ftpclient.~pas

Delphi 开 发的 一个 小的 FTP 程序。。。。有需要的

unit FtpClient;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, FileCtrl, ComCtrls, ImgList,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP,IdFTPList,
  Menus;

type
  TFrmMain = class(TForm)
    GroupBox2: TGroupBox;
    GroupBox4: TGroupBox;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    EditHostAddress: TEdit;
    EditPort: TEdit;
    EditUsername: TEdit;
    EditPassword: TEdit;
    LinkServer: TBitBtn;
    GroupBox3: TGroupBox;
    MemoMessage: TMemo;
    GroupBox6: TGroupBox;
    Panel2: TPanel;
    DriveComboBox1: TDriveComboBox;
    ListViewRemoteFile: TListView;
    ListViewLocalFile: TListView;
    ImageList1: TImageList;
    FTPCLIENT: TIdFTP;
    PopupMenuLocal: TPopupMenu;
    LocalCreateDirectory: TMenuItem;
    LocalDeleteFile: TMenuItem;
    N3: TMenuItem;
    UploadFile: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    BigIcon: TMenuItem;
    SmallIcon: TMenuItem;
    List: TMenuItem;
    Detail: TMenuItem;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    ListViewSendFile: TListView;
    PopupMenuRemote: TPopupMenu;
    RemoteRenameFile: TMenuItem;
    RemoteDeleteFile: TMenuItem;
    N4: TMenuItem;
    RemoteCreateDirectory: TMenuItem;
    N8: TMenuItem;
    DownloadFile: TMenuItem;
    procedure DriveComboBox1Change(Sender: TObject);
    procedure ListViewLocalFileDblClick(Sender: TObject);
    procedure LinkServerClick(Sender: TObject);
    procedure ListViewRemoteFileDblClick(Sender: TObject);
    procedure BigIconClick(Sender: TObject);
    procedure SmallIconClick(Sender: TObject);
    procedure ListClick(Sender: TObject);
    procedure DetailClick(Sender: TObject);
    procedure ListViewLocalFileContextPopup(Sender: TObject;
      MousePos: TPoint; var Handled: Boolean);
    procedure UploadFileClick(Sender: TObject);
    procedure ListViewRemoteFileContextPopup(Sender: TObject;
      MousePos: TPoint; var Handled: Boolean);
    procedure DownloadFileClick(Sender: TObject);
    procedure RemoteCreateDirectoryClick(Sender: TObject);
    procedure RemoteDeleteFileClick(Sender: TObject);
    procedure LocalCreateDirectoryClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure LocalDeleteFileClick(Sender: TObject);
    procedure RemoteRenameFileClick(Sender: TObject);
  private
    procedure DisplayLocalFileList();
    procedure DisplayRemoteFileList();
  public
    IsTransferring : Boolean;   //是否正在传送文件
    LocalPath: string;          //当前本地路径
    RemotePath: string;         //当前服务器路径
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.dfm}

//显示本地文件列表
procedure TFrmMain.DisplayLocalFileList();
var
  sr: TSearchRec;  
  Item : TListItem;
begin
  SetCurrentDir(LocalPath);  //设置当前路径
  ListViewLocalFile.Clear;  //清空本地文件列表
  if Length(LocalPath)>3 then //不是根目录
  begin
    //填加上级目录项目
    Item:=ListViewLocalFile.Items.Add;
    Item.ImageIndex:=0;
    Item.Caption:='..';
    Item.SubItems.Add('上级目录');
    Item.SubItems.Add('');
    Item.SubItems.Add('');
  end;
  //填加文件夹
  if FindFirst('*', faDirectory, sr) = 0 then
  begin
    repeat
      if ((sr.Attr and faDirectory) = sr.Attr) and (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        Item:=ListViewLocalFile.Items.Add;
        Item.ImageIndex:=0;    //图标序号
        Item.Caption:=sr.Name;       //文件夹名
        Item.SubItems.Add('文件夹');
        Item.SubItems.Add('');
        Item.SubItems.Add(DateTimeToStr(FileDateToDateTime(sr.Time)));      //时间
      end;
    until FindNext(sr) <> 0;  //下一个
    FindClose(sr);   //结束查找
  end;
  //填加文件
  if FindFirst('*', faArchive, sr) = 0 then
  begin
    repeat
      Item:=ListViewLocalFile.Items.Add;
      Item.ImageIndex:=1;      //图标序号
      Item.Caption:=sr.Name;  //文件名
      Item.SubItems.Add('');
      Item.SubItems.Add(IntToStr(sr.Size));  //文件大小
      Item.SubItems.Add(DateTimeToStr(FileDateToDateTime(sr.Time)));  //时间
    until FindNext(sr) <> 0;    //下一个
    FindClose(sr);  //结束查找
  end;
end;

//显示远程文件列表
procedure TFrmMain.DisplayRemoteFileList();
Var
  LS: TStringList;
  FileCount : Integer;
  newItem : TListItem;
begin
  try
    LS := TStringList.Create;
    FTPClient.ChangeDir(RemotePath);  //设置FTP服务器当前目录
    ListViewRemoteFile.Items.Clear;  //清空远程文件列表

    FTPClient.List(LS);    //得到文件和目录列表
    //处理LS的每个项目
    for FileCount:=0 to LS.Count - 1 do
    begin
      //是目录吗？
      if FTPClient.DirectoryListing.Items[FileCount].ItemType = ditDirectory then
      begin
        //添加目录项目
        newItem := ListViewRemoteFile.Items.Insert(0);
        newItem.ImageIndex := 0;   //图标序号
        newItem.subItems.Add('文件夹');
      end
      else
      begin
        //添加文件项目
        newItem := ListViewRemoteFile.Items.Add;
        newItem.ImageIndex := 1;     //图标序号
        newItem.subItems.Add('');
      end ;
      newItem.Caption := FTPClient.DirectoryListing.Items[FileCount].FileName;   //文件名
      newItem.subItems.Add(IntToStr(FTPClient.DirectoryListing.Items[FileCount].Size));  //文件大小
      newItem.subItems.Add(DateTimeToStr(FTPClient.DirectoryListing.Items[FileCount].ModifiedDate)); //时间
    end;
    if Length(RemotePath)>1 then  //不是根目录
    begin
      //填加上级目录项目
      newItem:=ListViewRemoteFile.Items.Insert(0);
      newItem.ImageIndex:=0;  //图标序号
      newItem.Caption:='..';
      newItem.SubItems.Add('上级目录');
      newItem.SubItems.Add('');
      newItem.SubItems.Add('');
    end;
  finally
    LS.Free;   //释放TStringList
  end;
end;

//本地驱动器选择
procedure TFrmMain.DriveComboBox1Change(Sender: TObject);
begin
  LocalPath:= DriveComboBox1.Drive+':\';   //本地路径
  DisplayLocalFileList();   //刷新本地文件列表
end;

//本地文件列表双击事件
procedure TFrmMain.ListViewLocalFileDblClick(Sender: TObject);
var
  TmpFileName : String;
begin
  if ListViewLocalFile.Selected = nil then  //  没有选择列表项目
    Exit;
  TmpFileName :=ListViewLocalFile.Selected.Caption;  // 得到文件名
  if ListViewLocalFile.Selected.SubItems[0] = '上级目录' then  //是上级目录吗？
  begin
    LocalPath:=LocalPath+'.txt';
    LocalPath:=ExtractFileDir(LocalPath);  //得到上级目录完整路径
    DisplayLocalFileList();                //刷新本地文件列表
  end
  else if ListViewLocalFile.Selected.SubItems[0] = '文件夹' then     //是文件夹吗？
       begin
         if Length(LocalPath)=3 then                //是根目录吗？
           LocalPath := LocalPath + TmpFileName
         else
           LocalPath := LocalPath + '\' + TmpFileName;
         DisplayLocalFileList();       //刷新本地文件列表
       end
       else   //是文件，上传文件
       begin
         if not FTPClient.Connected Then  //和服务器建立连接否？
           Exit;
         if MessageDlg('是否上传该文件？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
           UploadFileClick(Sender);     //上传文件
       end;
end;

//连接到服务器
procedure TFrmMain.LinkServerClick(Sender: TObject);
begin
  if FTPClient.Connected then  //已经建立了连接吗？
  begin
    if MessageDlg('断开当前连接吗？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
    begin
      try
        if IsTransferring then      //正在传送文件吗？
          FTPClient.Abort;   // 断开连接
        FTPClient.Quit;  //退出连接
      Except
        ShowMessage('正在传送文件，请稍候！');
      end;
    end
    else
      exit;  //退出本过程
  end;
  try
     //连接服务器属性设置
    FTPClient.Host:=EditHostAddress.Text;
    FTPClient.Port:=StrToInt(EditPort.Text);
    FTPClient.UserName:=EditUserName.Text;
    FTPClient.Password:=EditPassWord.Text;
    FTPClient.Connect;   //连接
    MemoMessage.Lines.AddStrings(FTPClient.LoginMsg.Text);
    //服务器路径初始化
    RemotePath:='/';
   //刷新服务器文件列表
    DisplayRemoteFileList();
  except
    MessageDlg('不能和服务器建立连接！',mtError, [mbYes],0);
  end;
end;

//服务器文件列表双击事件
procedure TFrmMain.ListViewRemoteFileDblClick(Sender: TObject);
var
  FileName : String;
begin
  if not FTPClient.Connected Then  //没有连接到服务器，退出
    Exit;
  if ListViewRemoteFile.Selected = nil then  //没有选中文件，退出
    Exit;
  FileName := ListViewRemoteFile.Selected.Caption;    //文件名
  if ListViewRemoteFile.Selected.SubItems[0] = '上级目录' then  //是上级目录吗？
  begin
    FTPClient.ChangeDirUp;  //到上级目录
    RemotePath:= FtpClient.RetrieveCurrentDir;   //FTP服务器的当前目录名称
    DisplayRemoteFileList();  //刷新服务器文件列表
  end
  else if ListViewRemoteFile.Selected.SubItems[0]='文件夹' then
       begin
         RemotePath := RemotePath+'/'+FileName;      //下级目录名称
        //刷新服务器文件列表
         DisplayRemoteFileList();
       end
       else
       if MessageDlg('是否下载该文件？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
         DownloadFileClick(Sender);    //下载文件
end;

procedure TFrmMain.BigIconClick(Sender: TObject);
begin
  ListViewLocalFile.ViewStyle:=vsIcon;
end;

procedure TFrmMain.SmallIconClick(Sender: TObject);
begin
  ListViewLocalFile.ViewStyle:=vsSmallIcon;
end;

procedure TFrmMain.ListClick(Sender: TObject);
begin