home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / dnalib7a.zip / COPYFILE.BAS < prev    next >
BASIC Source File  |  1994-05-14  |  2KB  |  54 lines
  1. '┌─────────────────────────────────────────────────────────────────────┐
  2. '│ copies InFile$ to OutFile$ w/error checking, but does not verify    │░░
  3. '│ existence of InFile$                                                │░░
  4. '│ if OutFile$ already exists, it is truncated to 0, then overwritten  │░░
  5. '│ if copy is good, function returns 0                                 │░░
  6. '│ if error occurs, function returns PB error code                     │░░
  7. '└─────────────────────────────────────────────────────────────────────┘░░
  8. '  ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
  9.  
  10. FUNCTION CopyFile%(BYVAL InFile$, BYVAL OutFile$) PUBLIC
  11. LOCAL BytesLeft&, MaxString%, FileIn%, FileOut%
  12.  
  13. $CODE SEG "DNASEG2"
  14.  
  15. ON LOCAL ERROR GOTO CopyFileError
  16.  
  17. FileIn% = FREEFILE                        'source file
  18. OPEN InFile$ FOR BINARY AS FileIn%
  19.  
  20. FileOut% = FREEFILE
  21. OPEN OutFile$ FOR OUTPUT AS FileOut%      'clear destination file if
  22. CLOSE FileOut%                            'it exists
  23. OPEN OutFile$ FOR BINARY AS FileOut%      'reopen destination
  24.  
  25. MaxString% = FRE(t$)                      'create largest buffer possible
  26. Buffer$ = SPACE$(MaxString%)
  27. BytesLeft& = LOF(FileIn%)                 'bytes to copy
  28.  
  29. DO
  30.   IF BytesLeft& < MaxString% THEN         'nearly done
  31.     MaxString% = BytesLeft&
  32.     Buffer$ = SPACE$(MaxString%)
  33.   END IF
  34.   GET FileIn%,,Buffer$
  35.   PUT FileOut%,,Buffer$
  36.   BytesLeft& = BytesLeft& - MaxString%
  37. LOOP WHILE ISTRUE(BytesLeft&)
  38.  
  39. CLOSE FileIn%, FileOut%
  40.  
  41. '-----------------------------------------------------------------------------
  42. ExitCopyFile:
  43.  
  44. EXIT FUNCTION
  45. '-----------------------------------------------------------------------------
  46. CopyFileError:
  47.  
  48. CLOSE
  49. CopyFile% = ERRTEST
  50. RESUME ExitCopyFile
  51. '-----------------------------------------------------------------------------
  52. END FUNCTION
  53. '-----------------------------------------------------------------------------
  54.