Copy a file with or without a progressbar (Views: 29)
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; |