Download text file
' ==========================================================================
' Binary Text File handling
' ==========================================================================
' $LINK "BIN_TXT.PBU
' DECLARE FUNCTION fBTFopen& (BYVAL FileName$)
' DECLARE SUB BTFclose ()
' DECLARE FUNCTION fBTFread$ (BYVAL LineNo&)
' DECLARE SUB BTFwrite (BYVAL Text$,BYVAL LineNo&)
' DECLARE FUNCTION fBTFadd$ (BYVAL Text$,BYVAL LineNo&)
' DECLARE FUNCTION fBTFdelete& (BYVAL LineNo&)
$if 1
$STRING 32
SHARED sTXTfile$, sTfileNo% ' file being read
SHARED sIDXfile$, sXfileNo% ' temp index file
SHARED sLastLine&, sCrLf$ ' #of lines and EOL
SHARED sMaxLen% ' longest line -CrLf
' start of test code
SHELL "COPY D:\INTERRUP\OPCODES.LST" ' get a fresh copy
CLS ' ready the screen
LastLine& = fBTFopen&( "OPCODES.LST" ) ' create the index
IF LastLine& = 0 THEN BEEP : END ' no text file!
PRINT USING "Longest Line: ###"; fMaxLineLen% '
ThisLine& = 100 ' line # to test
Display7 ThisLine&
Txt$ = "Test Line" + string$(60, 95 )
BTFwrite Txt$, ThisLine&
Display7 ThisLine&
'
ByeBye: ' clean-up
BTFclose ' close/kill index
END ' end of prog
'
SUB Display7( BYVAL ThisLine& ) LOCAL PUBLIC
LOCAL X&, L$
PRINT USING "Number of Lines: ##,###"; sLastLine&
ThisLine& = MAX( ThisLine&, 4 )
ThisLine& = MIN( ThisLine&, sLastLine& - 3 )
PRINT STRING$(80,196);
FOR X& = ThisLine& -3 TO ThisLine& + 3
L$ = fBTFread$( X& )
PRINT USING "#### "; X&;
PRINT LEFT$( L$, 72 ); "<<"
NEXT
PRINT STRING$(80,196)
END SUB
$endif
' =========================================================================
' ================= start of code ======================================
' =========================================================================
FUNCTION fBTFopen&( BYVAL TxtFile$ ) LOCAL PUBLIC
LOCAL Chunk%, Offset&, Jump%
LOCAL D$, L%, P1%, P2%
IF sXfileNo% > 0 THEN EXIT FUNCTION ' one at a time, please
sXfileNo% = 0 ' just in case
sTfileNo% = 0 '
sCrLf$ = CHR$(13,10) '
Jump% = LEN( sCrLf$ ) '
IF LEN( DIR$(TxtFile$) ) = 0 THEN EXIT FUNCTION ' file doesn't exist
sTfileNo% = FREEFILE ' next file number
OPEN "B", #sTfileNo%, TxtFile$ ' open the file
IF LOF(sTfileNo%) = 0 THEN ' empty file
CLOSE sTfileNo% ' close it
KILL TxtFile$ ' kill it
EXIT FUNCTION ' RETURN ZERO
END IF '
sTXTfile$ = TxtFile$ ' store to SHARED var
sIDXfile$ = EXTRACT$( TxtFile$, "." ) + "._$_" ' create file name
sXfileNo% = FREEFILE ' next file number
IF LEN(DIR$(sIDXfile$)) > 0 THEN KILL sIDXfile$ ' erase existing file
OPEN "B", #sXfileNo%, sIDXfile$ ' create index file
Offset& = 0 ' set offset pointer
PUT #sXfileNo%, ,Offset& ' dummy record
PUT #sXfileNo%, ,Offset& ' 1st line at offset 4
'
Chunk% = FRE(-4) ' max string length
DECR Chunk%, ( Chunk% MOD 512 ) ' rounded to 512bytes
'
DO '
SEEK #sTfileNo%, Offset& ' set infile's pointer
GET$ #sTfileNo%, Chunk%, D$ ' read in the chunk
Chunk% = LEN(D$) ' check the length
P1% = 1 ' reset buffer pointer
DO ' process the buffer
P2% = INSTR( P1%, D$, sCrLf$ ) ' find next CrLf
IF P2% = 0 THEN EXIT LOOP ' end of buffer
L% = P2% - P1% + 2 ' length of line
sMaxLen% = MAX%( sMaxLen%, L% ) ' get new max length
P1% = P2% + Jump% ' set buffer pointer
INCR Offset&, L% ' the NEXT line
PUT #sXfileNo%, ,Offset& ' store line pointer
LOOP UNTIL P1% => Chunk% ' just in case
LOOP UNTIL EOF(sTfileNo%) ' all done
sLastLine& = ( LOF(sXfileNo%) \ 4 ) -2 ' compute # of lines
DECR sMaxLen%, Jump% ' adjust max line len
sMaxLen% = MIN%( 512, sMaxLen% ) ' can't be longer
'
FUNCTION = sLastLine& ' RETURN # of lines
'
END FUNCTION '
' =========================================================================
FUNCTION fBTFmaxlen% () LOCAL PUBLIC
FUNCTION = sMaxLen%
END FUNCTION
' =========================================================================
SUB BTFClose LOCAL PUBLIC
CLOSE #sTfileNo% ' close both file
CLOSE #sXfileNo% '
KILL sIDXfile$ ' kill index file
sTfileNo% = 0 ' clear SHARED vars
sXfileNo% = 0 '
sLastLine& = 0 '
sMaxLen% = 0
sCrLf$ = "" '
sIDXfile$ = "" '
sTXTfile$ = "" '
END SUB
' =========================================================================
FUNCTION fBTFread$( BYVAL LineNo& ) LOCAL PUBLIC
LOCAL Offset&, Txt$
IF LineNo& < 1 THEN EXIT FUNCTION ' not far enough!
IF LineNo& > sLastLine& THEN EXIT FUNCTION ' too far!
SEEK #sXfileNo%, ( LineNo& * 4 ) ' 4 bytes per pointer
GET #sXfileNo%, , Offset& ' get the offset
SEEK #sTfileNo%, Offset& ' set the file pointer
GET$ #sTfileNo%, 512, Txt$ ' read in a buffer full
FUNCTION = EXTRACT$( Txt$, sCrLf$ ) ' strip off the CrLf
END FUNCTION
' ==========================================================================
FUNCTION fBTFadd&( BYVAL Txt$, BYVAL LineNo& ) LOCAL PUBLIC
LOCAL Offset&, X&, Noff&, Bytes%
Txt$ = EXTRACT$( Txt$, sCrLf$ ) + sCrLf$ ' massage incoming $
Bytes% = LEN( Txt$ ) ' get the length
LineNo& = MIN( LineNo&, sLastLine& ) ' just in case
LineNo& = MAX( LineNo&, 0 ) '
INCR sLastLine& ' new last line
INCR LineNo& ' and new after line#
X& = ( LineNo& * 4 ) ' pointer offset
GET# sXfileNo%, X&, Offset& ' txt file offset
IF sLineNo& < sLastLine& THEN ' if not new last line
MoveFileBytes sTfileNo%, Offset&, Bytes% ' then move data down
END IF '
SEEK #sTfileNo%, Offset& ' position file pointer
PUT$ #sTfileNo%, Txt$ ' and put the new line
'
Offset& = ( sLastLine& * 4 ) ' start at the bottom
FOR X& = sLastLine& TO LineNo& STEP -1 ' of the index file
GET #sXfileNo%, Offset&, Noff& ' get the old ptr
INCR Noff&, Bytes% ' incr it by the length
PUT #sXfileNo%, , Noff& ' put it back 4bytes
DECR Offset&, 4 ' farther down
NEXT '
'
FUNCTION = sLastLine& ' RETURN new last line
END FUNCTION
' ==========================================================================
SUB BTFwrite( BYVAL Txt$, BYVAL LineNo& ) LOCAL PUBLIC
LOCAL OldLen%, NewLen%, Bytes%
LOCAL Noff&, X&, Offset&, Null$
IF LineNo& < 1 THEN EXIT SUB ' not far enough!
IF LineNo& > sLastLine& THEN EXIT SUB ' too far!
Txt$ = EXTRACT$( Txt$, sCrLf$ ) + sCrLf$ ' one line only, please
SEEK #sXfileNo%, ( LineNo& * 4 ) ' 4 bytes per pointer
GET #sXfileNo%, ,Offset& ' offset to this line
GET #sXfileNo%, ,Noff& ' offset to next line
OldLen% = Noff& - Offset& ' compute orig. length
NewLen% = LEN(Txt$) ' new lenght
Bytes% = NewLen% - OldLen% ' difference in bytes
IF Bytes% < 1 THEN ' decrease file size
SEEK #sTfileNo%, Offset& ' position pointer
PUT$ #sTfileNo%, Txt$ ' put the new info
IF Bytes% = 0 THEN EXIT SUB ' all done here!
IF LineNo& = sLastLine& THEN GOTO FixIndex ' don't need move data
Offset& = Noff& + Bytes% ' new eol positon
END IF '
MoveFileBytes sTfileNo%, Offset&, Bytes% ' move the data
IF Bytes% > 0 THEN ' increased file size
SEEK #sTfileNo%, Offset& ' position pointer
PUT$ #sTfileNo%, Txt$ ' put the new info
END IF '
'
FixIndex: '
Offset& = ( LineNo& * 4 ) '
FOR X& = LineNo& + 1 TO sLastLine& + 1 ' adjust pointer to
INCR Offset&, 4 ' new positions
GET #sXfileNo%, Offset&, Noff& ' read old pointer
INCR Noff&, Bytes% ' adjust
PUT #sXfileNo%, Offset&, Noff& ' write new pointer
NEXT '
IF Bytes% < 0 THEN BTFtruncate Bytes% ' all done here
END SUB
' ==========================================================================
FUNCTION fBTFdelete&( LineNo& ) LOCAL PUBLIC
LOCAL Offset&, Noff&, X&
LOCAL Bytes%, NULL$, Poff&
IF LineNo& < 1 THEN EXIT FUNCTION ' not far enough!
IF LineNo& > sLastLine& THEN EXIT FUNCTION ' too far!
DECR sLastLine& '
Poff& = ( LineNo& * 4 ) '
GET #sXfileNo%, Poff&, Offset& '
GET #sXfileNo%, , Noff& '
Bytes% = ( Noff& - Offset& ) '
MoveFileBytes sTfileNo%, Offset&, -Bytes% '
'
Noff& = Poff& + 4 ' next line offset
FOR X& = LineNo& TO sLastLine& ' move line offset data
GET #sXfileNo%, Noff&, Offset& : INCR Noff&, 4 ' up one line and
DECR Offset&, Bytes% ' decr by lost bytes
PUT #sXfileNo%, Poff&, Offset& : INCR Poff&, 4 '
NEXT '
BTFtruncate Bytes% ' chop the txt file
'
FUNCTION = sLastLine& ' RETURN new last line#
END FUNCTION
' ==========================================================================
SUB BTFtruncate( BYVAL Bytes% ) LOCAL PRIVATE
LOCAL Null$, Offset&
Null$ = ""
Offset& = LOF( sTfileNo% ) - Bytes% ' new EOF
SEEK #sTfileNo%, Offset& ' set the pointer
$if 1 ' pb v3.2 & fb
PUT$ #sTfileNo%, Null$ ' put a NULL string
CLOSE #sTfileNo% ' close the file
OPEN "B", #sTfileNo%, sTXTfile$ ' reopen it
$else ' pb v3.5
SETEOF #sTfileNo% '
$endif
END SUB
'============================================================================
'
' PURPOSE: to move bytes of a BIN file around to create/close-up space
' PARAMS: FileNo% PowerBASIC's file number
' Start& starting offset of data to be moved
' Bytes& < 0 the number of bytes to close-up
' > 0 the number of bytes to open up
' NOTE: When closing-up data the value of Start& is the 1st byte
' to be over-written NOT the first byte to be moved to the
' new position. This was done to keep the extra math inside
' this routine and out of all the calls to it!
' 5
' THE FILE as it was: 11111abcdef_22222
' MoveFileBytes FileNo%, 5, +7 produces 11111abcdef_abcdef_22222
' MoveFileBytes FileNo%, 5, -7 produces 1111122222
'
'============================================================================
SUB MoveFileBytes( BYVAL FileNo%, BYVAL StartOff&, BYVAL Bytes& ) LOCAL PUBLIC
LOCAL B%, BytesToMove&, L&, MaxBytes%, D$
'旼컴컴컴컴컴컴컴컴컴컴컴
MaxBytes% = FRE(-4) '� biggest string chunk
DECR MaxBytes%, ( MaxBytes% MOD 512 ) '� round off to 512
L& = LOF( FileNo% ) '� length of file
BytesToMove& = L& - StartOFF& '�
IF Bytes& > 0 THEN '� opening a space
StartOff& = L& '�
ELSE '� closing up a gap
StartOFF& = StartOFF& - Bytes& '� this adds the neg #
BytesToMove& = BytesToMove& + Bytes& '� this subs the neg #
END IF '�
'�
DO '�
B% = MIN( MaxBytes%, BytesToMove& ) '� size of chunk
IF Bytes& > 0 THEN DECR StartOff&, B% '� fix seek position <�
SEEK #FileNo%, StartOff& '� set get position �
GET$ #FileNo%, B%, D$ '� take a bite 쿽r
SEEK #FileNo%, StartOff& + Bytes& '� set put position �
PUT$ #FileNo%, D$ '� spit it out �
IF Bytes& < 0 THEN INCR StartOff&, B% '� fix seek position <�
DECR BytesToMove&, B% '� decr work load by chunk
LOOP UNTIL BytesToMove& =< 0 '�
'읕컴컴컴컴컴컴컴컴컴컴컴
END SUB