home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOL_INC.ZIP / MOVEFILE.INC < prev    next >
Encoding:
Text File  |  1988-01-29  |  2.4 KB  |  103 lines
  1.  
  2. (*
  3.  * Copy or Move files; changes time stamps
  4.  *
  5.  * (C) 1987 Samuel H. Smith, 14-Dec-87 (rev. 27-Jan-88)
  6.  *
  7.  *)
  8.  
  9. (* ------------------------------------------------------------ *)
  10. procedure copy_file(source,dest: anystring);
  11.    (* copy a file from one place to another *)
  12.  
  13. const
  14.    bufmax = $F000;   {maximum buffer size}
  15.    extra = $1000;    {extra heap to leave free}
  16. var
  17.    bufsize:  word;   {actual buffer size}
  18.    buf:      ^byte;
  19.    ifd:      dos_handle;
  20.    ofd:      dos_handle;
  21.    n,w:      word;
  22.  
  23. begin
  24.    bufsize := bufmax;
  25.    if bufsize > maxavail-extra then
  26.       bufsize := maxavail-extra;
  27.  
  28.    if bufsize < extra then
  29.    begin
  30.       displn(^G^G'Can''t allocate COPY_FILE buffer!');
  31.       exit;
  32.    end;
  33.  
  34.    ifd := dos_open(source,open_read);
  35.    if ifd = dos_error then
  36.       exit;
  37.  
  38.    ofd := dos_create(dest);
  39.    if ofd = dos_error then
  40.    begin
  41.       dos_close(ifd);
  42.       exit;
  43.    end;
  44.  
  45.    getmem(buf,bufsize);
  46.  
  47.    repeat
  48.       disp('.');
  49.       n := dos_read(ifd,buf^,bufsize);
  50.  
  51.       disp(^H' '^H);
  52.       dos_write(ofd,buf^,n);
  53.       w := dos_regs.ax;
  54.    until w <> bufsize;
  55.  
  56.    dos_close(ifd);
  57.    dos_close(ofd);
  58.  
  59.    if w <> n then
  60.    begin
  61.       disp('Sorry, no space for '+remove_path(dest));
  62.       dos_unlink(dest);
  63.    end;
  64.  
  65.    freemem(buf,bufsize);
  66. end;
  67.  
  68.  
  69. (* ------------------------------------------------------------ *)
  70. procedure move_file(source,dest: anystring);
  71.    (* move a file from one place to another;  quickly rename if
  72.       possible, otherwise copy and delete.  touches file to make
  73.       file-date = date moved or copied *)
  74. var
  75.    tfd:  file of byte;
  76.    buf:  byte;
  77.  
  78. begin
  79.  
  80. (* try to rename the file (fastest way, only on same device) *)
  81.    assign(tfd,source);
  82.    {$i-} rename(tfd,dest); {$i+}
  83.    if ioresult = 0 then
  84.    begin
  85.       (* move worked, touch the file to set last update date/time
  86.          to today's date.  otherwise file may have strange date as
  87.          set by the transfer protocol.  this makes date = date uploaded *)
  88.       {$i-}
  89.          assign(tfd,dest);  reset(tfd);
  90.          read(tfd,buf);    seek(tfd,0);
  91.          write(tfd,buf);   close(tfd);
  92.       {$i-}
  93.       if ioresult <> 0 then {couldn't "touch" file} ;
  94.       exit;
  95.    end;
  96.  
  97. (* rename failed, just copy the file and delete original *)
  98.    copy_file(source,dest);
  99.    {$i-} erase(tfd); {$i+}
  100.    if ioresult <> 0 then {unlink failed} ;
  101. end;
  102.  
  103.