Question

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

Delphi 2010 - 带有进度条的Overbyte ICS FTP上传

1 个答案: