Mirror

Copy a file with or without a progressbar (Views: 100)


Problem/Question/Abstract:

How to COPY a file with or without a progressbar

Answer:

function FileCopy(const SourceFile, TargetFile: string): Boolean; overload;
function FileCopy(const SourceFile, TargetFile: string; PB: TProgressBar): Boolean;
  overload;

function FileCopy(const SourceFile, TargetFile: string): Boolean;
begin
  Result := FileCopy(SourceFile, TargetFile, nil);
end;

function FileCopy(const SourceFile, TargetFile: string; PB: TProgressBar):
  Boolean;
const
  BlockSize = 1024 * 16;
var
  FSource, FTarget: Integer;
  BRead, Bwrite: Word;
  Buffer: Pointer;
begin
  Result := False;

  FSource := FileOpen(SourceFile, fmOpenRead + fmShareDenyNone); { Open Source }

  if FSource >= 0 then
  try
    if Assigned(PB) then
    begin
      PB.Position := 0;
      pb.Min := 0;
      pb.Max := (FileSeek(FSource, 0, 2));
      if (pb.Max > 2048) then
        pb.Step := pb.Max div 2048
      else
        pb.Step := pb.Max;
      FileSeek(FSource, 0, 0);
    end;
    FTarget := FileCreate(TargetFile); { Open Target }
    try
      getmem(Buffer, BlockSize);
      try
        FileSeek(FSource, 0, soFromBeginning);
        repeat

          BRead := FileRead(FSource, Buffer^, BlockSize);

          if assigned(PB) then
            PB.StepIt;

          BWrite := FileWrite(FTarget, Buffer^, Bread);

          if assigned(PB) then
            PB.StepIt;

        until (Bread = 0) or (Bread <> BWrite);
        if Bread = Bwrite then
        begin
          Result := True;
          if assigned(PB) then
            PB.Position := PB.Max;
        end;
      finally
        freemem(Buffer, BlockSize);
      end;
      FileSetDate(FTarget, FileGetDate(FSource));
    finally
      FileClose(FTarget);
    end;
  finally
    FileClose(FSource);
  end;
end;

<< Back to main page