IDFTP 控件使用

unit U_FTP;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, IdAntiFreezeBase, IdAntiFreeze, IdIntercept, IdLogBase,
  IdLogDebug, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdFTP, ComCtrls, StdCtrls, ExtCtrls,IdFTPCommon,IniFiles;
  //添加對IdFTPCommon、IniFiles的引用

type
  TF_FTP = class(TForm)
    Splitter1: TSplitter;
    DirectoryList: TListBox;
    DebugList: TListBox;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ServerName: TEdit;
    ConnectButton: TButton;
    Panel2: TPanel;
    Path: TEdit;
    ChDirButton: TButton;
    CreateDirButton: TButton;
    Checkbox2: TCheckBox;
    User: TEdit;
    Pass: TEdit;
    Checkbox1: TCheckBox;
    StatusBar1: TStatusBar;
    CommandPanel: TPanel;
    UploadButton: TButton;
    AbortButton: TButton;
    BackButton: TButton;
    DeleteButton: TButton;
    DownloadButton: TButton;
    ProgressBar1: TProgressBar;
    IdFTP1: TIdFTP;
    IdLogDebug1: TIdLogDebug;
    UploadOpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    PopupMenu1: TPopupMenu;
    Download1: TMenuItem;
    Upload1: TMenuItem;
    Delete1: TMenuItem;
    N1: TMenuItem;
    Back1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure ConnectButtonClick(Sender: TObject);
    procedure UploadButtonClick(Sender: TObject);
    procedure ChDirButtonClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
    procedure AbortButtonClick(Sender: TObject);
    procedure BackButtonClick(Sender: TObject);
    procedure CreateDirButtonClick(Sender: TObject);
    procedure DownloadButtonClick(Sender: TObject);
    procedure IdFTP1Disconnected(Sender: TObject);
    procedure IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
    procedure IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure Checkbox2Click(Sender: TObject);
    procedure Checkbox1Click(Sender: TObject);
    procedure DirectoryListClick(Sender: TObject);
    procedure IdLogDebug1Connect(ASender: TIdConnectionIntercept);
    procedure IdLogDebug1Disconnect(ASender: TIdConnectionIntercept);
  private
    { Private declarations }
    AbortTransfer: Boolean;    //是否終止傳輸
    TransferrignData: Boolean;
    BytesToTransfer: LongWord;//傳輸的字節數
    STime: TDateTime;
    AverageSpeed: Double;     //平均速度
    procedure ChageDir(DirName: String);
    procedure SetFunctionButtons(AValue: Boolean);
    procedure SaveFTPHostInfo(Datatext, header: String);
    function GetHostInfo(header: String): String;
    function GetNameFromDirLine(Line: String; Var IsDirectory: Boolean): String;
  public
    { Public declarations }
  end;

var
  F_FTP: TF_FTP;

implementation

{$R *.dfm}
//******************自定義過程************************
//根據給定參數修改按鈕和菜單項的當前狀態
procedure TF_FTP.SetFunctionButtons(AValue: Boolean);
Var
  i: Integer;
begin
  with CommandPanel do
  //設置CommandPanel上的按鈕是否活躍
    for i := 0 to ControlCount - 1 do
      if Controls[i].Name <> 'AbortButton' then
          Controls[i].Enabled := AValue;

   with PopupMenu1 do
   //設置彈出式菜單中的菜單項的活躍狀態
      for i := 0 to Items.Count - 1 do
          Items[i].Enabled := AValue;

  ChDirButton.Enabled := AValue;    //修改路徑按鈕
  CreateDirButton.Enabled := AValue;//新建目錄按鈕
end;

//修改當前路徑
procedure TF_FTP.ChageDir(DirName: String);
begin
  try
     //修改按鈕和菜單項的當前狀態
    SetFunctionButtons(false);
    //修改路徑
    IdFTP1.ChangeDir(DirName);
    //設置文件傳輸類型爲ASCII文件傳輸
    IdFTP1.TransferType := ftASCII;
    //顯示當前路徑
    Path.Text := IdFTP1.RetrieveCurrentDir;
    //更新文件和目錄顯示
    DirectoryList.Items.Clear;
    IdFTP1.List(DirectoryList.Items);
  finally
    SetFunctionButtons(true);
  end;
end;

//保存主機信息
procedure TF_FTP.SaveFTPHostInfo(Datatext, header: String);
var
  ServerIni: TIniFile;
begin
//將主機信息保存在一個配置文件中
  ServerIni := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'FtpHostInfo.ini');
  ServerIni.WriteString('Server', header, Datatext);
  ServerIni.UpdateFile;
  ServerIni.Free;
end;

//獲取主機信息
function TF_FTP.GetHostInfo(header: String): String;
var
  ServerName: String;
  ServerIni: TIniFile;
begin
  ServerIni := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'FtpHostInfo.ini');
  ServerName := ServerIni.ReadString('Server', header, header);
  ServerIni.Free;
  result := ServerName;
end;

//獲取文件或目錄名
function TF_FTP.GetNameFromDirLine(Line: String; Var IsDirectory: Boolean): String;
Var
  i: Integer;
  DosListing: Boolean;
begin
  IsDirectory := Line[1] = 'd';
  DosListing := false;
  for i := 0 to 7 do begin
    if (i = 2) and not IsDirectory then
    begin
      IsDirectory := Copy(Line, 1, Pos(' ', Line) - 1) = '<DIR>';
      if not IsDirectory then
      DosListing := Line[1] in ['0'..'9']
    else
      DosListing := true;
    end;
    Delete(Line, 1, Pos(' ', Line));
    While Line[1] = ' ' do Delete(Line, 1, 1);
    if DosListing and (i = 2) then break;
  end;
  Result := Line;
end;

//*****************************************************
//初始化FTP客戶端
procedure TF_FTP.FormCreate(Sender: TObject);
begin
  SetFunctionButtons(false);
  IdLogDebug1.Active := true;
  //從配置文件中獲取一個FTP服務器地址
  ServerName.Text := GetHostInfo('FTPHOST');
  //設置進度條的初始狀態
  ProgressBar1.Parent := StatusBar1;
  ProgressBar1.Top := 2;
  ProgressBar1.Left := 1;
  AverageSpeed:=0;
end;

//*****************按鈕操作******************************
//連接FTP服務器
procedure TF_FTP.ConnectButtonClick(Sender: TObject);
begin
  ConnectButton.Enabled := false;
  if IdFTP1.Connected then
    try
      if TransferrignData then IdFTP1.Abort;
      IdFTP1.Quit;
    finally
      Path.Text := '/';
      DirectoryList.Items.Clear;
      //修改按鈕和菜單項的當前狀態
      SetFunctionButtons(false);
      ConnectButton.Caption := '連接';
      ConnectButton.Enabled := true;
      ConnectButton.Default := true;
    end
  else with IdFTP1 do
    try
    //建立到FTP服務器的連接
      Username := User.Text;
      Password := Pass.Text;
      Host := ServerName.Text;
      Connect;
      Self.ChageDir(Path.Text);//修改當前路徑
      SetFunctionButtons(true);
      //將主機信息保存到配置文件中
      SaveFTPHostInfo(ServerName.Text, 'FTPHOST');
    finally
      ConnectButton.Enabled := true;
      if Connected then
      //斷開與FTP服務器的連接
        begin
          ConnectButton.Caption := '斷開連接';
          ConnectButton.Default := false;
        end;
    end;
end;

//修改路徑
procedure TF_FTP.ChDirButtonClick(Sender: TObject);
begin
  SetFunctionButtons(false);
  ChageDir(Path.Text);
  SetFunctionButtons(true);
end;

//創建新的目錄
procedure TF_FTP.CreateDirButtonClick(Sender: TObject);
Var
  S: String;
begin
  S := InputBox('創建新目錄', '名稱', '');
  if S <> '' then
  try
    SetFunctionButtons(false);
    IdFTP1.MakeDir(S);
    ChageDir(Path.Text);
  finally
    SetFunctionButtons(true);
  end;
end;

//從FTP服務器中下載文件
procedure TF_FTP.DownloadButtonClick(Sender: TObject);
Var
  Name, Line: String;
  IsDirectory: Boolean;
begin
  if not IdFTP1.Connected then exit;
  if DirectoryList.ItemIndex=-1 then exit;
  Line := DirectoryList.Items[DirectoryList.ItemIndex];
  Name := GetNameFromDirLine(Line, IsDirectory);
  //對目錄而言，進入下層目錄
  if IsDirectory then begin
    SetFunctionButtons(false);
    ChageDir(Name);
    SetFunctionButtons(true);
  end
  //上傳文件
  else begin
  try
    SaveDialog1.FileName := Name;
    if SaveDialog1.Execute then begin
    SetFunctionButtons(false);
    IdFTP1.TransferType := ftBinary;
    BytesToTransfer := IdFTP1.Size(Name);
    IdFTP1.Get(Name, SaveDialog1.FileName, true);
    end;
  finally
    SetFunctionButtons(true);
  end;
  end;
end;  

//向FTP服務器中上傳數據
procedure TF_FTP.UploadButtonClick(Sender: TObject);
begin
if IdFTP1.Connected then begin
   //選擇要上傳的文件
  if UploadOpenDialog1.Execute then
    try
      SetFunctionButtons(false);
      IdFTP1.TransferType := ftBinary;
      //上傳文件並更新路徑顯示
      IdFTP1.Put(UploadOpenDialog1.FileName, ExtractFileName(UploadOpenDialog1.FileName));
      ChageDir(idftp1.RetrieveCurrentDir);
    finally
      SetFunctionButtons(true);
    end;
  end;
end;


//從FTP服務器中刪除指定的內容
procedure TF_FTP.DeleteButtonClick(Sender: TObject);
Var
  Name, Line: String;
  IsDirectory: Boolean;
begin
  if not IdFTP1.Connected then exit;
  if DirectoryList.ItemIndex=-1 then exit;
  //獲取要刪除的文件名或目錄名
  Line := DirectoryList.Items[DirectoryList.ItemIndex];
  Name := GetNameFromDirLine(Line, IsDirectory);
  //刪除目錄
  if IsDirectory then
    try
      SetFunctionButtons(false);
      idftp1.RemoveDir(Name);
      ChageDir(idftp1.RetrieveCurrentDir);
    finally
    end
  //刪除文件
  else
    try
    SetFunctionButtons(false);
    idftp1.Delete(Name);
    ChageDir(idftp1.RetrieveCurrentDir);
    finally
    end;      
end;

//返回以前的路徑
procedure TF_FTP.BackButtonClick(Sender: TObject);
begin
 if not IdFTP1.Connected then exit;
 try
  ChageDir('..');
 finally
 end;
end;

//終止傳輸
procedure TF_FTP.AbortButtonClick(Sender: TObject);
begin
 AbortTransfer := true;
end;

//**********************TIdFTP組件事件處理************************
//斷開連接時的處理
procedure TF_FTP.IdFTP1Disconnected(Sender: TObject);
begin
  StatusBar1.Panels[1].Text := '連接斷開';
end;

//在連接狀態改變時進行處理
procedure TF_FTP.IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: String);
begin
  DebugList.ItemIndex := DebugList.Items.Add(AStatusText);
  StatusBar1.Panels[1].Text := AStatusText;
end;

//在進行緩衝區讀寫時進行適當的處理 ：顯示下載和上傳速度
procedure TF_FTP.IdFTP1Work(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
  AverageSpeed := (AWorkCount / 1024) / DLTime;
  //顯示 下載和上傳速度
  S := FormatFloat('0.00 KB/s', AverageSpeed);
  case AWorkMode of
    wmRead: StatusBar1.Panels[1].Text := '下載速度： ' + S;
    wmWrite: StatusBar1.Panels[1].Text := '上傳速度： ' + S;
  end;

  if AbortTransfer then IdFTP1.Abort;

  ProgressBar1.Position := AWorkCount;
  AbortTransfer := false;
end;

//在數據傳輸開始時進行適當的處理，顯示“放棄”按鈕，設置進度條狀態
procedure TF_FTP.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  TransferrignData := true;
  AbortButton.Visible := true;
  AbortTransfer := false;
  STime := Now;
  if AWorkCountMax > 0 then ProgressBar1.Max := AWorkCountMax
  else ProgressBar1.Max := BytesToTransfer;
  AverageSpeed := 0;
end;

//在數據傳輸結束時進行適當的處理，隱藏“放棄”按鈕，設置狀態
procedure TF_FTP.IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  AbortButton.Visible := false;
  StatusBar1.Panels[1].Text := '傳輸結束';
  BytesToTransfer := 0;
  TransferrignData := false;
  ProgressBar1.Position := 0;
  AverageSpeed := 0;
end;
//***********************其它組件事件***********************
//是否使用被動連接
procedure TF_FTP.Checkbox1Click(Sender: TObject);
begin
  IdFTP1.Passive := Checkbox1.Checked;
end;

 //設置是否顯示連接跟蹤信息
procedure TF_FTP.Checkbox2Click(Sender: TObject);
begin
  IdLogDebug1.Active := Checkbox2.Checked;
  DebugList.Visible := Checkbox2.Checked;
  if DebugList.Visible then Splitter1.Top := DebugList.Top + 5;
end;

//目錄列表框單擊事件 ：根據用戶單擊目錄還是文件的不同設置下載按鈕的標題
procedure TF_FTP.DirectoryListClick(Sender: TObject);
Var
  Line: String;
  IsDirectory: Boolean;
begin
  if not IdFTP1.Connected then exit;
  Line := DirectoryList.Items[DirectoryList.ItemIndex];
  GetNameFromDirLine(Line, IsDirectory);
  if IsDirectory then DownloadButton.Caption := '修改路徑'
  else DownloadButton.Caption := '下載';
end;

procedure TF_FTP.IdLogDebug1Connect(ASender: TIdConnectionIntercept);
begin
 DebugList.ItemIndex := DebugList.Items.Add('正在建立連接');
end;

procedure TF_FTP.IdLogDebug1Disconnect(ASender: TIdConnectionIntercept);
begin
 DebugList.ItemIndex := DebugList.Items.Add('正在斷開連接');
end;

end.