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

Question

我正在使用 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;

谢谢！

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;