如何显示复制文件的进度

Question

如何显示正在复制文件的进度
例如在ProgressBar1上显示

Answer 1

like the windows copy file dialogs..use this api;
Performs a copy, move, rename, or delete operation on a file system object. WINSHELLAPI int WINAPI SHFileOperation(    LPSHFILEOPSTRUCT lpFileOp
   );
 ParameterslpFileOpPointer to an SHFILEOPSTRUCT structure that contains information the function needs to carry out the operation. Return ValuesReturns zero if successful or nonzero if an error occurs. See AlsoSHFILEOPSTRUCT

Answer 2

uses ShellAPI
var
  p:_shfileopstruct;
  a:integer;
begin
  p.Wnd:=handle;
  p.wFunc:=fo_copy
  p.pFrom:='f:\test'#0#0;  //copyf盘的test文件夹
  p.pTo:=nil;
  p.fFlags:=fof_noconfirmation or fof_simpleprogress
  p.fAnyOperationsAborted:=true;
  a:=shfileoperation(p);
end;

Answer 3

http://oldlook.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20788085.html

Answer 4

我做过一个 (只能记得大致意思)
var
  copyfromfile,copytofile:file
  fromfilesize,copyedsize:integer;
  buff:array[0.1024] of char;
begin
  assignfile(copyfromfile,'c:\f.txt'); 
  reset(copyfromfile);
  assignfile(copytofile,'d:\f.txt');
  rewrite(copytofile);
  fromfilesize=filesize(copyfromfile);
  copyedsize=0;
  while not eof(copyfromfile) do
  begin
     blockread(copyfromfile,buff);
     blockwrite(copytofile,buff); 
  end; 
end;

Answer 5

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);
var
  Dir: string;
begin
  Dir := 'D:';
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
//函数执行成功
// sdAllowCreate：允许创建目录
// sdPerformCreate：执行创建目录
// sdPrompt：显示提示信息
    edit1.text:= Dir;
end;procedure TForm1.Button2Click(Sender: TObject);
var
  Dir: string;
begin
  Dir := 'D:';
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
 //解释同上
    edit2.text:= Dir;
end;end.

Answer 6

typedef struct _SHFILEOPSTRUCT { // shfos  
    HWND         hwnd;  //句柄
    UINT         wFunc;  //
    LPCSTR       pFrom; 
    LPCSTR       pTo; 
    FILEOP_FLAGS fFlags; 
    BOOL         fAnyOperationsAborted; 
    LPVOID       hNameMappings; 
    LPCSTR       lpszProgressTitle;   //是否显示进度！
} SHFILEOPSTRUCT, FAR *LPSHFILEOPSTRUCT; 
 unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,shellAPI,filectrl;type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StaticText1: TStaticText;
    StaticText2: TStaticText;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.Button1Click(Sender: TObject);
var
  Dir: string;
begin
  Dir := 'D:';
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
//函数执行成功
// sdAllowCreate：允许创建目录
// sdPerformCreate：执行创建目录
// sdPrompt：显示提示信息
    edit1.text:= Dir;
end;procedure TForm1.Button2Click(Sender: TObject);
var
  Dir: string;
begin
  Dir := 'D:';
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then
 //解释同上
    edit2.text:= Dir;
end;procedure TForm1.Button3Click(Sender: TObject);
var
  OpStruc:TSHFileOpStruct;
  FromBuf,ToBuf:Array[0..128] of Char;
begin
  FillChar(FromBuf,Sizeof(FromBuf),0);
  FillChar(ToBuf,Sizeof(ToBuf),0);
  //用0初始化FromBuf和ToBuf数组
  StrPCopy(FromBuf,Pchar(Edit1.Text));
  StrPCopy(ToBuf,Pchar(Edit2.Text));
  //分别在 FromBuf和ToBuf数组中填入操作的源目录及目标目录
  //开始填充OpStruc记录
  with OpStruc do
  begin
    Wnd:=Handle;
    wFunc:=FO_COPY;
  //复制操作
    pFrom:=@FromBuf;
    pTo:=@ToBuf;
    fFlags:=FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
    fAnyOperationsAborted:=False;
    hNameMappings:=nil;
    lpszProgressTitle:=nil;
  end;
  if SHFileOperation(OpStruc)=0 then
 //函数执行成功
  MessageBox(Handle,'复制完毕。','复制信息',MB_OK+MB_ICONINFORMATION);
end;procedure TForm1.Button4Click(Sender: TObject);
var
  OpStruc:TSHFileOpStruct;
  FromBuf,ToBuf:Array[0..128] of Char;
begin
  FillChar(FromBuf,Sizeof(FromBuf),0);
  FillChar(ToBuf,Sizeof(ToBuf),0);
  StrPCopy(FromBuf,Pchar(Edit1.Text));
  StrPCopy(ToBuf,Pchar(Edit2.Text));
  //开始填充OpStruc记录
  with OpStruc do
  begin
    Wnd:=Handle;
    wFunc:=FO_MOVE;
   //移动操作
    pFrom:=@FromBuf;
    pTo:=@ToBuf;
    fFlags:=FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
    fAnyOperationsAborted:=False;
    hNameMappings:=nil;
    lpszProgressTitle:='正在文件';
  end;
  if SHFileOperation(OpStruc)=0 then
  //执行成功
  MessageBox(Handle,'移动完毕。','移动信息',MB_OK+MB_ICONINFORMATION);
end;procedure TForm1.Button5Click(Sender: TObject);
var
  OpStruc:TSHFileOpStruct;
  FromBuf:Array[0..128] of Char;
begin
  FillChar(FromBuf,Sizeof(FromBuf),0);
  StrPCopy(FromBuf,Pchar(Edit1.Text));
  //开始填充OpStruc记录
  with OpStruc do
  begin
    Wnd:=Handle;
    wFunc:=FO_DELETE;
    pFrom:=@FromBuf;
    pTo:=nil;
    fFlags:=FOF_NOCONFIRMATION;
    lpszProgressTitle:='正在删除';
  end;
  if SHFileOperation(OpStruc)=0 then
  //执行成功
  MessageBox(Handle,'删除完毕。','删除信息',MB_OK+MB_ICONINFORMATION);
end;end.