51代码网ORACLEMYSQLSQL SERVER其它数据库java/jspasp/asp.netC/C++/VC++APP应用其它语言服务器应用
您现在的位置: 51代码网 >> java >> 文章正文

delphi的IdFTP控件函数怎么调用

更新时间:2012-4-1:  来源:51代码网

RootDir = 要删除的根目录,一般情况下 RemoteDir 与 RootDir 相等}
procedure TForm1.FTP_DeleteAllFiles(var idFTP : TIdFtp;RemoteDir,RootDir : string);
label Files;
var
i,DirCount : integer;
Temp : string;
begin
  idFTP.ChangeDir(RemoteDir);
  if Pos(RootDir,idFTP.RetrieveCurrentDir) = 0 then Exit;
  Files :
  idFTP.List(nil);
  DirCount := idFTP.DirectoryListing.Count ;
  while DirCount = 0 do
  begin
  Temp := idFTP.RetrieveCurrentDir;
  idFTP.ChangeDirUp;
  idFTP.RemoveDir(Temp);
  idFTP.List(nil);
  DirCount := idFTP.DirectoryListing.Count ;
  for i := 0 to DirCount - 1 do
  if idFTP.DirectoryListing[i].FileName = RootDir then Exit;
  end;
  
  for i := 0 to DirCount - 1 do
  begin
  if Pos(RootDir,idFTP.RetrieveCurrentDir) = 0 then Break ;
  if idFTP.DirectoryListing[i].ItemType = ditDirectory then
  begin
  FTP_DeleteAllFiles(idFTP,idFTP.DirectoryListing[i].FileName,RootDir);
  end else begin
  idFTP.Delete(idFTP.DirectoryListing[i].FileName);
  goto Files ;
  end;
  end;
  
end;

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdFTP, StdCtrls, idftplist, ComCtrls, ExtCtrls;

type
  Thread1 = class(TThread)
  private
    FidFTP : TIdFtp;
  protected
    procedure Execute; override;
  public
    constructor Create(var idFTP : TIdFtp);
  end;

  Thread2 = class(TThread)
  private
    FidFTP : TIdFtp;
  protected
    procedure Execute; override;
  public
    constructor Create(var idFTP : TIdFtp);
    procedure FTP_DeleteAllFiles(var idFTP: TIdFtp; RemoteDir: string);
  end;

  TForm1 = class(TForm)
    IdFTP1: TIdFTP;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    Memo1: TMemo;
    Button3: TButton;
    Edit4: TEdit;
    procedure IdFTP1Connected(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure IdFTP1Disconnected(Sender: TObject);
    procedure IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function GetPrevDir(dir:string):string;
  end;

var
  Form1: TForm1;
  T1: TThread;
  T2: TThread;

implementation

{$R *.dfm}

procedure TForm1.IdFTP1Connected(Sender: TObject);
begin
  Button1.Enabled := false;
  Timer1.Enabled := true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if not IdFTP1.Connected then
  begin
    Timer1.Enabled := false;
    IdFTP1.Tag := 0;
    IdFTP1.Host := Edit1.Text;
    IdFTP1.Username := Edit2.Text;
    IdFTP1.Password := Edit3.Text;
    IdFTP1.Port := strtoint(Edit4.Text);
    T1 := Thread1.Create(IdFTP1);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  IdFTP1.Abort;
  if IdFTP1.Connected then IdFTP1.Disconnect;
end;

procedure TForm1.IdFTP1Disconnected(Sender: TObject);
begin
  Button1.Enabled := true;
  if IdFTP1.Tag = 0 then Button1.Click;
end;

procedure TForm1.IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: String);
begin
  StatusBar1.Panels.Items[0].Text := AStatusText;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := false;
  T2 := Thread2.Create(IdFTP1);
end;


{ Thread1 }

constructor Thread1.Create(var idFTP: TIdFtp);
begin
  FidFTP := idFTP;
  FreeOnTerminate := True;
  inherited Create(false);
end;

procedure Thread1.Execute;
begin
  try
    FidFTP.Connect(true, -1);
  except
  end;
end;


{ Thread2 }

constructor Thread2.Create(var idFTP : TIdFtp);
begin
  FidFTP := idFTP;
  FreeOnTerminate := True;
  inherited Create(false);
end;

procedure Thread2.Execute;
begin
  try
    FTP_DeleteAllFiles(FidFTP, '/');
  except
  end;   
end;


{删除整个ftp目录,包括下面的文件, RemoteDir 要删除的目录}
procedure Thread2.FTP_DeleteAllFiles(var idFTP : TIdFtp; RemoteDir : string);
var
  i,DirCount : integer;
  Temp : string;
begin
  idFTP.ChangeDir(RemoteDir);
  Form1.Memo1.Lines.Add('ChangeDir:' + idFTP.RetrieveCurrentDir);
  idFTP.List(nil);
  DirCount := idFTP.DirectoryListing.Count;
  if DirCount = 0 then
    begin
      try
        idFTP.RemoveDir(idFTP.RetrieveCurrentDir);
        Form1.Memo1.Lines.Add('Success:' + idFTP.RetrieveCurrentDir);
      except
        Form1.Memo1.Lines.Add('Failed:' + idFTP.RetrieveCurrentDir);
      end;
      //上级
      Temp := Form1.GetPrevDir(idFTP.RetrieveCurrentDir);
      if Temp <> '/' then FTP_DeleteAllFiles(idFTP, Temp);
    end;

  for i := 0 to DirCount - 1 do
    begin
      if idFTP.DirectoryListing[i].ItemType = ditDirectory then
        begin

[1] [2] 下一页

  • 上一篇文章:
  • 下一篇文章: 没有了
  • 赞助商链接
    推荐文章
  • 此栏目下没有推荐文章
  • {
    设为首页 | 加入收藏 | 友情链接 | 网站地图 | 联系站长 |