home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / win-os2.swg / 0024_Windows File Copy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-03  |  2.8 KB  |  141 lines
  1. Unit Fcopy;
  2.  
  3. Interface
  4.  
  5. {copy file: return TRUE is successful or FALSE if something
  6.  went wrong}
  7.  Function COPYFILE(Source, Target : String) : Boolean;
  8.  
  9.  
  10. Implementation
  11. uses
  12. wintypes, winprocs, windos;
  13.  
  14.  
  15. {--- buffer for file copy -------}
  16. Type
  17. CopyBuf = Array[1..32768] of Byte;  {32kb buffer!}
  18.  
  19. Var
  20. Buffers : CopyBuf;                 {pointer for buffer}
  21.  
  22.  
  23. {------------------ Print an Error Message -------------}
  24. Procedure ErrorMessage(Title,Msg : PChar);
  25. Begin
  26.   MessageBox(GetFocus,Msg,Title,mb_IconExclamation+mb_OK);
  27. End;
  28.  
  29.  
  30. {--------- copy from Source to Target ---------}
  31. Function COPYFILE(Source, Target : String) : Boolean;
  32.  
  33. Var
  34. SourceFile,TargetFile   : File;
  35. BytesRead,
  36. BytesWritten  : Integer;
  37.  
  38. TotalRead,      {bytes from source file}
  39. TotalWritten,   {bytes from target file}
  40.  
  41. OldTime       : LongInt;
  42.  
  43.  
  44. Begin {CopyFile}
  45.  
  46.    CopyFile  := False;
  47.  
  48.    If Source = Target then
  49.    begin
  50.      ErrorMessage(' ERROR ',' Same Source and Target files! ');
  51.      exit;
  52.    end;
  53.  
  54.  
  55.    Assign(SourceFile,Source);
  56.  
  57.    {$I-}
  58.    Reset(SourceFile,1);
  59.    {$I+}
  60.  
  61.    if IORESULT <> 0 then
  62.    begin
  63.      ErrorMessage(' ERROR ',' I am unable to open the source file');
  64.      exit;
  65.    end;
  66.  
  67.  
  68.     Assign(TargetFile,Target);
  69.  
  70.     {$I-}
  71.       Rewrite(TargetFile,1);
  72.     {I+}
  73.  
  74.      if ioresult <> 0 then
  75.       begin
  76.         ErrorMessage(' ERROR ',' I am unable to create the target file ');
  77.         Close(SourceFile);
  78.         EXIT;
  79.       end;
  80.  
  81.  
  82.       GetFTime(SourceFile,OldTime);  {* get the old time & date stamp *}
  83.  
  84.       New(Buffers);
  85.       TotalRead    := 0;
  86.       TotalWritten := 0;
  87.  
  88.  
  89.      {$I-}
  90.       While not Eof(SourceFile) do
  91.       begin
  92.          BlockRead(SourceFile,  Buffers, Sizeof(Buffers), BytesRead);
  93.          BlockWrite(TargetFile, Buffers, BytesRead, BytesWritten);
  94.  
  95.          Inc(TotalRead,    BytesRead);    {monitor the total size}
  96.          Inc(TotalWritten, BytesWritten); {of bytes being copied}
  97.       end;
  98.      {$I+}
  99.  
  100.      if ioresult <> 0 then
  101.       begin
  102.         ErrorMessage(' ERROR ',' Error encountered during file copy ');
  103.         Dispose(Buffers);
  104.  
  105.         {$I-}
  106.         Close(SourceFile);
  107.         Close(TargetFile);
  108.         {$I+} If IoResult <> 0 Then {leave anyway};
  109.  
  110.         EXIT;
  111.       end;
  112.  
  113.  
  114.       {$I-}
  115.         Close(SourceFile);
  116.         SetFTime(TargetFile, OldTime);  {* reset the date and time *}
  117.         Close(TargetFile);
  118.       {$I+} If IoResult <> 0 Then {};
  119.  
  120.  
  121.      Dispose(Buffers);
  122.  
  123.      If TotalRead <> TotalWritten
  124.      Then {mismtach in bytes read and copied}
  125.      begin
  126.        ErrorMessage('ERROR',
  127.        ' Discrepancies exist in the source and target file sizes!');
  128.  
  129.        Exit;
  130.      end;
  131.  
  132.  
  133.      {if we get here, all went well}
  134.  
  135.      CopyFile := True;
  136.  
  137. End; {copyfile}
  138.  
  139. End.
  140.  
  141.