home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 September / Chip_1999-09_cd.bin / internet / Jeremy / tp / downloads / copyfile.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-03  |  2.0 KB  |  71 lines
  1. unit copyfile;
  2.  
  3. interface
  4.  uses crt,dos;
  5.  
  6.  procedure copy(zdroj, cil: string);
  7.  
  8. implementation
  9.  
  10.  procedure copy(zdroj, cil: string);
  11.  const BufSize=63000;
  12.  var f, temp: file;
  13.      NR, NW: word;
  14.      bufR: array[1..BufSize] of byte;
  15.  begin
  16.       writeln;
  17.       textcolor(14); highvideo;
  18.       writeln(' Fcopy v.1.0');
  19.       writeln(' ──────────────────────────────────────────');
  20.       textcolor(15); lowvideo;
  21.  
  22.       writeln(' [Rychle kopirovani souboru] #JS 320011447]');
  23.       writeln;
  24.       assign(f, zdroj);
  25.       assign(temp,cil);
  26.       {$I-} reset(f,1); {$I+}
  27.       if IOresult<>0 then begin
  28.                                write(chr(7));
  29.                                writeln(' Chyba: ',zdroj,' neexistuje!');
  30.                                exit;
  31.                           end;
  32.  
  33.       {$I-}
  34.       rewrite(temp,1);
  35.       {$I+}
  36.       if IOresult<>0 then begin
  37.                                close(f);
  38.                                write(chr(7));
  39.                                writeln(' Chyba - nelze vytvorit cilovy soubor!');
  40.                                exit;
  41.                           end;
  42.  
  43.       {$I-}
  44.       Blockread(f,BufR,BufSize,NR);
  45.       {$I+}
  46.       if IOresult<>0 then begin
  47.                                close(f); close(temp); erase(temp);
  48.                                write(chr(7));
  49.                                writeln(' Doslo k chybe pri cteni!');
  50.                                exit;
  51.                           end;
  52.  
  53.       writeln(' Kopiruji soubor ...');
  54.       repeat
  55.             NW:=NR;
  56.             {$I-}
  57.             BlockWrite(temp,BufR,NW,NR);
  58.             Blockread(f,Bufr,BufSize,NR);
  59.             {$I+}
  60.             if IOresult<>0 then begin
  61.                                      close(f); close(temp); erase(temp);
  62.                                      write(chr(7));
  63.                                      writeln(' Doslo k chybe pri zapisu!');
  64.                                      exit;
  65.                                 end;
  66.       until NR=0;
  67.       close(f); close(temp);
  68.  
  69. end;
  70. BEGIN
  71. END.