Delphi 2010-带进度条的超字节ICS FTP上传

Question

我正在使用ICS Overbyte FTP上传文件。我想显示一个进度条和一个速度指示器，以便trqack和估计大文件上传。我该怎么做？同样在上传完成后，我想从我的hdd中删除该文件。这是我现在用来上传到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;

谢谢！

Answer 1

TFtpClient有一个OnProgress/OnProgress64事件：

OnProgress：显示当前文件传输进度。

property OnProgress : procedure(Sender : TObject; Count : LongInt; var Abort : Boolean) of object;

单位
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：当命令完成时触发。

property OnRequestDone : procedure(Sender : TObject; RqType : TFtpRequest; Error : Word) of object;

单位
FtpCli

说明
命令完成后，将调用此事件。使用此事件可以知道异步命令何时完成，然后调用下一个命令。

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;