home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 14 / CDACTUAL.iso / cdactual / demobin / share / program / Basic / TKMOVE.ZIP / MOVE.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-09-16  |  2.4 KB  |  74 lines
  1. DECLARE FUNCTION Move% (From$, To$)
  2. 'QB's NAME function also has the ability to move a file to a different
  3. 'subdirectory on the same drive.  This version is written for PDS which
  4. 'can make use of ON LOCAL ERROR GOTO to trap attempts to rename across
  5. 'drives.  If that fails then the program will do a copy and delete.
  6. 'You could add any number of additional traps for full drive, drive not
  7. 'found etc.  But this should make for an interesting starting point...
  8.  
  9. 'demo code
  10. From$ = "Z:\E\FOO"          'networked remote drive E: on test system
  11. 'From$ = "E:\SOURCE\FOO"     'cross drive test
  12. To$ = "Z:\E\hold\foobar"
  13. ErrorIs% = Move%(From$, To$)
  14. IF ErrorIs% THEN PRINT "Move Failed"
  15. 'Note: the true copy program doesn't trap for full disk etc.
  16.  
  17. FUNCTION Move% (From$, To$)
  18.     ON LOCAL ERROR GOTO BadRename
  19.  
  20.     IF LEN(DIR$(To$)) > 0 THEN  'name can't overwrite--binary inserts
  21.        PRINT "Overwriting existing file: "; To$
  22.        KILL To$
  23.     END IF
  24.     Move% = 0                   'sucessful rename
  25.     NAME From$ AS To$
  26.     EXIT FUNCTION
  27. BadRename:
  28.     RESUME NormalCopy
  29. NormalCopy:
  30.     ON LOCAL ERROR GOTO 0
  31.     'this is the code from TKCOPY--merged to provide copy function in
  32.     'this program to make it complete.  It'd be better to call the
  33.     'routine to avoid duplication of code.  Also, real one is commented.
  34.     IF LEN(DIR$(From$)) = 0 THEN
  35.        PRINT "File Not Found: "; From$
  36.        Move% = -1
  37.        EXIT FUNCTION
  38.     END IF
  39.  
  40.     b1% = FREEFILE
  41.     OPEN From$ FOR BINARY AS #b1%
  42.     b2% = FREEFILE
  43.     ON LOCAL ERROR GOTO BadCopy 'deletes To$ instead of From$
  44.     OPEN To$ FOR BINARY AS #b2%
  45.     FileSize& = LOF(1)
  46.  
  47.     MaxLen& = ((FRE("") - 4096) \ 1024) * 1024
  48.     IF MaxLen& > FileSize& THEN MaxLen& = FileSize&
  49.     IF MaxLen& > 32 * 1024& - 1 THEN MaxLen& = 32 * 1024& - 1
  50.     IF MaxLen& < 2048 AND MaxLen& <> FileSize& THEN
  51.        PRINT "Insufficient data space -- COPY Aborted"
  52.     ELSE
  53.         f$ = SPACE$(MaxLen&)
  54.         DO
  55.           GET b1%, , f$
  56.           PUT b2%, , f$
  57.           FileSize& = FileSize& - MaxLen&
  58.           IF FileSize& < MaxLen& THEN
  59.              MaxLen& = FileSize&
  60.              f$ = SPACE$(MaxLen&)
  61.           END IF
  62.         LOOP UNTIL FileSize& = 0
  63.         CLOSE b1%, b2%
  64.     END IF
  65.     KILL From$
  66. EXIT FUNCTION
  67. BadCopy:
  68.     Move% = ERR
  69.     KILL To$
  70.     RESUME Exidus
  71. Exidus:
  72. END FUNCTION
  73.  
  74.