BBS: Inland Empire Archive Date: 01-11-93 (20:17) Number: 338 From: JOHN GALLAS Refer#: NONE To: RANDY HARRIS Recvd: NO Subj: I NEED HELP! Conf: (2) Quik_Bas
RH>EID:F10D 84B80000
RH>Can someone please tell me if there is a way in QB to shorten a file
RH>which has been opened 'BINARY'? I am saving data records in the file,
RH>but cannot figure out how to delete a record and update the EOF
RH>pointer.
RH>I can write the data to a new file, then delete the old and rename the
RH>new, but this is quite slow.
I got just what ya need..
' To put it simply, this program will *shorten* the length of a file.
DEFINT A-Z
DECLARE FUNCTION TruncateFile% (Handle%, NewLength&)
' $INCLUDE: '\qb45\qb.bi'
'Heres an example of how to use it:
OPEN "TEST.DAT" FOR BINARY AS #1 'Create a file to test
A$ = " "
PUT #1, 10240, A$ 'Make it 10K long
PRINT "File length:"; LOF(1) 'Make sure
Handle% = FILEATTR(1, 2) 'Get DOS file handle
NewLength& = 5000 'New length for this file
Status% = TruncateFile%(Handle%, NewLength&) 'Do it
IF Status% THEN
PRINT "DOS Error"; Status%; " occurred."
ELSE
PRINT "New file length:"; LOF(1)
END IF
CLOSE
FUNCTION TruncateFile% (Handle%, NewLength&)
DIM Reg AS RegTypeX
'First, position the file read/write pointer to the place where the
'truncation should take place. We can't trust BASIC's SEEK statement
'because the movement is sometimes held until the next read/write.
Reg.ax = &H4200 'DOS "Set file pointer" function
Reg.bx = Handle%
'We go through these steps to prevent "overflow" errors when
'NewLength& > 32767. The high word of the file position goes in CX
'and the low word goes in DX. Since BASIC treats integers and longs
'"signed" variables, we need to take to extra steps to prevent
'an overflow error as we break the long integer down.
DEF SEG
Addr% = VARPTR(NewLength&)
Reg.cx = CVI(CHR$(PEEK(Addr% + 2)) + CHR$(PEEK(Addr% + 3)))
Reg.dx = CVI(CHR$(PEEK(Addr%)) + CHR$(PEEK(Addr% + 1)))
CALL INTERRUPTX(&H21, Reg, Reg)
IF Reg.flags AND 1 THEN
Status% = Reg.ax
GOTO TruncateExit
END IF
'Now, write 0 bytes.
Reg.ax = &H4000 'Dos "Write file or device"
Reg.bx = Handle%
Reg.cx = 0 'Write 0 bytes
Reg.dx = 0 'These are not needed, but make
Reg.ds = 0 ' sure they're zero, just in case
CALL INTERRUPTX(&H21, Reg, Reg)
IF Reg.flags AND 1 THEN
Status% = Reg.ax
END IF
TruncateExit:
TruncateFile% = Status%
END FUNCTION
RH>The second question is this: Is there a way to send data out the COM
RH>port without any EOB characters being sent? QB will not open the COM
RH>port in BINARY and all other methods seem to send an EOB character or
RH>two when I PUT a record out the port.
RH>The only work around I have been able to come up with so far is to PUT
RH>the data to a file, then SHELL and TYPE the file out the port.
I don't understand this part, whats an EOB character?
* OLX 2.1 TD * Compiled...First screen came up...SHIP IT!!!
--- TMail v1.30.4
* Origin: TC-AMS MLTBBS 2.2 - Minnetonka, MN (612)-938-4799 (1:282/7)

Books at Amazon:
Back to BASIC: The History, Corruption, and Future of the Language
Hackers: Heroes of the Computer Revolution (including Tiny BASIC)
Go to: The Story of the Math Majors, Bridge Players, Engineers, Chess Wizards, Scientists and Iconoclasts who were the Hero Programmers of the Software Revolution
The Advent of the Algorithm: The Idea that Rules the World
Moths in the Machine: The Power and Perils of Programming
Mastering Visual Basic .NET