TIP: Click on subject to list as thread! ANSI
echo: power_bas
to: KEN UZZELL
from: FRANK COX
date: 1996-09-08 10:06:00
subject: File Copy

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

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