一个简易的FTP客户端软件

一个简易的FTP客户端软件

刚学Delphi的菜鸟，参照资料做了一个FTP客户端软件，觉得学到了一点点皮毛，这是源代码。
unit Unit1;

interface

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

type
TFMain = class(TForm)
IdFTP1: TIdFTP;
GroupBox1: TGroupBox;
HostName: TLabeledEdit;
Port: TLabeledEdit;
UserName: TLabeledEdit;
PassWord: TLabeledEdit;
BitBtn1: TBitBtn;
MsgMemo: TMemo;
QueueList: TListView;
Splitter1: TSplitter;
Splitter2: TSplitter;
GroupBox2: TGroupBox;
Splitter3: TSplitter;
GroupBox3: TGroupBox;
Panel1: TPanel;
LocalFileList: TListView;
DriveComboBox1: TDriveComboBox;
BitBtn2: TBitBtn;
Panel2: TPanel;
RemoteFileList: TListView;
ComboHistory: TComboBox;
BitBtn3: TBitBtn;
PopLocal: TPopupMenu;
PopRemote: TPopupMenu;
ImageList1: TImageList;
ActionList1: TActionList;
connect: TAction;
Upload: TAction;
DownLoad: TAction;
LocalMakeDir: TAction;
LocalDel: TAction;
LocalDirUp: TAction;
LocalChangeDir: TAction;
RemoteChangeDir: TAction;
RemoteDel: TAction;
RemoteNewDir: TAction;
RemoteRename: TAction;
RemoteDirUp: TAction;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
LocalRefresh: TAction;
N8: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure RemoteChangeDirExecute(Sender: TObject);
procedure connectExecute(Sender: TObject);
procedure RemoteFileListDblClick(Sender: TObject);
procedure DownLoadExecute(Sender: TObject);
procedure RemoteDirUpExecute(Sender: TObject);
procedure UploadExecute(Sender: TObject);
procedure LocalDirUpExecute(Sender: TObject);
procedure LocalChangeDirExecute(Sender: TObject);
procedure LocalMakeDirExecute(Sender: TObject);
procedure RemoteDelExecute(Sender: TObject);
procedure RemoteNewDirExecute(Sender: TObject);
procedure LocalFileListContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure RemoteFileListContextPopup(Sender: TObject; MousePos: TPoint;
var Handled: Boolean);
procedure DriveComboBox1Change(Sender: TObject);
procedure LocalFileListDblClick(Sender: TObject);
procedure LocalRefreshExecute(Sender: TObject);
procedure LocalDelExecute(Sender: TObject);
private
{ Private declarations }
IsTransParent:Boolean; /////用于判断当前是否正在传输数据
LocalPath:String; ////用来记录当前路径
public
{ Public declarations }
end;

var
FMain: TFMain;

implementation

{$R *.dfm}

procedure TFMain.FormCreate(Sender: TObject);
begin
IsTransParent:=false; //////IsTransParent为假，没有数据传输
end;

procedure TFMain.RemoteChangeDirExecute(Sender: TObject);
var
LS:TStringList;
FileCount:Integer;
newItem:TListItem;
FolderCount:Integer;
begin
try
LS:=TStringList.Create; ///创建LS对象
self.IdFTP1.ChangeDir(ComboHistory.Text); //调用ChangDir更换当前目录到选定目录
// 以下代码显示当前目录列表
self.RemoteFileList.Items.Clear; ////清空文件列表已有数据
//默认参数调用List过程，利用DirectoryListing的解析结果，可以获得文件的各种属性
self.IdFTP1.List(LS);
FolderCount:=0;
for FileCount:=0 to LS.Count - 1 do
begin
///如果当前项为目录，插入到文件项前面
if IdFTP1.DirectoryListing.Items[FileCount].ItemType=ditDirectory then
begin
newItem:=self.RemoteFileList.Items.Insert(FolderCount);
newItem.ImageIndex:=0;
newItem.SubItems.Add('文件夹');
end
else
begin
///如果当前项为文件，直接添加到列表后面
newItem:=self.RemoteFileList.Items.Add;
newItem.ImageIndex:=1;
newItem.SubItems.Add('');
end;
newItem.Caption:=self.IdFTP1.DirectoryListing.Items[FileCount].FileName;
newItem.SubItems.Add(IntToStr(self.IdFTP1.DirectoryListing.Items[FileCount].Size));
newItem.SubItems.Add(DateToStr(IdFTP1.DirectoryListing.Items[FileCount].ModifiedDate));
end;
finally
LS.Free;
end;
end;

procedure TFMain.connectExecute(Sender: TObject);
begin
if self.IdFTP1.Connected then ///判断是否已经建立到服务器的连接
begin
/// 如果已经建立连接，提示用户是否中止当前下载过程及连接
if MessageDlg('是否中止当前下载过程及连接？',mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
try /////用户选择中止当前过程
if IsTransParent then ///////如果当前有数据传输操作
self.IdFTP1.Abort; //////取消当前数据传输
self.IdFTP1.Quit; //////断开当前连接
Except
showMessage('中止当前下载过程出错'); ////捕捉异常，错误处理
end;
end
else
exit; ////////用户选择否，则直接退出该过程
end;
try
////以下为新连接设置建立连接时所需要的属性
self.IdFTP1.Username:=Username.Text; ///账号
self.IdFTP1.Password:=PassWord.Text; ///密码
self.IdFTP1.Host:=HostName.Text; ///服务器地址
self.IdFTP1.Port:=StrToInt(Port.Text);///端口
self.IdFTP1.Connect; ///根据已经设置属性建立到FTP服务器的连接
MsgMemo.Lines.AddStrings(self.IdFTP1.LoginMsg.Text); ////显示登录信息
self.ComboHistory.Clear;
self.ComboHistory.Items.Add('/'); ///记录所有访问过的目录，初始化认为根目录
self.ComboHistory.ItemIndex:=0;
self.RemoteChangeDirExecute(Sender); ///更新RemoteFileList中的文件列表到服务器当前目录
Except
ShowMessage('连接服务器出错');
end;
end;

procedure TFMain.RemoteFileListDblClick(Sender: TObject);
var
FileName:String;
begin
if not self.IdFTP1.Connected then exit;
if self.RemoteFileList.Selected=nil then exit;
FileName:=self.RemoteFileList.Selected.Caption;
if self.RemoteFileList.Selected.SubItems[0]='文件夹' then ///如果双击选定的项为文件夹
begin
if self.ComboHistory.ItemIndex=0 then
FileName:='/'+FileName
else
FileName:=ComboHistory.Items[ComboHistory.ItemIndex]+'/'+FileName;
if self.ComboHistory.Items.IndexOf(FileName)=-1 then
self.ComboHistory.Items.Add(FileName);
self.ComboHistory.ItemIndex:=self.ComboHistory.Items.IndexOf(FileName);
self.RemoteChangeDirExecute(Sender);
end
else /////如果选中文件，提示是否下载此文件
if MessageDlg('是否下载此文件？',mtConfirmation,[mbYes,mbNo],0)= mrYes then
self.DownLoadExecute(Sender);
end;

procedure TFMain.DownLoadExecute(Sender: TObject);
var
FileName:String;
Item:TListItem;
QueueItem:TListItem;
begin
if not self.IdFTP1.Connected then exit;
if self.RemoteFileList.Selected=nil then exit;
///我们想让程序支持选定一批文件来下载，下面这个循环就是把所有选定的文件添加到QueuLIst
///列表中，下载过程中逐个从列表中读出文件名，从而下载所选文件。
///为了实现选中多个文件，我们首先还得设定RemoteFileList的MutiSelect属性为True
Item:=self.RemoteFileList.Selected;
self.QueueList.Clear;
while Item<>nil do
begin
QueueItem:=self.QueueList.Items.Add;
QueueItem.Caption:=Item.Caption;
QueueItem.SubItems.Add(LocalPath);
QueueItem.SubItems.Add(Item.SubItems[1]);
QueueItem.SubItems.Add('<-');
QueueItem.SubItems.Add('');
QueueItem.SubItems.Add(self.ComboHistory.Text);
Item:=self.RemoteFileList.GetNextItem(Item,sdAll,[isSelected]);
end;
self.QueueList.Refresh; ////刷新队列使用户可见
////设置这些组件为无效状态，使得在下载过程中，用户不会再触发事件
self.RemoteFileList.Enabled:=false;
self.ComboHistory.Enabled:=false;
self.RemoteDirUp.Enabled:=false;
self.IsTransParent:=true;
try
while self.QueueList.Items.Count>0 do
begin
FileName:=self.QueueList.Items[0].Caption;
self.QueueList.Items[0].SubItems[3]:='正在下载'; ///显示当前下载过程的状态
self.QueueList.Refresh;
if FileExists(FileName) then
begin
if MessageDlg('文件已存在，是否继续？',mtConfirmation,[mbYes,mbNo],0)=mrYes then
///调用Get过程来下载文件
self.IdFTP1.Get(FileName,LocalPath+'/'+FileName,false,true) //续传该文件
else
self.IdFTP1.Get(FileName,LocalPath+'/'+FileName,true); //覆盖该文件
end
else
self.IdFTP1.Get(FileName,LocalPath+'/'+FileName,false);
self.QueueList.Items[0].Delete; ///从文件列表中删除已下载文件
self.QueueList.Refresh;
self.RemoteChangeDirExecute(Sender); ///更新本地文件列表
end;self.RemoteFileList.Enabled:=true;
self.ComboHistory.Enabled:=true;
self.RemoteDirUp.Enabled:=true;
self.IsTransParent:=false;
except
self.QueueList.Items[0].SubItems[3]:='错误';
showMessage('下载文件错误！！');
self.RemoteFileList.Enabled:=true;
self.ComboHistory.Enabled:=true;
self.RemoteDirUp.Enabled:=true;
self.IsTransParent:=false;
end;
end;

procedure TFMain.RemoteDirUpExecute(Sender: TObject);
begin
if self.IdFTP1.Connected then
begin
self.IdFTP1.ChangeDirUp; ///调用ChangeDirUp过程来实现返回到上一级目录
self.ComboHistory.ItemIndex:=ComboHistory.Items.IndexOf(IdFTP1.RetrieveCurrentDir);
self.RemoteChangeDirExecute(Sender);
end;
end;

procedure TFMain.UploadExecute(Sender: TObject);
var
FileName:string;
Item:TListItem;
QueueItem:TListItem;
begin
if not self.IdFTP1.Connected then exit;
if self.LocalFileList.Selected=nil then exit;
Item:=self.LocalFileList.Selected;
///保存要上传的文件列表
self.QueueList.Clear;
while Item<>nil do
begin
QueueItem:=self.QueueList.Items.Add;
QueueItem.Caption:=Item.Caption;
QueueItem.SubItems.Add(LocalPath);
QueueItem.SubItems.Add(Item.SubItems[1]);
QueueItem.SubItems.Add('->');
QueueItem.SubItems.Add('');
QueueItem.SubItems.Add(self.ComboHistory.Text);
Item:=LocalFileList.GetNextItem(Item,sdAll,[isSelected]);
end;
self.QueueList.Refresh;
self.LocalFileList.Enabled:=false;
self.DriveComboBox1.Enabled:=false;
self.RemoteFileList.Enabled:=false;
self.ComboHistory.Enabled:=false;
self.RemoteDirUp.Enabled:=false;
self.IsTransParent:=True;
try
while self.QueueList.Items.Count>0 do
begin
FileName:=self.QueueList.Items[0].Caption;
self.QueueList.Items[0].SubItems[3]:='正在上传';
self.QueueList.Refresh;
////调用Put过程来上传文件
self.IdFTP1.Put(LocalPath+'/'+FileName,FileName);
self.RemoteChangeDirExecute(Sender);
self.QueueList.Items[0].Delete;
self.QueueList.Refresh;
end;
self.LocalFileList.Enabled:=true;
self.DriveComboBox1.Enabled:=true;
self.RemoteFileList.Enabled:=true;
self.ComboHistory.Enabled:=true;
self.RemoteDirUp.Enabled:=true;
self.IsTransParent:=false;
except
self.QueueList.Items[0].SubItems[3]:='错误';
ShowMessage('上传文件错误');
self.LocalFileList.Enabled:=true;
self.DriveComboBox1.Enabled:=true;
self.RemoteFileList.Enabled:=true;
self.ComboHistory.Enabled:=true;
self.RemoteDirUp.Enabled:=true;
self.IsTransParent:=false;
end;
end;

///返回到本地上一级目录
procedure TFMain.LocalDirUpExecute(Sender: TObject);
begin
if length(LocalPath)=3 then exit; //已经是顶层目录，直接退出
LocalPath:=LocalPath+'.txt'; //用该方法使系统把最后一个目录当成文件
LocalPath:=ExtractFileDir(LocalPath);///ExtractFileDir得到LocalPath中绝对路径名
self.LocalChangeDirExecute(Sender);
end;

///更新本地当前目录和LocalFileList文件列表
///用API函数FindFirst,FindNext来获取当前目录下的所有文件和子目录
procedure TFMain.LocalChangeDirExecute(Sender: TObject);
var
sr:TSearchRec;
Item:TListItem;
begin
SetCurrentDir(LocalPath);
self.LocalFileList.Clear;
if FindFirst('*',faDirectory,sr)=0 then
begin
repeat
if ((sr.Attr and faDirectory)=sr.Attr) and (sr.Name<>'.') and (sr.Name<>'..')then
begin
Item:=self.LocalFileList.Items.Add;
Item.ImageIndex:=0;
Item.Caption:=sr.Name;
Item.SubItems.Add('文件夹');
Item.SubItems.Add('');
Item.SubItems.Add(DateTimeToStr(sr.Time));
end;
until FindNext(sr)<>0;
FindClose(sr);
end;
if FindFirst('*',faArchive,sr)=0 then
begin
repeat
Item:=self.LocalFileList.Items.Add;
Item.ImageIndex:=1;
Item.Caption:=sr.Name;
Item.SubItems.Add('');
Item.SubItems.Add(IntToStr(sr.Size));
Item.SubItems.Add(DateToStr(sr.Time));
until FindNext(sr)<>0;
FindClose(sr);
end;
end;

procedure TFMain.LocalMakeDirExecute(Sender: TObject);
var
NewFolder:String;
begin
NewFolder:=InputBox('新建文件夹','名字',''); ///输入新建文件夹名
if NewFolder<>'' then
try
CreateDir(NewFolder);
self.LocalChangeDirExecute(Sender);
except
showMessage('创建本地目录错误');
end;
end;

////删除一个远程空目录或文件
procedure TFMain.RemoteDelExecute(Sender: TObject);
var
FileName:string;
begin
if not self.IdFTP1.Connected then exit;
if self.RemoteFileList.Selected=nil then exit;
FileName:=self.RemoteFileList.Selected.Caption;
if self.RemoteFileList.Selected.SubItems[0]='文件夹' then
self.IdFTP1.RemoveDir(FileName) ///如果删除的是文件夹，调用RemoveDir过程来删除
else
self.IdFTP1.Delete(FileName); ///如果删除的是文件，调用Delete过程来删除
self.RemoteChangeDirExecute(Sender); ///更新服务器文件列表
end;

procedure TFMain.RemoteNewDirExecute(Sender: TObject);
var
NewFolder:string;
begin
if not self.IdFTP1.Connected then exit;
NewFolder:=InputBox('新建文件夹','名字','');
if NewFolder<>'' then
self.IdFTP1.MakeDir(NewFolder); ///调用MakeDir来建立新文件夹
self.RemoteChangeDirExecute(Sender);
end;

procedure TFMain.LocalFileListContextPopup(Sender: TObject;
MousePos: TPoint; var Handled: Boolean);
begin
if self.LocalFileList.Selected=nil then
begin
self.LocalMakeDir.Enabled:=true;
self.Upload.Enabled:=false;
end
else
begin
self.LocalMakeDir.Enabled:=false;
if self.LocalFileList.Selected.SubItems[0]='文件夹' then
self.Upload.Enabled:=false
else
self.Upload.Enabled:=true;
end;
end;

procedure TFMain.RemoteFileListContextPopup(Sender: TObject;
MousePos: TPoint; var Handled: Boolean);
begin
if self.RemoteFileList.Selected=nil then
begin
self.RemoteNewDir.Enabled:=true;
self.DownLoad.Enabled:=true;
self.RemoteRename.Enabled:=false;
self.RemoteDel.Enabled:=false;
end
else
begin
self.RemoteNewDir.Enabled:=false;
self.RemoteRename.Enabled:=true;
self.RemoteDel.Enabled:=true;
if self.RemoteFileList.Selected.SubItems[0]='文件夹' then
self.DownLoad.Enabled:=false
else self.DownLoad.Enabled:=true; ////如果是文件，可以下载
end;
end;

procedure TFMain.DriveComboBox1Change(Sender: TObject);
begin
LocalPath:=self.DriveComboBox1.Drive+':/';
self.LocalChangeDirExecute(Sender);
end;

procedure TFMain.LocalFileListDblClick(Sender: TObject);
var
FileName:string;
begin
if self.LocalFileList.Selected=nil then exit;
FileName:=self.LocalFileList.Selected.Caption;
if self.LocalFileList.Selected.SubItems[0]='文件夹' then
begin ///如果要求相应双击的是文件夹，则进入此文件夹
if Length(LocalPath)=3 then
self.LocalPath:=LocalPath+FileName
else LocalPath:=LocalPath+'/'+FileName;
self.LocalChangeDirExecute(Sender);
end
else
begin ////如果是文件，提示是否要上传该文件
if not self.IdFTP1.Connected then exit;
if MessageDlg('是否上传该文件？？',mtConfirmation,[mbYes,mbNo],0)=mrYes then
self.UploadExecute(Sender);
end;
end;

procedure TFMain.LocalRefreshExecute(Sender: TObject);
begin
if not self.IdFTP1.Connected then exit;
self.LocalFileList.Refresh;
self.LocalChangeDirExecute(Sender);
end;

procedure TFMain.LocalDelExecute(Sender: TObject);
var
FileName:string;
begin
if not self.IdFTP1.Connected then exit;
FileName:=self.LocalFileList.Selected.Caption;
if self.LocalFileList.Selected.SubItems[0]='文件夹' then
RemoveDir(FileName) ////只可删除空文件夹
else
deletefile(FileName);
self.LocalChangeDirExecute(Sender);
end;

end.