Indy9的IdFTP完全使用

来源：互联网发布：现代软件学院学费多少编辑：程序博客网时间：2024/05/16 04:00
Delphi 7自带的INDY控件，其中包含了IdFTP，可以方便的实现FTP客户端程序，参考自带的例子，其中有上传、下载、删除文件，但是不包含
对文件夹的操作，得自己实现上传、下载、删除整个文件夹（带子目录和文件)。于是自己参考了网上的资料，重新整理下，
使用归纳如下示例工程所示：
窗体上放置TIdFTP、TIdAntiFreeze组件，还有其他一些基本控件。当在列表框选择的是“文件夹”时，点击“下载”、“删除”
就会对此文件夹进行下载或删除，若是选择的是“文件”类型，则对单个文件操作；上传分单个文件上传和上传整个目录。工程源码如下：
[delphi] view plaincopy
{*******************************************************}  
{                                                       }  
{       系统名称 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.  
运行工程如下图所示：