自做的文件复制函数(用API的FileCopy(...)),在复制大文件时进度条无法正常显示,像死机似的,有没有办法解决。100分。(能做出像Winows的文件

  • 主题发起人 海天子
  • 开始时间

海天子

Unregistered / Unconfirmed
GUEST, unregistred user!
自做的文件复制函数(用API的FileCopy(...)),在复制大文件时进度条无法正常显示,像死机似的,有没有办法解决。100分。(能做出像Winows的文件复制的效果。)(100分)<br />自做的文件复制函数(用API的FileCopy(...)),在复制大文件时进度条无法正常显示,像死机似的,有没有办法解决。100分。(能做出像Winows的文件复制的效果。)
 
uses ShellApi;

function TForm1.Win_Copy(fFROM,fTO:String):boolean;
var FData : TShFileOpStruct;
begin
fTo:=fTo+#0#0;
fFrom:=fFrom+#0#0;
Fdata.pFrom := PChar(fFrom);
fdata.pTo := PChar(fTo);
fdata.wFunc := FO_COPY ;
FData.Wnd := application.Handle ;
fData.lpszProgressTitle := '正在复制';
fData.fFlags := FOF_ALLOWUNDO OR FOF_NOCONFIRMMKDIR;// or FOF_SILENT ;
result:=ShFileOperation( FData ) = 0 ;
end;
 
try
Application.ProcessMessage
 
form上加上一个ProgressBar1控件
procedure TfrmMain.mycopyfile(sourcef, targetf: string);
var
FromF, ToF: file;
NumRead, NumWritten: Integer;
Buf: array[1..2048] of Char;
n: integer;
begin
AssignFile(FromF, sourcef);
Reset(FromF, 1); { Record size = 1 }
AssignFile(ToF, targetf); { Open output file }
Rewrite(ToF, 1); { Record size = 1 }
n := 0;
sb1.Panels[3].Text := '备份数据进度';
repeat
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
ProgressBar1.Position := (sizeof(buf) * n * 100 div FileSize(FromF));
application.ProcessMessages;
//显示进度
BlockWrite(ToF, Buf, NumRead, NumWritten);
inc(n);
until (NumRead = 0) or (NumWritten &lt;&gt; NumRead);
sb1.Panels[3].text := '进度';
ProgressBar1.Position := 0;
CloseFile(FromF);
CloseFile(ToF);
end;
 
你也可以考虑用多线程.
 
还是用Multi_Thread比较好
 
用TFileStream处理,自己控制文件复制进程!
 
只能用多进程
 
能给出个多线程的例子吗?我不想用zw84611的方法,我要的是自做的
 
看看CopyFileEx函数吧
 
参考:

TCopyFile = class(TThread)
public
Percent : Integer;
Done,ToDo : Integer;
ListIndex : integer;
Start : TDateTime;
constructor Create(Src, Dest: String);
private
{ Private declarations }
IName,OName : String;
protected
procedure Execute; override;
procedure CopyProgress;
procedure TotalCopyProgress;
procedure ShowError;
end;

const
sc_DragMove:longint=$F012;
KB1 = 1024;
MB1 = 1024*KB1;
GB1 = 1024*MB1;
// ---------------------------
del_img_set=[22,24,25];
copy_img_set=[22,25];

var
CopyToForm: TCopyToForm;
iCopy,wid:integer;

implementation
uses Main,ShellAPI,FileCtrl,FmxUtils,ShlObj,ActiveX;
{$R *.DFM}

constructor TCopyFile.Create(Src, Dest : String);
begin
IName := Src;
OName := Dest;
Percent := 0;
Start := Now;
FreeOnTerminate := True;
inherited Create(True);
end;

procedure TCopyFile.ShowError;
begin
CopyToForm.CopyListView.items[ListIndex].ImageIndex :=25;
ShowMessage('无法读取源文件'+IName+',此次拷贝将是不完整的,请以后再试。');
end;

procedure TCopyFile.CopyProgress;
begin
with CopyToForm do
begin
//listview1.items[ListIndex].SubItems.BeginUpdate;
CopyListview.items[ListIndex].SubItems[0]:= inttostr(Percent)+'%';
if percent&gt;=100 then CopyListview.items[ListIndex].ImageIndex :=24;
//label4.Caption := '已复制'+ inttostr(Round((ListIndex+1)/listview1.Items.Count*100))+'%';
//listview1.items[ListIndex].SubItems.EndUpdate;
end;
end;

procedure TCopyFile.TotalCopyProgress;
begin
with CopyToForm do
begin
inc(iCopy);
label4.Caption := '已复制'+ inttostr(Round((iCopy)/CopyListview.Items.Count*100))+'%';
caption:='拷贝文件('+label4.Caption+')';
if iCopy=CopyListview.Items.Count then
begin
label4.Caption := '复制完成。';
BtnCancel.Caption :='关闭';
//speedbutton4.Enabled := false;
show;
CopyToForm.WindowState := wsNormal;
//listview1.items[ListIndex].SubItems.EndUpdate;
end;
end;
end;

procedure TCopyFile.Execute;
var
fi,fo : TFileStream;
dod,did : Integer;
cnt,max : Integer;
begin
Start := Now;
//try
{ Open existing destination }
if fileexists(oName) then //断点续传!
begin
try
fo := TFileStream.Create(OName, fmOpenReadWrite);
except on EFOpenError do
begin
{CopyToForm.CopyListView.items[ListIndex].ImageIndex :=25;
ShowMessage('无法读取源文件'+OName+',此次拷贝将是不完整的,请以后再试。'); }
synchronize(ShowError);
exit;
end;
end;//end of try
fo.Position:=fo.size;
end
//except
{ otherwise Create destination }
else fo := TFileStream.Create(OName, fmCreate);
//end;
try
{ open source }
try
fi := TFileStream.Create(IName, fmOpenRead);
except on EFOpenError do
begin
synchronize(ShowError);
exit;
end;
end;//end of try

try
{ synchronise dest en src }
cnt:= fo.Position;
fi.Position := cnt;
max := fi.Size;
ToDo := Max-cnt;
Done := 0;
did:=0; // zw
{ start copying }
Repeat
dod := KB1; // Block size
if cnt+dod&gt;max then dod := max-cnt;
try
if dod&gt;0 then did := fo.CopyFrom(fi, dod);
except on EReadError do
begin
{CopyToForm.CopyListView.items[ListIndex].ImageIndex :=25;
ShowMessage('无法读取源文件'+OName+',此次拷贝将是不完整的,请以后再试。');}
synchronize(ShowError);
exit;
end
end; // end of try
cnt:=cnt+did;
Percent := Round(Cnt/Max*100);
synchronize(CopyProgress);
Done := Done+did;
ToDo := Max;
until (dod=0) or (Terminated);

finally
fi.free;
end;
finally
fo.free;
end;
synchronize(TotalCopyProgress);
end;

这个方法实际上支持断点序传哟(用于局域网中文件复制时特别有用)
 
多人接受答案了。
 
多人接受答案了。
 
顶部