...copy a file using a progressbar?

Author: Thomas Stutz

Homepage: http://www.swissdelphicenter.ch

{ 1. }

{

You need a TProgressBar on your form for this tip.

Für diesen Tip wird eine TProgressBar benötigt.

}

procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);

var

FromF, ToF: file of byte;

Buffer: array[0..4096] of char;

NumRead: integer;

FileLength: longint;

begin

AssignFile(FromF, Source);

reset(FromF);

AssignFile(ToF, Destination);

rewrite(ToF);

FileLength := FileSize(FromF);

with Progressbar1 do

begin

Min := 0;

Max := FileLength;

while FileLength > 0 do

begin

BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);

FileLength := FileLength - NumRead;

BlockWrite(ToF, Buffer[0], NumRead);

Position := Position + NumRead;

end;

CloseFile(FromF);

CloseFile(ToF);

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

CopyFileWithProgressBar1('c:\Windows\Welcome.exe', 'c:\temp\Welcome.exe');

end;

{ 2. }

{***************************************}

// To show the estimated time to copy a file:

procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string);

var

FromF, ToF: file of byte;

Buffer: array[0..4096] of char;

NumRead: integer;

FileLength: longint;

t1, t2: DWORD;

maxi: integer;

begin

AssignFile(FromF, Source);

reset(FromF);

AssignFile(ToF, Destination);

rewrite(ToF);

FileLength := FileSize(FromF);

with Progressbar1 do

begin

Min := 0;

Max := FileLength;

t1 := TimeGetTime;

maxi := Max div 4096;

while FileLength > 0 do

begin

BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);

FileLength := FileLength - NumRead;

BlockWrite(ToF, Buffer[0], NumRead);

t2 := TimeGetTime;

Min := Min + 1;

// Show the time in Label1

label1.Caption := FormatFloat('0.00', ((t2 - t1) / min * maxi - t2 + t1) / 100);

Application.ProcessMessages;

Position := Position + NumRead;

end;

CloseFile(FromF);

CloseFile(ToF);

end;

end;

{ 3. }

{***************************************}

// To show the estimated time to copy a file, using a callback function:

type

TCallBack = procedure(Position, Size: Longint); { export; }

procedure FastFileCopy(const InFileName, OutFileName: string;

CallBack: TCallBack);

implementation

procedure FastFileCopyCallBack(Position, Size: Longint);

begin

Form1.ProgressBar1.Max := Size;

Form1.ProgressBar1.Position := Position;

end;

procedure FastFileCopy(const InFileName, OutFileName: string;

CallBack: TCallBack);

const

BufSize = 3 * 4 * 4096; { 48Kbytes gives me the best results }

type

PBuffer = ^TBuffer;

TBuffer = array[1..BufSize] of Byte;

var

Size: DWORD;

Buffer: PBuffer;

infile, outfile: file;

SizeDone, SizeFile: LongInt;

begin

if (InFileName <> OutFileName) then

begin

buffer := nil;

Assign(infile, InFileName);

Reset(infile, 1);

try

SizeFile := FileSize(infile);

Assign(outfile, OutFileName);

Rewrite(outfile, 1);

try

SizeDone := 0;

New(Buffer);

repeat

BlockRead(infile, Buffer^, BufSize, Size);

Inc(SizeDone, Size);

CallBack(SizeDone, SizeFile);

BlockWrite(outfile, Buffer^, Size)

until Size < BufSize;

FileSetDate(TFileRec(outfile).Handle,

FileGetDate(TFileRec(infile).Handle));

finally

if Buffer <> nil then

Dispose(Buffer);

CloseFile(outfile)

end;

finally

CloseFile(infile);

end;

end

else

raise EInOutError.Create('File cannot be copied onto itself')

end; {FastFileCopy}

procedure TForm1.Button1Click(Sender: TObject);

begin

FastFileCopy('c:\daten.txt', 'c:\test\daten2.txt', @FastFileCopyCallBack);

end;

{ 4. }

{***************************************}

function CopyFileWithProgressBar2(TotalFileSize,

TotalBytesTransferred,

StreamSize,

StreamBytesTransferred: LARGE_INTEGER;

dwStreamNumber,

dwCallbackReason: DWORD;

hSourceFile,

hDestinationFile: THandle;

lpData: Pointer): DWORD; stdcall;

begin

// just set size at the beginning

if dwCallbackReason = CALLBACK_STREAM_SWITCH then

TProgressBar(lpData).Max := TotalFileSize.QuadPart;

TProgressBar(lpData).Position := TotalBytesTransferred.QuadPart;

Application.ProcessMessages;

Result := PROGRESS_CONTINUE;

end;

function TForm1.CopyWithProgress(sSource, sDest: string): Boolean;

begin

// set this FCancelled to true, if you want to cancel the copy operation

FCancelled := False;

Result := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2,

ProgressBar1, @FCancelled, 0);

end;

end;