home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / files / filecopy / filecopy.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-05-04  |  4.4 KB  |  123 lines
  1. {****************************************************************
  2.  
  3.   FileCopy - A unit to copy one file into another
  4.   Version 1.1  4/20/88
  5.   by Richard S. Sadowsky
  6.   CIS 74017,1670
  7.  
  8.   Released as is to the public domain, use at your own risk!
  9.  
  10.   Uploaded because "how do I copy a file" is a relatively common
  11.   question in BPROGA.  This unit takes full advantage of the DOS
  12.   unit, using GetFTime and SetFTime to set the destination
  13.   file's time/date stamp to be the same as that of the source.
  14.  
  15.   Mods:
  16.   date    |  ver  |  by  |   modifications
  17.   =============================================
  18.   4/20/88    1.1    RSS    fixed final Reset which neglected to clear
  19.                            IOResult.  Also will not try to set time/date
  20.                            Attribute of dest file if error occurred in copy.
  21.  
  22. ****************************************************************}
  23.  
  24. {$I-,V-,S-,R-} { It is required to turn off abort on I/O error with $I- }
  25. Unit FileCopy;
  26.  
  27. interface
  28.  
  29. uses DOS;
  30.  
  31. type
  32.   Path             = String[70]; { to store filespecs }
  33.  
  34. function File_Copy_Buf(Source,Dest : Path;
  35.                        BufPtr : Pointer; BufferSize : Word) : Word;
  36. {
  37.   Copies file specified by Source into file specified by Dest using a
  38.   buffer BufferSize bytes in size and pointed to by BufPtr.  The function
  39.   result is the error code. If the error code is zero, then the file was
  40.   successfully copied.  The filenames may optionally include drive and/or
  41.   pathnames.  If the destination file already exists, it will be
  42.   overwritten.  If ErrorCode nonzero, then it is the IOResult value
  43.   that signaled the error.  A special value of $FFFF indicates
  44.   that the destination disk filled before the entire file was copied.
  45.   I would suggest that you delete the destination file if an error
  46.   occurs and the destination file was created (like a read/write
  47.   or disk full error) since this routine will not do that for you.
  48. }
  49.  
  50. function File_Copy(Source,Dest : Path; BufferSize : Word) : Word;
  51. {
  52.   Same as File_Copy_Buf except automatically allocates a buffer of
  53.   BufferSize bytes on the heap, so no pointer need be passed.
  54. }
  55.  
  56. implementation
  57.  
  58. function File_Copy_Buf(Source,Dest : Path;
  59.                        BufPtr : Pointer; BufferSize : Word) : Word;
  60.  
  61. var
  62.   InF,OutF         : File;    { the input and output files }
  63.   ErrorCode,Num,N  : Word;    { a few words }
  64.   Time             : LongInt; { to hold time/date stamp }
  65.  
  66. begin
  67.   Assign(InF,Source);
  68.   Reset(InF,1);           { open the source file }
  69.   ErrorCode := IOResult;
  70.   GetFTime(InF,Time);     { get time/date stamp from source file }
  71.   if ErrorCode = 0 then begin
  72.     Assign(OutF,Dest);
  73.     Rewrite(OutF,1);      { Create destination file }
  74.     ErrorCode := IOResult;
  75.     { copy loop }
  76.     while (not EOF(InF)) and (ErrorCode = 0) do begin
  77.       BlockRead(InF,BufPtr^,BufferSize,Num); { read a buffer full from source }
  78.       ErrorCode := IOResult;
  79.       if ErrorCode = 0 then begin
  80.         BlockWrite(OutF,BufPtr^,Num,N);      { write it to destintion }
  81.         ErrorCode := IOResult;
  82.         if N < Num then
  83.           ErrorCode := $FFFF;   { disk probably full }
  84.       end;
  85.     end;
  86.   end;
  87.  
  88.   { error detection and reporting could be alot better, }
  89.   { but what do ya want for nothin? }
  90.  
  91.   { try to close the files no matter what to make sure handles are freed }
  92.   Close(OutF);      { Close destination file }
  93.   if IOresult <> 0 then ;   { clear IOResult }
  94.   Close(InF);       { close source file }
  95.   if IOresult <> 0 then ;   { clear IOResult }
  96.   if ErrorCode = 0 then begin
  97.     Assign(OutF,Dest);
  98.     Reset(OutF);
  99.     if IOResult <> 0 then ;  { clear IOResult }
  100.     SetFTime(OutF,Time);     { Set time/date stamp of dest to that of source }
  101.     Close(OutF);
  102.     if IOresult <> 0 then ;  { clear IOResult }
  103.   end;
  104.   File_Copy_Buf := ErrorCode;
  105. end;
  106.  
  107. function File_Copy(Source,Dest : Path; BufferSize : Word) : Word;
  108. { shell around File_Copy_Buf to automatically allocate a buffer of }
  109. { BufferSize on the heap }
  110. var
  111.   Buf              : Pointer;
  112.  
  113. begin
  114.   if BufferSize > 65521 then
  115.     BufferSize := 65521;  { user specified buffer bigger than possible }
  116.                           { so scale it down }
  117.   GetMem(Buf,BufferSize); { allocate memory for the buffer }
  118.   File_Copy := File_Copy_Buf(Source,Dest,Buf,BufferSize);
  119.   FreeMem(Buf,BufferSize); { deallocate heap space for buffer }
  120. end;
  121.  
  122. end.
  123.