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