type
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure WndProc(var Msg: TMessage); override;
end;
var
Form1 : TForm1;
implementation
{$R *.dfm}
type
TCopyEx = packed record
Source: String[255];
Dest: String[255];
Handle: THandle;
end;
PCopyEx = ^TCopyEx;
const
CEXM_CANCEL = WM_USER + 1;
CEXM_CONTINUE = WM_USER + 2; // wParam: lopart, lParam: hipart
CEXM_MAXBYTES = WM_USER + 3; // wParam: lopart; lParam: hipart
var
CancelCopy : Boolean = False;
function CopyFileProgress(TotalFileSize, TotalBytesTransferred, StreamSize,
StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber, dwCallbackReason,
hSourceFile, hDestinationFile: DWORD; lpData: Pointer): DWORD; stdcall;
begin
if CancelCopy = True then
begin
SendMessage(THandle(lpData), CEXM_CANCEL, 0, 0);
result := PROGRESS_CANCEL;
exit;
end;
case dwCallbackReason of
CALLBACK_CHUNK_FINISHED:
begin
SendMessage(THandle(lpData), CEXM_CONTINUE, TotalBytesTransferred.LowPart, TotalBytesTransferred.HighPart);
result := PROGRESS_CONTINUE;
end;
CALLBACK_STREAM_SWITCH:
begin
SendMessage(THandle(lpData), CEXM_MAXBYTES, TotalFileSize.LowPart, TotalFileSize.HighPart);
result := PROGRESS_CONTINUE;
end;
else
result := PROGRESS_CONTINUE;
end;
end;
procedure TForm1.WndProc(var Msg: TMessage);
begin
inherited;
case Msg.Msg of
CEXM_MAXBYTES:
begin
ProgressBar1.Max := (Msg.LParam) shl 32) + Msg.WParam;
end;
CEXM_CONTINUE:
begin
Progressbar1.Position := (Int64(Msg.LParam) shl 32) + Msg.WParam;
Caption := IntToStr(Msg.WParam + Msg.LParam);
end;
CEXM_CANCEL:
begin
Progressbar1.Position := 0;
Caption := '0';
end;
end;
end;
function CopyExThread(p: PCopyEx): Integer;
var
Source: String;
Dest: String;
Handle: THandle;
Cancel : PBool;
begin
Source := p.Source;
Dest := p.Dest;
Handle := p.Handle;
Cancel := PBOOL(False);
CopyFileEx(PChar(Source), PChar(Dest), @CopyFileProgress, Pointer(Handle), Cancel, 0);
Dispose(p);
result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Params: PCopyEx;
ThreadID: Cardinal;
begin
cancelCopy := False;
New(Params);
Params.Source := 'H:\Videos ungebrannt\Gwen Stefani - rich girl.mpeg';
Params.Dest := 'H:\test.mpeg';
Params.Handle := Handle;
CloseHandle(BeginThread(nil, 0, @CopyExThread, Params, 0, ThreadID));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
CancelCopy := True;
end;
Sind die Daten gr��er als 2 GB und �berschreiten somit den Bereich vom Datentyp Integer, wird es erforderlich die Daten zum Anzeigen in der Progressbar in Prozent umzurechnen, da ProgressBar.Max als Integer deklariert ist.