Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Trucos (https://www.clubdelphi.com/foros/forumdisplay.php?f=52)
-   -   Copiar archivos con barra de Progreso (https://www.clubdelphi.com/foros/showthread.php?t=80820)

MaMu 25-07-2007 07:31:33

Copiar archivos con barra de Progreso
 
Dado que siempre hay alguien que busca como copiar archivos con barra de progreso (Progressbar), aqui les dejo un ejemplo de uso de la WinApi CopyFileEx.
Si lo quieren probar, creen un formulario y ponga 2 botones y una barra de progreso, las demas cosas queda a criterio del lector.

Código Delphi [-]
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
    { Private declarations }
  public
    { Public declarations }
  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}

//Ejemplo de llamada y copia
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;

//Cancelamos la copia
procedure TForm1.Button2Click(Sender: TObject);
begin
  CancelCopy := True;
end;

end.

cHackAll 12-08-2007 01:34:09

El uso de un ProgressBar con el tamaño total de un archivo funciona siempre y cuando éste no sobrepase los 2147483647 bytes, (~2 Gb), dejo mis correcciónes aconsejando usar un hilo para no "perjudicar" al hilo principal:

Código Delphi [-]
...

implementation

{$R *.dfm}

var Cancel: LongBool;

function ProgressRoutine(TotalFileSize, TotalBytesTransferred, StreamSize, StreamBytesTransferred: Int64; dwStreamNumber, dwCallbackReason, hSourceFile, hDestinationFile: Cardinal; lpData: Pointer): Cardinal; stdcall;
var Value: Cardinal;
begin
 Application.ProcessMessages;
 case dwCallbackReason of
  CALLBACK_CHUNK_FINISHED: Form1.ProgressBar1.Position := (TotalBytesTransferred * 100) div TotalFileSize;
//  CALLBACK_STREAM_SWITCH: Form1.ProgressBar1.Max := 100;
 end;
 Result := PROGRESS_CONTINUE;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 CopyFileEx('F:\DVD\Prince of Persia\Prince of Persia (The two thrones).mdf', 'e:\Dummy.mdf', @ProgressRoutine, nil, @Cancel, 0);
 ShowMessage(SysErrorMessage(GetLastError));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Cancel := True;
end;

end.


La franja horaria es GMT +2. Ahora son las 12:19:44.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi