IDFTP 控件使用

最新推荐文章于 2018-11-11 08:24:40 发布
wwcz898
最新推荐文章于 2018-11-11 08:24:40 发布
阅读量3.8k
点赞数
分类专栏： delphi 文章标签： ftp服务器 string integer header function delete
delphi 专栏收录该内容
13 篇文章 0 订阅
订阅专栏
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.