下面的程序是用delphi7.0 + idFTP实现的。可能还会有bug,不过希望能给需要他的人带来一点点帮助和提示!,程序中只有下载与删除的代码,至于上传的code自己写吧,稍微思考一下就可以实现。

unit Unit1;

 

interface

 

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,IdFTPList,

 IdTCPClient, IdFTP ;

 

type

 TForm1 = class(TForm)

   Btt_DownLoadDir: TButton;

   IdFTP1: TIdFTP;

   Btt_DeleteDir: TButton;

   Label1: TLabel;

   lb_num: TLabel; //处理文件个数提示。

   procedure Btt_DownLoadDirClick(Sender: TObject);

   procedure Btt_DeleteDirClick(Sender: TObject);

 private

   { Private declarations }

 public

   { Public declarations }

 end;

var

 Form1: TForm1;

implementation

 

{$R *.dfm}

 

 

 

 

 

 

{下载整个目录,并遍历所有子目录

  首先ChangeDir(Root)到根目录

 然后创建本地目录+ RemoteDir

 然后用list得到所有目录名

 循环判断,进入RemoteDir目录内部

 如果是目录继续第归。否则get该文件到本地目录,当get完所有文件后返回上一级目录

 List再取得信息,继续循环

 }

 

procedure FTP_DownloadDir(var idFTP : TIdFtp;RemoteDir,LocalDir : string);

label Files ;

var

  i,DirCount : integer;

begin

 if not DirectoryExists(LocalDir + RemoteDir) then

   ForceDirectories(LocalDir + RemoteDir);

 idFTP.ChangeDir(RemoteDir);

 idFTP.List(nil);

 DirCount := idFTP.DirectoryListing.Count ;

 if DirCount = 0 then

 begin

   idFTP.ChangeDirUp;

   idFTP.List(nil);

 end;

 for i := 0 to DirCount - 1 do

 begin

   if DirCount <> idFTP.DirectoryListing.Count then

   begin

     repeat

       idFTP.ChangeDirUp;

       idFTP.List(nil);

     until DirCount = idFTP.DirectoryListing.Count ;

   end;

   if idFTP.DirectoryListing[i].ItemType = ditDirectory then

     FTP_DownloadDir(idFTP,idFTP.DirectoryListing[i].FileName,LocalDir + RemoteDir + '\')

   else begin

     idFTP.Get(idFTP.DirectoryListing[i].FileName,LocalDir + RemoteDir + '\' +

       idFTP.DirectoryListing[i].FileName,true);

     Form1.lb_num.Caption := IntToStr(StrToInt(Form1.lb_num.Caption) + 1);

     Form1.lb_num.Update;

     if i = DirCount - 1 then

     begin

       idFTP.ChangeDirUp;

       idFTP.List(nil);

     end;

   end;

 end;

end;

 

{删除整个ftp目录,包括下面的文件,

 RootDir =要删除的根目录,一般情况下RemoteDirRootDir相等}

procedure 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);

     Form1.lb_num.Caption := IntToStr(StrToInt(Form1.lb_num.Caption) + 1);

     Form1.lb_num.Update;

     goto Files ;

   end;

 end;

end;

 

procedure TForm1.Btt_DownLoadDirClick(Sender: TObject);

begin

 IdFTP1.Connect(true,-1);

 if IdFTP1.Connected then

 begin

   IdFTP1.ChangeDir('bigimage');

   FTP_DownloadDir(IdFTP1,'1002.1002.1002','g:\ftpdir\');

 end;

 IdFTP1.Disconnect ;

end;

 

procedure TForm1.Btt_DeleteDirClick(Sender: TObject);

begin

 IdFTP1.Connect(true,-1);

 if IdFTP1.Connected then

 begin

   IdFTP1.ChangeDir('bigimage');

   FTP_DeleteAllFiles(IdFTP1,'1002.1002.1002','1002.1002.1002');

 end;

 IdFTP1.Disconnect ;

end;

 

end.

 

 

运行环境win2000 advanced server + delphi7.0 + iis6.0

来源:http://blog.csdn.net/smandhgx/archive/2004/04/07/15221.aspx

  • 相关文章

    • 无相关文章
最后修改:2009 年 08 月 16 日
卧槽,全是白嫖客,服务器不要钱吗?