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>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.


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."
   PRINT "New file length:"; LOF(1)

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.

    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

    TruncateFile% = Status%


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)
Outer Court
Echo Basic Postings

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