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