2010. február 10., szerda

Copy a file using a TFileStream


Problem/Question/Abstract:

How to copy a file using a TFileStream

Answer:

{ ... }
type
  TFileCopyUpdateEvent = procedure(const SrcFile, DestFile: string;
    CurrentPos, MaxSize: Integer) of object;

function Min(Val1, Val2: Integer): Integer;
begin
  Result := Val1;
  if Val2 < Val1 then
    Result := Val2;
end;

{SrcFile and DestFile are the fully qualified filenames to the files to copy function}

MyFileCopy(SrcFile, DestFile: TFilename; OnUpdate: TFileCopyUpdateEvent = nil):
  Boolean;
const
  StreamBuf = 4096;
var
  Src, Dst: TFileStream;
  BufCount: Integer;
begin
  Src := nil;
  Dst := nil; {prevents .Free problems on exception}
  {allow everyone else any access}
  Src := TFileStream.Create(SrcFile, fmOpenRead or fmShareDenyNone);
  if FileExists(DestFile) then
    {this could cause an error if a user has the file open}
    Dst := TFileStream.Create(DestFile, fmOpenWrite or fmShareExclusive)
  else
    Dst := TFileStream.Create(DestFile, fmCreate or fmShareExclusive);
  try
    while Dst.Position < Dst.Size do
    begin
      BufCount := Min(StreamBuf, Dst.Size - Dst.Position);
      Src.CopyFrom(Dst, BufCount);
      if Assigned(OnUpdate) then {report progress every 4k}
        OnUpdate(SrcFile, DestFile, Dst.Position, Dst.Size);
    end;
  finally
    Src.Free;
    Dst.Free;
  end;
end;

Nincsenek megjegyzések:

Megjegyzés küldése