unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
CancelCopy: Boolean;
implementation
function CopyFileProgress(TotalFileSize, TotalBytesTransferred, StreamSize,
StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, dwCallbackReason,
hSourceFile, hDestinationFile, lpData: DWORD): DWORD; stdcall;
begin
Application.ProcessMessages;
if CancelCopy = True then
begin
ShowMessage('Cancelado');
result := PROGRESS_CANCEL;
Exit;
end;
case dwCallbackReason of
CALLBACK_CHUNK_FINISHED:
begin
Form1.ProgressBar1.Position := TotalBytesTransferred.QuadPart;
result := PROGRESS_CONTINUE;
end;
CALLBACK_STREAM_SWITCH:
begin
Form1.ProgressBar1.Max := TotalFileSize.QuadPart;
result := PROGRESS_CONTINUE;
end;
end;
end;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Cancel: PBOOL;
origen,destino:string;
begin
CancelCopy := False;
Cancel := nil;
origen:='C:\miruta\archivo.dat';
destino:='C:\miotraruta\archivo.dat';
CopyFileEx(pChar(origen), pChar(destino),@CopyFileProgress, nil, Cancel, 0);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
CancelCopy := True;
end;
end.