Category : BASIC Source Code
Archive   : TKMOVE.ZIP
Filename : MOVE.BAS

 
Output of file : MOVE.BAS contained in archive : TKMOVE.ZIP

DECLARE FUNCTION Move% (From$, To$)
'QB's NAME function also has the ability to move a file to a different
'subdirectory on the same drive. This version is written for PDS which
'can make use of ON LOCAL ERROR GOTO to trap attempts to rename across
'drives. If that fails then the program will do a copy and delete.
'You could add any number of additional traps for full drive, drive not
'found etc. But this should make for an interesting starting point...

'demo code
From$ = "Z:\E\FOO" 'networked remote drive E: on test system
'From$ = "E:\SOURCE\FOO" 'cross drive test
To$ = "Z:\E\hold\foobar"
ErrorIs% = Move%(From$, To$)
IF ErrorIs% THEN PRINT "Move Failed"
'Note: the true copy program doesn't trap for full disk etc.

FUNCTION Move% (From$, To$)
ON LOCAL ERROR GOTO BadRename

IF LEN(DIR$(To$)) > 0 THEN 'name can't overwrite--binary inserts
PRINT "Overwriting existing file: "; To$
KILL To$
END IF
Move% = 0 'sucessful rename

NAME From$ AS To$
EXIT FUNCTION
BadRename:
RESUME NormalCopy
NormalCopy:
ON LOCAL ERROR GOTO 0
'this is the code from TKCOPY--merged to provide copy function in
'this program to make it complete. It'd be better to call the
'routine to avoid duplication of code. Also, real one is commented.
IF LEN(DIR$(From$)) = 0 THEN
PRINT "File Not Found: "; From$
Move% = -1
EXIT FUNCTION
END IF

b1% = FREEFILE
OPEN From$ FOR BINARY AS #b1%
b2% = FREEFILE
ON LOCAL ERROR GOTO BadCopy 'deletes To$ instead of From$
OPEN To$ FOR BINARY AS #b2%
FileSize& = LOF(1)

MaxLen& = ((FRE("") - 4096) \ 1024) * 1024
IF MaxLen& > FileSize& THEN MaxLen& = FileSize&
IF MaxLen& > 32 * 1024& - 1 THEN MaxLen& = 32 * 1024& - 1
IF MaxLen& < 2048 AND MaxLen& <> FileSize& THEN
PRINT "Insufficient data space -- COPY Aborted"
ELSE
f$ = SPACE$(MaxLen&)
DO
GET b1%, , f$
PUT b2%, , f$
FileSize& = FileSize& - MaxLen&
IF FileSize& < MaxLen& THEN
MaxLen& = FileSize&
f$ = SPACE$(MaxLen&)
END IF
LOOP UNTIL FileSize& = 0
CLOSE b1%, b2%
END IF
KILL From$
EXIT FUNCTION
BadCopy:
Move% = ERR
KILL To$
RESUME Exidus
Exidus:
END FUNCTION