> Greetings All!
> In one application I am developing, I have to copy binary
> files from one directory to another as part of its function.
Routine # 1:
============
DECLARE SUB COPYFILE(STRING, STRING)
CLS
INPUT "Enter Source file --> ", Source$
INPUT "Enter Target file --> ", Target$
PRINT "Calling COPYFILE...";
CALL COPYFILE(Source$, Target$)
END
SUB COPYFILE(Source$, Target$)
y=pos(x) : x=csrlin
OPEN Source$ FOR BINARY AS #1
OPEN Target$ FOR BINARY AS #2
IF LOF(1) > 4096 THEN
FOR Yy=1 to LOF(1) \ 4096
GET$ #1, 4096, FileBlock$
' print number of bytes copied at cursor position
LOCATE X,Y: PRINT STR$(Yy*4096)+" bytes..."
PUT$ #2, FileBlock$
NEXT Yy
' copy the remaining partial block
GET$ #1, LOF(1)-((LOF(1)\4096)*4096), FileBlock$
PUT$ #2,FileBlock$
' print number of bytes copied at cursor position
LOCATE X, Y: PRINT "Copied"+STR$(LOF(1))+" bytes..."
ELSE
' or do this if the file is less than 4096 (or block size)
GET$ #1, LOF(1), FileBlock$
LOCATE X,Y: PRINT "Copied"+STR$(LOF(1))+" bytes..."
put$ #2,FileBlock$
END IF
CLOSE #1:CLOSE #2
END SUB
Routine #2
==========
'this routine will allow you to copy a file from within your
'Power Basic 2.1a or greater program without having to
'shell to the copy command
'Eric Schonning, Fido 1:206/2505
'released to the public domain for Power Basic users
's.path$ = full source path with trailing \
'd.path$ = full destination path with trailing \
'on either s.path$ or d.path$ use "" to signify current directory
'or use curdir$+"\"
'copy.file$ = filename to copy
s.path$=""
d.path$="c:\"
copy.file$="pbcopy.bas"
call copy(copy.file$,s.path$,d.path$)
sub copy(copy.file$,s.path$,d.path$) local
if dir$(s.path$+copy.file$) = "" then
beep
print "Error. Cannot Locate "ucase$(s.path$+copy.file$)
exit sub
end if
if s.path$ = d.path$ then
beep
print "Error. Cannot Copy a File Onto Itself"
exit sub
end if
in.file%=freefile
open s.path$+copy.file$ for binary as in.file%
'get file date/time to update destination file with it
bx%=fileattr(in.file%,2)
reg 1,&h5700
reg 2,bx%
call interrupt &h21
flag%=reg(0)
'carry flag clear if ok, it is bit 0
if (flag% and &b1) then beep:print "Error Getting File Date/Time":exit sub
'ax%=reg(1) 'read al if error
cx%=reg(3) 'file time
dx%=reg(4) 'file date
out.file%=freefile
open d.path$+copy.file$ for binary as out.file%
'this copy works by reading as large of string blocks as possible. the
'maximum string size is 32750, which will be reported by fre(0).
'fre(0) will also give the maximum amount of string memory left
'if you are running out of memory. the largest number fre(0) will return
'is 32750.
in.lof&=lof(in.file%)
maxsize%=fre(0) 'largest size string that can be allocated
for i&=0 to in.lof& step maxsize%
sd$="":null%=fre(0)
if (in.lof& - i&) < maxsize% then
'at the end of the file, just copy what is left
s&=seek(in.file%)
get$ in.file%,(in.lof&-i&),sd$
seek out.file%,s&
put$ out.file%,sd$
else
s&=seek(in.file%)
get$ in.file%,maxsize%,sd$
seek out.file%,s&
put$ out.file%,sd$
end if
next i&
'set output file to same date/time as input file
bx%=fileattr(out.file%,2)
reg 1,&h5701
reg 2,bx%
reg 3,cx%
reg 4,dx%
call interrupt &h21
close in.file%,out.file%
end sub
--- Msgedsq 2.2e
---------------
* Origin: THE BIG ELECTRIC CAT Melville Sask *SDS* *PDN* (1:140/53)
|