home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / copymove.swg / 0007_Copy File with Display.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  1.7 KB  |  67 lines
  1. Hello Matthew!
  2.  
  3. Answering a msg of <Monday April 12 1993>, from Matthew Staikos to All:
  4.  
  5. The Norton-like bar along with the copying won't compile,
  6. but you get the idea, no?
  7.  
  8.   {$I-}
  9.   function __copyfil(
  10.     show: boolean; x1,x2,y,f,b: byte; fs: longint; src, targ: string
  11.   ): byte;
  12.   {
  13.    return codes:
  14.      0 successful
  15.      1 source and target the same
  16.      2 cannot open source
  17.      3 unable to create target
  18.      4 error during copy
  19.      5 cannot allocate buffer
  20.   }
  21.   const
  22.     bufsize = 16384;
  23.  
  24.   type
  25.     fbuf = array[1..bufsize] of char;
  26.     fbf  = ^fbuf;
  27.  
  28.   var
  29.     source,
  30.     target   :    file;
  31.     bread,
  32.     bwrite   :    word;
  33.     filebuf  :    ^fbf;
  34.     tr       : longint;
  35.     nr       :    real;
  36.  
  37.   begin
  38.     if memavail > bufsize then new(filebuf) else begin
  39.       __copyfil := 5; exit
  40.     end;
  41.     if src = targ then begin __copyfil := 1; exit end;
  42.     assign(source, src); reset(source,1);
  43.     if ioresult <> 0 then begin __copyfil := 2; exit end;
  44.     assign(target, targ); rewrite(target,1);
  45.     if ioresult <> 0 then begin __copyfil := 3; exit end;
  46.     if show then __write(x1+2,y,f,b,__rep(x2-x1-3,'░')); tr := 0;
  47.     repeat
  48.       blockread(source,filebuf^,bufsize,bread);
  49.       tr := tr + bread; nr := tr/fs;
  50.       nr := nr * (x2-x1-3);
  51.       if show then __write(x1+2,y,f,b,__rep(trunc(nr), '█'));
  52.       blockwrite(target,filebuf^,bread,bwrite);
  53.     until (bread = 0) or (bread <> bwrite);
  54.     if show then __write(x1+2,y,f,b,__rep((x2-x1-3),'█'));
  55.     close(source); close(target);
  56.     if bread <> bwrite then __copyfil := 4 else __copyfil := 0;
  57.   end;
  58.   {$I-}
  59.  
  60.  
  61.  
  62.  
  63. Floor
  64.  
  65. --- GoldED 2.40
  66.  * Origin: UltiHouse/2 5 Years! V32b/HST/16k8: x31,13,638709 (2:512/195)
  67.