CopyFileEx

[Luckie]

Threads wären besser:

Delphi-Quellcode:

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.WParam + Msg.LParam;
      end;
    CEXM_CONTINUE:
      begin
        Progressbar1.Position := Msg.WParam + Msg.LParam;
        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;

Ungefähr so.