Delphi 2010 - Overbyte 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: 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;

Delphi 2010 - Overbyte ICS FTP 上传进度条

Delphi 2010 - Overbyte ICS FTP upload with progress bar

delphi

delphi-2010