' ========================================================================== ' 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 ³or 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