Indy9的IdFTP完全使用

    Delphi 7自带的INDY控件，其中包含了IdFTP，可以方便的实现FTP客户端程序，参考自带的例子，其中有上传、下载、删除文件，但是不包含对文件夹的操作，得自己实现上传、下载、删除整个文件夹（带子目录和文件）。于是自己参考了网上的资料，重新整理下，使用归纳如下示例工程所示：

窗体上放置TIdFTP、TIdAntiFreeze组件，还有其他一些基本控件。当在列表框选择的是“文件夹”时，点击“下载”、“删除”就会对此文件夹进行下载或删除，若是选择的是“文件”类型，则对单个文件操作；上传分单个文件上传和上传整个目录。工程源码如下：

{*******************************************************} { } { 系统名称 IdFTP完全使用 } { 版权所有 (C) http://blog.csdn.net/akof1314 } { 单元名称 Unit1.pas } { 单元功能 在Delphi 7下实现FTP客户端 } { } {*******************************************************} unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, IdFTPCommon, IdFTPList, ComCtrls, IdGlobal, IdAntiFreezeBase, IdAntiFreeze, FileCtrl; type TForm1 = class(TForm) idftp_Client: TIdFTP; edt_CurrentDirectory: TEdit; lst_ServerList: TListBox; edt_ServerAddress: TEdit; edt_UserName: TEdit; edt_UserPassword: TEdit; lbl1: TLabel; lbl2: TLabel; lbl3: TLabel; lbl4: TLabel; btn_Connect: TButton; btn_EnterDirectory: TButton; btn_Back: TButton; btn_Download: TButton; btn_Upload: TButton; btn_Delete: TButton; btn_MKDirectory: TButton; btn_Abort: TButton; mmo_Log: TMemo; pb_ShowWorking: TProgressBar; dlgSave_File: TSaveDialog; lbl_ShowWorking: TLabel; idntfrz1: TIdAntiFreeze; dlgOpen_File: TOpenDialog; btn_UploadDirectory: TButton; procedure btn_ConnectClick(Sender: TObject); procedure btn_EnterDirectoryClick(Sender: TObject); procedure btn_BackClick(Sender: TObject); procedure lst_ServerListDblClick(Sender: TObject); procedure btn_DownloadClick(Sender: TObject); procedure idftp_ClientWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); procedure idftp_ClientWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); procedure idftp_ClientWorkEnd(Sender: TObject; AWorkMode: TWorkMode); procedure FormCreate(Sender: TObject); procedure btn_AbortClick(Sender: TObject); procedure btn_UploadClick(Sender: TObject); procedure btn_DeleteClick(Sender: TObject); procedure btn_MKDirectoryClick(Sender: TObject); procedure btn_UploadDirectoryClick(Sender: TObject); private FTransferrignData: Boolean; //是否在传输数据 FBytesToTransfer: LongWord; //传输的字节大小 FAbortTransfer: Boolean; //取消数据传输 STime : TDateTime; //时间 FAverageSpeed : Double; //平均速度 procedure ChageDir(DirName: String); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} {------------------------------------------------------------------------------- Description: 窗体创建函数 -------------------------------------------------------------------------------} procedure TForm1.FormCreate(Sender: TObject); begin Self.DoubleBuffered := True; //开启双缓冲，使得lbl_ShowWorking描述不闪烁 idntfrz1.IdleTimeOut := 50; idntfrz1.OnlyWhenIdle := False; end; {------------------------------------------------------------------------------- Description: 连接、断开连接 -------------------------------------------------------------------------------} procedure TForm1.btn_ConnectClick(Sender: TObject); begin btn_Connect.Enabled := False; if idftp_Client.Connected then begin //已连接 try if FTransferrignData then //是否数据在传输 idftp_Client.Abort; idftp_Client.Quit; finally btn_Connect.Caption := '连接'; edt_CurrentDirectory.Text := '/'; lst_ServerList.Items.Clear; btn_Connect.Enabled := True; mmo_Log.Lines.Add(DateTimeToStr(Now) + '断开服务器'); end; end else begin //未连接 with idftp_Client do try Passive := True; //被动模式 Username := Trim(edt_UserName.Text); Password := Trim(edt_UserPassword.Text); Host := Trim(edt_ServerAddress.Text); Connect(); Self.ChageDir(edt_CurrentDirectory.Text); finally btn_Connect.Enabled := True; if Connected then btn_Connect.Caption := '断开连接'; mmo_Log.Lines.Add(DateTimeToStr(Now) + '连接服务器'); end; end; end; {------------------------------------------------------------------------------- Description: 改变目录 -------------------------------------------------------------------------------} procedure TForm1.ChageDir(DirName: String); var LS: TStringList; i: Integer; begin LS := TStringList.Create; try idftp_Client.ChangeDir(AnsiToUtf8(DirName)); idftp_Client.TransferType := ftASCII; edt_CurrentDirectory.Text := Utf8ToAnsi(idftp_Client.RetrieveCurrentDir); idftp_Client.List(LS); LS.Clear; with idftp_Client.DirectoryListing do begin for i := 0 to Count - 1 do begin if Items[i].ItemType = ditDirectory then LS.Add(Format('%-22s%15s%-10s%s',[Utf8ToAnsi(Items[i].FileName),IntToStr(Items[i].Size),' 文件夹',DateTimeToStr(Items[i].ModifiedDate)])) else LS.Add(Format('%-22s%15s%-10s%s',[Utf8ToAnsi(Items[i].FileName),IntToStr(Items[i].Size),' 文件',DateTimeToStr(Items[i].ModifiedDate)])); end; end; lst_ServerList.Items.Clear; lst_ServerList.Items.Assign(LS); finally LS.Free; end; end; {------------------------------------------------------------------------------- Description: 进入目录按钮 -------------------------------------------------------------------------------} procedure TForm1.btn_EnterDirectoryClick(Sender: TObject); begin Self.ChageDir(edt_CurrentDirectory.Text); end; {------------------------------------------------------------------------------- Description: 后退按钮 -------------------------------------------------------------------------------} procedure TForm1.btn_BackClick(Sender: TObject); begin Self.ChageDir('..'); end; {------------------------------------------------------------------------------- Description: 双击文件夹名称，进入该目录 -------------------------------------------------------------------------------} procedure TForm1.lst_ServerListDblClick(Sender: TObject); begin if not idftp_Client.Connected then Exit; if idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].ItemType = ditDirectory then Self.ChageDir(Utf8ToAnsi(idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].FileName)); end; {------------------------------------------------------------------------------- Description: 下载按钮 -------------------------------------------------------------------------------} procedure TForm1.btn_DownloadClick(Sender: TObject); procedure DownloadDirectory(var idFTP: TIdFtp;LocalDir, RemoteDir: string); var i,DirCount: Integer; strName: string; begin if not DirectoryExists(LocalDir + RemoteDir) then begin ForceDirectories(LocalDir + RemoteDir); //创建一个全路径的文件夹 mmo_Log.Lines.Add('建立目录：' + LocalDir + RemoteDir); end; idFTP.ChangeDir(AnsiToUtf8(RemoteDir)); idFTP.TransferType := ftASCII; idFTP.List(nil); DirCount := idFTP.DirectoryListing.Count; for i := 0 to DirCount - 1 do begin strName := Utf8ToAnsi(idFTP.DirectoryListing.Items[i].FileName); mmo_Log.Lines.Add('解析文件：' + strName); if idFTP.DirectoryListing.Items[i].ItemType = ditDirectory then if (strName = '.') or (strName = '..') then Continue else begin DownloadDirectory(idFTP,LocalDir + RemoteDir + '/', strName); idFTP.ChangeDir('..'); idFTP.List(nil); end else begin if (ExtractFileExt(strName) = '.txt') or (ExtractFileExt(strName) = '.html') or (ExtractFileExt(strName) = '.htm') then idFTP.TransferType := ftASCII //文本模式 else idFTP.TransferType := ftBinary; //二进制模式 FBytesToTransfer := idFTP.Size(AnsiToUtf8(strName)); ; idFTP.Get(AnsiToUtf8(strName), LocalDir + RemoteDir + '/' + strName, True); mmo_Log.Lines.Add('下载文件：' + strName); end; Application.ProcessMessages; end; end; var strName: string; strDirectory: string; begin if not idftp_Client.Connected then Exit; btn_Download.Enabled := False; strName := idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].FileName; if idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].ItemType = ditDirectory then begin if SelectDirectory('选择目录保存路径','',strDirectory) then begin DownloadDirectory(idftp_Client,strDirectory + '/',Utf8ToAnsi(strName)); idftp_Client.ChangeDir('..'); idftp_Client.List(nil); end; end else begin //下载单个文件 dlgSave_File.FileName := Utf8ToAnsi(strName); if dlgSave_File.Execute then begin idftp_Client.TransferType := ftBinary; FBytesToTransfer := idftp_Client.Size(strName); if FileExists(dlgSave_File.FileName) then begin case MessageDlg('文件已经存在，是否要继续下载？', mtConfirmation, mbYesNoCancel, 0) of mrCancel: //退出操作 begin Exit; end; mrYes: //断点继续下载文件 begin FBytesToTransfer := FBytesToTransfer - FileSizeByName(strName); idftp_Client.Get(strName,dlgSave_File.FileName,False,True); end; mrNo: //从头开始下载文件 begin idftp_Client.Get(strName,dlgSave_File.FileName,True); end; end; end else idftp_Client.Get(strName, dlgSave_File.FileName, False); end; end; btn_Download.Enabled := True; end; {------------------------------------------------------------------------------- Description: 读写操作的工作事件 -------------------------------------------------------------------------------} procedure TForm1.idftp_ClientWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); Var S: String; TotalTime: TDateTime; H, M, Sec, MS: Word; DLTime: Double; begin TotalTime := Now - STime; //已花费的时间 DecodeTime(TotalTime, H, M, Sec, MS); //解码时间 Sec := Sec + M * 60 + H * 3600; //转换成以秒计算 DLTime := Sec + MS / 1000; //精确到毫秒 if DLTime > 0 then FAverageSpeed := (AWorkCount / 1024) / DLTime; //求平均速度 if FAverageSpeed > 0 then begin Sec := Trunc(((pb_ShowWorking.Max - AWorkCount) / 1024) / FAverageSpeed); S := Format('%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]); S := '剩余时间 ' + S; end else S := ''; S := FormatFloat('0.00 KB/s', FAverageSpeed) + '; ' + S; case AWorkMode of wmRead: lbl_ShowWorking.Caption := '下载速度 ' + S; wmWrite: lbl_ShowWorking.Caption := '上传速度 ' + S; end; if FAbortTransfer then //取消数据传输 idftp_Client.Abort; pb_ShowWorking.Position := AWorkCount; FAbortTransfer := false; end; {------------------------------------------------------------------------------- Description: 开始读写操作的事件 -------------------------------------------------------------------------------} procedure TForm1.idftp_ClientWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); begin FTransferrignData := True; btn_Abort.Enabled := True; FAbortTransfer := False; STime := Now; if AWorkCountMax > 0 then pb_ShowWorking.Max := AWorkCountMax else pb_ShowWorking.Max := FBytesToTransfer; FAverageSpeed := 0; end; {------------------------------------------------------------------------------- Description: 读写操作完成之后的事件 -------------------------------------------------------------------------------} procedure TForm1.idftp_ClientWorkEnd(Sender: TObject; AWorkMode: TWorkMode); begin btn_Abort.Enabled := False; FTransferrignData := False; FBytesToTransfer := 0; pb_ShowWorking.Position := 0; FAverageSpeed := 0; lbl_ShowWorking.Caption := '传输完成'; end; {------------------------------------------------------------------------------- Description: 取消按钮 -------------------------------------------------------------------------------} procedure TForm1.btn_AbortClick(Sender: TObject); begin FAbortTransfer := True; end; {------------------------------------------------------------------------------- Description: 上传按钮 -------------------------------------------------------------------------------} procedure TForm1.btn_UploadClick(Sender: TObject); begin if idftp_Client.Connected then begin if dlgOpen_File.Execute then begin idftp_Client.TransferType := ftBinary; idftp_Client.Put(dlgOpen_File.FileName, AnsiToUtf8(ExtractFileName(dlgOpen_File.FileName))); ChageDir(Utf8ToAnsi(idftp_Client.RetrieveCurrentDir)); end; end; end; {------------------------------------------------------------------------------- Description: 删除按钮 -------------------------------------------------------------------------------} procedure TForm1.btn_DeleteClick(Sender: TObject); procedure DeleteDirectory(var idFTP: TIdFtp; RemoteDir: string); var i,DirCount: Integer; strName: string; begin idFTP.List(nil); DirCount := idFTP.DirectoryListing.Count; if DirCount = 2 then begin idFTP.ChangeDir('..'); idFTP.RemoveDir(RemoteDir); idFTP.List(nil); Application.ProcessMessages; mmo_Log.Lines.Add('删除文件夹：' + Utf8ToAnsi(RemoteDir)); Exit; end; for i := 0 to 2 do begin strName := idFTP.DirectoryListing.Items[i].FileName; if idFTP.DirectoryListing.Items[i].ItemType = ditDirectory then begin if (strName = '.') or (strName = '..') then Continue; idFTP.ChangeDir(strName); DeleteDirectory(idFTP,strName); DeleteDirectory(idFTP,RemoteDir); end else begin idFTP.Delete(strName); Application.ProcessMessages; mmo_Log.Lines.Add('删除文件：' + Utf8ToAnsi(strName)); DeleteDirectory(idFTP,RemoteDir); end; end; end; Var strName: String; begin if not idftp_Client.Connected then exit; strName := idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].FileName; if idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].ItemType = ditDirectory then try idftp_Client.ChangeDir(strName); DeleteDirectory(idftp_Client,strName); ChageDir(Utf8ToAnsi(idftp_Client.RetrieveCurrentDir)); finally end else //删除单个文件 try idftp_Client.Delete(strName); ChageDir(Utf8ToAnsi(idftp_Client.RetrieveCurrentDir)); finally end; end; {------------------------------------------------------------------------------- Description: 新建目录按钮 -------------------------------------------------------------------------------} procedure TForm1.btn_MKDirectoryClick(Sender: TObject); var S: string; begin if InputQuery('新建目录','文件夹名称',S) and (Trim(S) <> '') then begin idftp_Client.MakeDir(AnsiToUtf8(S)); Self.ChageDir(Utf8ToAnsi(idftp_Client.RetrieveCurrentDir)); end; end; {------------------------------------------------------------------------------- Description: 上传目录按钮 -------------------------------------------------------------------------------} procedure TForm1.btn_UploadDirectoryClick(Sender: TObject); function DoUploadDir(idftp:TIdFTP;sDirName:String;sToDirName:String):Boolean; var hFindFile:Cardinal; tfile:String; sCurDir:String[255]; FindFileData:WIN32_FIND_DATA; begin //先保存当前目录 sCurDir:=GetCurrentDir; ChDir(sDirName); idFTP.ChangeDir(AnsiToUtf8(sToDirName)); hFindFile:=FindFirstFile( '*.* ',FindFileData); Application.ProcessMessages; if hFindFile<>INVALID_HANDLE_VALUE then begin repeat tfile:=FindFileData.cFileName; if (tfile= '.') or (tfile= '..') then Continue; if FindFileData.dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY then begin try IdFTP.MakeDir(AnsiToUtf8(tfile)); mmo_Log.Lines.Add('新建文件夹：' + tfile); except end; DoUploadDir(idftp,sDirName+ '/'+tfile,tfile); idftp.ChangeDir('..'); Application.ProcessMessages; end else begin IdFTP.Put(tfile, AnsiToUtf8(tfile)); mmo_Log.Lines.Add('上传文件：' + tfile); Application.ProcessMessages; end; until FindNextFile(hFindFile,FindFileData)=false; end else begin ChDir(sCurDir); result:=false; exit; end; //回到原来的目录下 ChDir(sCurDir); result:=true; end; var strPath,strToPath,temp: string; begin if idftp_Client.Connected then begin if SelectDirectory('选择上传目录','',strPath) then begin temp := Utf8ToAnsi(idftp_Client.RetrieveCurrentDir); strToPath := temp; if Length(strToPath) = 1 then strToPath := strToPath + ExtractFileName(strPath) else strToPath := strToPath + '/' + ExtractFileName(strPath); try idftp_Client.MakeDir(AnsiToUtf8(ExtractFileName(strPath))); except end; DoUploadDir(idftp_Client,strPath,strToPath); Self.ChageDir(temp); end; end; end; end.

运行工程如下图所示：

示例源码下载：http://download.csdn.net/source/3236325