hackbard: Copy file with ProgressBar Callback

Viele Programme benutzen eine ProgressBar, um den Status eines Prozesses oder eines Kopiervorganges darzustellen. Doch oftmals stimmen der Prozess und der Status der ProgressBar nicht überein. Das kommt davon, weil die ProgressBar nicht den Status des Kopiervorgangs kennt.

Hier sind vier Beispiele wie man der ProgressBar das übermittelt, um den exakten Status zu bekommen.

Es wird benötigt: 1xProgressBar

Beispiel 1 :

// So zeigen Sie die exakte Zeit zum Kopieren einer Datei an:

private
    { Private declarations }
    procedure CopyFileWithProgressBar1(Source, Destination: string);
    
//


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;

Beispiel 2 :

// So zeigen Sie die Zeit zum Kopieren einer Datei an:

uses ExtCtrls, ComCtrls, MMsystem

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;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CopyFileWithProgressBar1('c:\Welcome.exe', 'c:\Welcome.exe');
end;

Beispiel 3 :

// So zeigen Sie die Zeit zum Kopieren einer Datei mithilfe einer Rückruffunktion an:

uses ExtCtrls, ComCtrls

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

procedure FastFileCopy(const InFileName, OutFileName: string;
  CallBack: TCallBack);

//

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;

Beispiel 4 :

// So zeigen Sie die exakte Zeit zum Kopieren mit einer funktion einer Datei an:

private
    { Private declarations }
    function CopyWithProgress(sSource, sDest: string): Boolean;

var
  Form1: TForm1;
  FCancelled : Boolean;

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;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CopyWithProgress('c:\1.txt', 'c:\2.txt');
end;

Eine weitere Methode :

Hier ist ein Beispiel, wie man einer ProgressBar den exakten Kopierstatus einer Datei übermittelt, unabhängig von dem, was auf dem System passiert oder wie groß die zu kopierende Datei ist.

uses ExtCtrls, ComCtrls

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
        ProgressBar.Max := (Int64(Msg.LParam) shl 32) + Msg.WParam;
      end;
    CEXM_CONTINUE:
      begin
        Progressbar.Position := (Int64(Msg.LParam) shl 32) + Msg.WParam;
        LabelAmountCopied.Caption := 'Copy: '
                                   + FormatFileSize(Msg.WParam + Msg.LParam);
      end;
    CEXM_CANCEL:
    begin
      Progressbar.Position := 0;
      LabelAmountCopied.Caption := 'Copy: 0 B';
    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.ButtonCopyClick(Sender: TObject);
var
  Params: PCopyEx;
  ThreadID: Cardinal;
begin
  cancelCopy := False;
  New(Params);
  Params.Source := EditOriginal.Text;
  Params.Dest := EditCopied.Text;
  Params.Handle := Handle;
  CloseHandle(BeginThread(nil, 0, @CopyExThread, Params, 0, ThreadID));
end;

procedure TForm1.EditCopiedClick(Sender: TObject);
begin
  SaveDialog1.InitialDir := ExtractFilePath(ParamStr(0));
  if not SaveDialog1.Execute then Exit;
  EditCopied.Text := SaveDialog1.FileName;
end;

procedure TForm1.EditOriginalClick(Sender: TObject);
begin
  OpenDialog1.InitialDir := ExtractFilePath(ParamStr(0));
  if not OpenDialog1.Execute then Exit;
  EditOriginal.Text := OpenDialog1.FileName;
end;

function TForm1.FormatFileSize(Size: extended): string;
begin
  if Size = 0 then
  begin
    Result := '0 B';
  end
  else if Size < 1000 then
  begin
    Result := FormatFloat('0', Size) + ' B';
  end
  else
  begin
    Size := Size / 1024;
    if (Size < 1000) then
    begin
      Result := FormatFloat('0.0', Size) + ' KB';
    end
    else
    begin
      Size := Size / 1024;
      if (Size < 1000) then
      begin
        Result := FormatFloat('0.00', Size) + ' MB';
      end
      else
      begin
        Size := Size / 1024;
        if (Size < 1000) then
        begin
          Result := FormatFloat('0.00', Size) + ' GB';
        end
        else
        begin
          Size := Size / 1024;
          if (Size < 1024) then
          begin
            Result := FormatFloat('0.00', Size) + ' TB';
          end
        end
      end
    end
  end;
end;

procedure TForm1.ButtonCancelClick(Sender: TObject);
begin
  CancelCopy := True;
end;

hackbard

Copy file with ProgressBar Callback

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate