Delphi 2010 - Overbyte ICS FTP 上传进度条
Delphi 2010 - Overbyte ICS FTP upload with progress bar
我正在使用 ICS Overbyte FTP 上传文件。我想显示一个进度条和一个速度指示器,以便跟踪和估计大文件上传。我怎样才能做到这一点?
此外,上传完成后,我想从我的硬盘中删除该文件。
这是我现在用来上传到 ftp 服务器的代码。
procedure TForm1.Button1Click(Sender: TObject);
var ftp:Tftpclient;
begin
Ftp:=Tftpclient.Create(NIL);
Ftp.UserName:='';
Ftp.PassWord:='';
Ftp.HostName:='';
Ftp.LocalFileName:='d:\fpc-2.6.4.i386-win32.exe';
Ftp.HostDirName:='/';
Ftp.HostFileName := extractfilename(ftp.LocalFileName);
ftp.BandwidthLimit:=0;
Ftp.Passive := True;
FTP.Binary := True;
ftp.MultiThreaded:=true;
try
ftp.connect;
if ftp.Connected then
begin
memo1.lines.add(datetimetostr(now)+' - connected to '+ftp.hostname+' => '+ftp.LastResponse);
Ftp.put;
memo1.lines.add(datetimetostr(now)+' - loading file "'+ftp.hostfilename+'" => '+ftp.LastMultiResponse);
Ftp.Quit;
memo1.Lines.Add(datetimetostr(now)+' - closing connection =>'+ftp.lastResponse);
end;
finally
ftp.free;
end;
end;
谢谢!
TFtpClient
有一个 OnProgress
/OnProgress64
事件:
OnProgress: Display the current file transfer progression.
property OnProgress : procedure(Sender : TObject; Count : LongInt; var Abort : Boolean) of object;
Unit
FtpCli
您需要创建 TFtpClient
对象并为其分配事件处理程序,然后您可以执行 Put()
命令并接收有关上传的状态。
procedure TForm1.Log(const S: String);
begin
Memo1.Lines.Add(DateTimeToStr(Now) + ' - ' + S);
Memo1.Update;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Ftp: TFtpClient;
begin
Ftp := TFtpclient.Create(nil);
try
Ftp.OnProgress := FtpProgress;
Ftp.UserName := ...;
Ftp.PassWord := ...;
Ftp.HostName := ...;
Ftp.LocalFileName := 'D:\fpc-2.6.4.i386-win32.exe';
Ftp.HostDirName := '/';
Ftp.HostFileName := ExtractFileName(Ftp.LocalFileName);
Ftp.BandwidthLimit := 0;
Ftp.Passive := True;
Ftp.Binary := True;
Ftp.MultiThreaded := true;
Log('connecting to ' + Ftp.HostName);
if not Ftp.Connect then
begin
Log('unable to connect to ' + Ftp.HostName + ' => ' + Ftp.LastResponse);
Exit;
end;
try
Log('connected to ' + Ftp.HostName);
Log('uploading file "' + Ftp.HostFileName + '");
if Ftp.Put then begin
Log('uploaded file "' + Ftp.HostFileName + '"');
end else begin
Log('unable to upload file "' + Ftp.HostFileName + '" => ' + Ftp.LastMultiResponse);
end;
finally
Log('closing connection');
Ftp.Quit;
end;
finally
Ftp.Free;
end;
end;
procedure TForm1.FtpProgress(Sender : TObject; Count : LongInt; var Abort : Boolean);
begin
// calculate size transmitted/remaining, speed, and time remaining as needed...
end;
如果您在异步模式下使用 TFtpClient
,还要为 OnRequestDone
事件分配一个处理程序,并且在一切完成之前不要释放该对象。
OnRequestDone: Trigged when a command is completed.
property OnRequestDone : procedure(Sender : TObject; RqType : TFtpRequest; Error : Word) of object;
Unit
FtpCli
Description
When an command is completed, this event is called. Use this event to know when an async command is completed and then call the next one.
var
Ftp: TFtpClient = nil;
procedure TForm1.Log(const S: String);
begin
Memo1.Lines.Add(DateTimeToStr(Now) + ' - ' + S);
Memo1.Update;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Ftp = nil then
begin
Ftp := TFtpClient.Create(Self);
Ftp.OnProgress := FtpProgress;
Ftp.OnRequestDone := FtpRequestDone;
end;
Ftp.UserName := ...;
Ftp.PassWord := ...;
Ftp.HostName := ...;
Ftp.LocalFileName := 'D:\fpc-2.6.4.i386-win32.exe';
Ftp.HostDirName := '/';
Ftp.HostFileName := ExtractFileName(Ftp.LocalFileName);
Ftp.BandwidthLimit := 0;
Ftp.Passive := True;
Ftp.Binary := True;
Ftp.MultiThreaded := true;
Log('connecting to ' + Ftp.HostName);
Ftp.ConnectAsync;
end;
procedure TForm1.FtpProgress(Sender : TObject; Count : LongInt; var Abort : Boolean);
begin
// calculate size transmitted/remaining, speed, and time remaining as needed...
end;
procedure TForm1.FtpRequestDone(Sender : TObject; RqType : TFtpRequest; Error : Word);
begin
case RqType of
ftpConnectAsync: begin
if Error = 0 then begin
Log('connected to ' + Ftp.HostName);
Log('uploading file "' + Ftp.HostFileName + '");
Ftp.PutAsync;
end else begin
Log('unable to connect to ' + Ftp.HostName + ' => ' + Ftp.LastResponse);
FreeAndNil(ftp);
end;
end;
ftpPutAsync: begin
if Error = 0 then begin
Log('uploaded file "' + Ftp.HostFileName + '"');
end else begin
Log('unable to upload file "' + Ftp.HostFileName + '" => ' + Ftp.LastMultiResponse);
end;
Log('closing connection');
Ftp.QuitAsync;
end;
ftpQuitAsync: begin
FreeAndNil(ftp);
end;
end;
end;
我正在使用 ICS Overbyte FTP 上传文件。我想显示一个进度条和一个速度指示器,以便跟踪和估计大文件上传。我怎样才能做到这一点? 此外,上传完成后,我想从我的硬盘中删除该文件。 这是我现在用来上传到 ftp 服务器的代码。
procedure TForm1.Button1Click(Sender: TObject);
var ftp:Tftpclient;
begin
Ftp:=Tftpclient.Create(NIL);
Ftp.UserName:='';
Ftp.PassWord:='';
Ftp.HostName:='';
Ftp.LocalFileName:='d:\fpc-2.6.4.i386-win32.exe';
Ftp.HostDirName:='/';
Ftp.HostFileName := extractfilename(ftp.LocalFileName);
ftp.BandwidthLimit:=0;
Ftp.Passive := True;
FTP.Binary := True;
ftp.MultiThreaded:=true;
try
ftp.connect;
if ftp.Connected then
begin
memo1.lines.add(datetimetostr(now)+' - connected to '+ftp.hostname+' => '+ftp.LastResponse);
Ftp.put;
memo1.lines.add(datetimetostr(now)+' - loading file "'+ftp.hostfilename+'" => '+ftp.LastMultiResponse);
Ftp.Quit;
memo1.Lines.Add(datetimetostr(now)+' - closing connection =>'+ftp.lastResponse);
end;
finally
ftp.free;
end;
end;
谢谢!
TFtpClient
有一个 OnProgress
/OnProgress64
事件:
OnProgress: Display the current file transfer progression.
property OnProgress : procedure(Sender : TObject; Count : LongInt; var Abort : Boolean) of object;
Unit
FtpCli
您需要创建 TFtpClient
对象并为其分配事件处理程序,然后您可以执行 Put()
命令并接收有关上传的状态。
procedure TForm1.Log(const S: String);
begin
Memo1.Lines.Add(DateTimeToStr(Now) + ' - ' + S);
Memo1.Update;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Ftp: TFtpClient;
begin
Ftp := TFtpclient.Create(nil);
try
Ftp.OnProgress := FtpProgress;
Ftp.UserName := ...;
Ftp.PassWord := ...;
Ftp.HostName := ...;
Ftp.LocalFileName := 'D:\fpc-2.6.4.i386-win32.exe';
Ftp.HostDirName := '/';
Ftp.HostFileName := ExtractFileName(Ftp.LocalFileName);
Ftp.BandwidthLimit := 0;
Ftp.Passive := True;
Ftp.Binary := True;
Ftp.MultiThreaded := true;
Log('connecting to ' + Ftp.HostName);
if not Ftp.Connect then
begin
Log('unable to connect to ' + Ftp.HostName + ' => ' + Ftp.LastResponse);
Exit;
end;
try
Log('connected to ' + Ftp.HostName);
Log('uploading file "' + Ftp.HostFileName + '");
if Ftp.Put then begin
Log('uploaded file "' + Ftp.HostFileName + '"');
end else begin
Log('unable to upload file "' + Ftp.HostFileName + '" => ' + Ftp.LastMultiResponse);
end;
finally
Log('closing connection');
Ftp.Quit;
end;
finally
Ftp.Free;
end;
end;
procedure TForm1.FtpProgress(Sender : TObject; Count : LongInt; var Abort : Boolean);
begin
// calculate size transmitted/remaining, speed, and time remaining as needed...
end;
如果您在异步模式下使用 TFtpClient
,还要为 OnRequestDone
事件分配一个处理程序,并且在一切完成之前不要释放该对象。
OnRequestDone: Trigged when a command is completed.
property OnRequestDone : procedure(Sender : TObject; RqType : TFtpRequest; Error : Word) of object;
Unit
FtpCliDescription
When an command is completed, this event is called. Use this event to know when an async command is completed and then call the next one.
var
Ftp: TFtpClient = nil;
procedure TForm1.Log(const S: String);
begin
Memo1.Lines.Add(DateTimeToStr(Now) + ' - ' + S);
Memo1.Update;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Ftp = nil then
begin
Ftp := TFtpClient.Create(Self);
Ftp.OnProgress := FtpProgress;
Ftp.OnRequestDone := FtpRequestDone;
end;
Ftp.UserName := ...;
Ftp.PassWord := ...;
Ftp.HostName := ...;
Ftp.LocalFileName := 'D:\fpc-2.6.4.i386-win32.exe';
Ftp.HostDirName := '/';
Ftp.HostFileName := ExtractFileName(Ftp.LocalFileName);
Ftp.BandwidthLimit := 0;
Ftp.Passive := True;
Ftp.Binary := True;
Ftp.MultiThreaded := true;
Log('connecting to ' + Ftp.HostName);
Ftp.ConnectAsync;
end;
procedure TForm1.FtpProgress(Sender : TObject; Count : LongInt; var Abort : Boolean);
begin
// calculate size transmitted/remaining, speed, and time remaining as needed...
end;
procedure TForm1.FtpRequestDone(Sender : TObject; RqType : TFtpRequest; Error : Word);
begin
case RqType of
ftpConnectAsync: begin
if Error = 0 then begin
Log('connected to ' + Ftp.HostName);
Log('uploading file "' + Ftp.HostFileName + '");
Ftp.PutAsync;
end else begin
Log('unable to connect to ' + Ftp.HostName + ' => ' + Ftp.LastResponse);
FreeAndNil(ftp);
end;
end;
ftpPutAsync: begin
if Error = 0 then begin
Log('uploaded file "' + Ftp.HostFileName + '"');
end else begin
Log('unable to upload file "' + Ftp.HostFileName + '" => ' + Ftp.LastMultiResponse);
end;
Log('closing connection');
Ftp.QuitAsync;
end;
ftpQuitAsync: begin
FreeAndNil(ftp);
end;
end;
end;