TIP: Click on subject to list as thread! ANSI
echo: power_bas
to: KEN UZZELL
from: BOB SEWELL
date: 1996-10-07 23:14:00
subject: File Copy

 While translating the works of Dr. Suess into Latin, Ken Uzzell said:
 KU> In one application I am developing, I have to copy binary files from
 KU> one directory to another as part of its function.
    I have two snippets posted long ago on the QB echo,
 which I include below.  Mind you, I've never gotten around
 to trying either of them, but they may at least provide you
 with a starting point.  My thanks to the authors, whose
 names I include in the copies of the original posts.
    The second one will need all statements associated with
 the call interrupts modified for PB.  Other modifications
 may be needed for PB as well.
 =======================================================================
 ' Number: 155 (Read 1 time)               Date: 16 Jul 92 17:03:10
 ' From: Coridon Henshaw
 ' To: Bob Sewell                      Recv
 ' Subject: COPY command from QB
 '
 DECLARE SUB FileCopy (FromFile$, ToFile$, Buffer$)
 ' FILECOPY.BAS  Matt Hart
 '
 ' Copy a file
 '
 ' For error trapping, compile with /X
    DEFINT A-Z
    'ON ERROR GOTO ErrorTrap    ' Uncomment to trap disk errors
    C$ = LTRIM$(RTRIM$(COMMAND$))
    FromFile$ = LEFT$(C$, INSTR(C$, " ") - 1)
    ToFile$ = MID$(C$, INSTR(C$, " ") + 1)
    IF FromFile$ = "" OR ToFile$ = "" THEN
        PRINT "To run test program:"
        PRINT "   C:\>filecopy fromfile tofile"
        END
    END IF
    Start@ = TIMER
    CALL FileCopy(FromFile$, ToFile$, SPACE$(32767))
    EndTime@ = TIMER - Start@
    PRINT USING "Took ###,###,###,### Seconds to copy"; EndTime@
 Ending:
    END
    ' Uncomment below for error trapping
 'ErrorTrap:
 '    PRINT "Error ";Err;" has occurred."
 '    PRINT "Press ENTER to resume or ESC to exit"
 '    DO
 '        A$=INKEY$
 '    LOOP UNTIL A$=CHR$(27) OR A$=CHR$(13)
 '    IF A$=CHR$(13) THEN
 '        RESUME
 '    ELSE
 '        RESUME Ending
 '    ENDIF
    ' Buffer$ - up to 32767.  Larger sizes will increase memory
    ' requirement but decrease copy time for large files.
 SUB FileCopy (FromFile$, ToFile$, Buffer$)
    FF = FREEFILE
    OPEN "B", FF, FromFile$
    TF = FREEFILE
    OPEN "B", TF, ToFile$
    A& = LOF(FF)
    B& = LEN(Buffer$)
    IF A& \ B& > 0& THEN
        FOR i& = 1& TO A& \ B&
            GET FF, , Buffer$
            PUT TF, , Buffer$
        NEXT
    END IF
    B& = A& MOD B&
    IF B& > 0& THEN
        Buffer$ = SPACE$(B&)
        GET FF, , Buffer$
        PUT TF, , Buffer$
    END IF
    CLOSE TF, FF
 END SUB
 =======================================================================
 ' From: Rick Cooper
 ' To: Bob Sewell                      Recv
 ' Subject: COPY command from QB
 '>    Anyone know how to access the DOS COPY command from within QB, without
 '> resorting to the SHELL "copy \path1\file1 \path2" statement?
 '>
 'Yeah.. Use this instead:
 DECLARE FUNCTION GetHandle& (FileName$)
 DECLARE SUB CloseHandle (Handle&)
 DECLARE SUB GetSetTimeDate (Which%, Handle&, Time&, Date&)
 '$INCLUDE: 'Qb.Bi'
 DECLARE SUB fcopy (First$, Second$)
 First$ = ""
 Second$ = ""
 FOR i = 1 TO LEN(COMMAND$)
    IF MID$(COMMAND$, i, 1)  " " THEN
        First$ = First$ + MID$(COMMAND$, i, 1)
    ELSE
        i = i + 1
        EXIT FOR
    END IF
 NEXT i
 FOR j = i TO LEN(COMMAND$)
    IF MID$(COMMAND$, j, 1)  " " THEN
        Second$ = Second$ + MID$(COMMAND$, j, 1)
    ELSE
        j = j + 1
        EXIT FOR
    END IF
 NEXT j
 CALL fcopy(First$, Second$)
 SUB CloseHandle (Handle&)
 '**************************************************************************
 ' This Function Closes the Handle Assigned by Dos... DO NOT try to use the
 ' QuickBasic Close Function... Must Be Closed By Dos Or The File Will
 ' Remain Open... Can Be Sticky
 '**************************************************************************
 DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
 InRegs.Ax = &H3E00
 InRegs.Bx = Handle&
 CALL InterruptX(&H21, InRegs, OutRegs)
 END SUB
 SUB fcopy (First$, Second$)
 '====================================================================
 'The Buffer Size Is Determined By Checking Availible String Space
 'If The Availible Space Is <= File Size Or the Quick Basic Limitation
 'On Strings Then The Largest Applicable buffer Is Used Resulting In
 'The Fastest Possible Copy
 '====================================================================
 DIM buffer AS STRING
 OPEN First$ FOR BINARY AS #1
 OPEN Second$ FOR BINARY AS #2
 place# = 0
 famount# = FRE(buffer)
    buffer = ""
    maxrecord# = 32767
    IF maxrecord# > famount# THEN maxrecord# = famount#
    bestrecord# = LOF(1)
 FOR i = 1 TO bestrecord#
    min# = LOF(1) - place#
    IF min# >= maxrecord# THEN              'Determine Best
        length# = maxrecord#            'Buffer Length
        buffer = SPACE$(length#)        'And Redimension
        GET #1, , buffer                'Buffer Accordingly
        PUT #2, , buffer                'And Increment The
        place# = place# + length#       'Location Pointer
        buffer = ""
    ELSEIF min# <= maxrecord# THEN          'Can We Get The
        length# = min#                  'Rest Of The File
        buffer = SPACE$(length#)        'All At Once?
        GET #1, , buffer                'If So Do It
        PUT #2, , buffer
        place# = place# + length#
        buffer = ""
    ELSE
    END IF
    IF place# >= bestrecord# THEN EXIT FOR  'If We Are At The
 NEXT i                                          'End Leave
 CLOSE
 '**************************************************************************
 ' Now, Thanks To Tom Handlin's Suggestion, We Rest The New File's Time
 ' And Date Stamp To The Old File's Time And Date
 '**************************************************************************
 handle1& = GetHandle&(First$)
 Handle2& = GetHandle&(Second$)
 CALL GetSetTimeDate(0, handle1&, Time&, Date&)
 CALL GetSetTimeDate(1, Handle2&, Time&, Date&)
 CALL CloseHandle(handle1&)
 CALL CloseHandle(Handle2&)
 END SUB
 FUNCTION GetHandle& (FileName$)
 '**************************************************************************
 ' This routine simply gets a Dos file handle to pass to the function
 ' which sets the time and date of the destination file. DO NOT attempt
 ' to pass a QuickBasic File Number. it must be assigned and recognized by
 ' Dos for the function to succed
 '**************************************************************************
 DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
 OpenFile$ = FileName$ + CHR$(0)
 InRegs.Ax = (256 * &H3D) + &H0
 InRegs.Ds = VARSEG(OpenFile$)
 InRegs.Dx = SADD(OpenFile$)
 CALL InterruptX(&H21, InRegs, OutRegs)
 GetHandle& = OutRegs.Ax
 END FUNCTION
 SUB GetSetTimeDate (Which%, Handle&, Time&, Date&)
 '**************************************************************************
 ' This is the function Which actually gets and sets a file's Date Time 
tamp.
 ' Notice the handle& variable... this is ABSOULTLY essential for this
 ' function to succeed. I won't go into the time/date field encoding
 ' here... I will, however, demonstrait these later in a function to set the
 ' time or date or both to what ever you wish.
 '**************************************************************************
 DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
 IF Which%  1 THEN
    InRegs.Ax = (256 * &H57) + &H0
 ELSE
    InRegs.Ax = (256 * &H57) + &H1
    InRegs.Cx = Time&
    InRegs.Dx = Date&
 END IF
 InRegs.Bx = Handle&
 CALL InterruptX(&H21, InRegs, OutRegs)
 IF Which%  1 THEN
    Time& = OutRegs.Cx
    Date& = OutRegs.Dx
 END IF
 END SUB
 'This will allow a very fast copy from within quickbasic and since it's QB
 'code you have complete control and can display anything (or nothing) while
 'it's copying and don't have to muck about with DOS
... I beg of you...  please...  bring me the blue pages!
--- PPoint 1.96
---------------
* Origin: Seven Wells On-Line * Nashville, TN (1:116/3000.12)

SOURCE: echomail via exec-pc

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.