Author: Lou Adler

How to copy a file using a TFileStream 

Answer:

1   { ... }
2   type
3     TFileCopyUpdateEvent = procedure(const SrcFile, DestFile: string;
4       CurrentPos, MaxSize: Integer) of object;
5   
6   function Min(Val1, Val2: Integer): Integer;
7   begin
8     Result := Val1;
9     if Val2 < Val1 then
10      Result := Val2;
11  end;
12  
13  {SrcFile and DestFile are the fully qualified filenames to the files to copy 
14  function}
15  
16  MyFileCopy(SrcFile, DestFile: TFilename; OnUpdate: TFileCopyUpdateEvent = nil):
17    Boolean;
18  const
19    StreamBuf = 4096;
20  var
21    Src, Dst: TFileStream;
22    BufCount: Integer;
23  begin
24    Src := nil;
25    Dst := nil; {prevents .Free problems on exception}
26    {allow everyone else any access}
27    Src := TFileStream.Create(SrcFile, fmOpenRead or fmShareDenyNone);
28    if FileExists(DestFile) then
29      {this could cause an error if a user has the file open}
30      Dst := TFileStream.Create(DestFile, fmOpenWrite or fmShareExclusive)
31    else
32      Dst := TFileStream.Create(DestFile, fmCreate or fmShareExclusive);
33    try
34      while Dst.Position < Dst.Size do
35      begin
36        BufCount := Min(StreamBuf, Dst.Size - Dst.Position);
37        Src.CopyFrom(Dst, BufCount);
38        if Assigned(OnUpdate) then {report progress every 4k}
39          OnUpdate(SrcFile, DestFile, Dst.Position, Dst.Size);
40      end;
41    finally
42      Src.Free;
43      Dst.Free;
44    end;
45  end;