unit U_FTP;interfaceuses 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);beginif 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.
