Indy9的IdFTP完全使用
作者：互联网
Delphi 7自带的INDY控件，其中包含了IdFTP，可以方便的实现FTP客户端程序，参考自带的例子，其中有上传、下载、删除文件，但是不包含对文件夹的操作，得自己实现上传、下载、删除整个文件夹（带子目录和文件）。于是自己参考了网上的资料，重新整理下，使用归纳如下示例工程所示：
窗体上放置TIdFTP、TIdAntiFreeze组件，还有其他一些基本控件。当在列表框选择的是“文件夹”时，点击“下载”、“删除”就会对此文件夹进行下载或删除，若是选择的是“文件”类型，则对单个文件操作；上传分单个文件上传和上传整个目录。工程源码如下：
{*******************************************************}
{ }
{ 系统名称 IdFTP完全使用 }
{ 版权所有 (C) http://blog.csdn.net/akof1314 }
{ 单元名称 Unit1.pas }
{ 单元功能 在Delphi 7下实现FTP客户端 }
{ }
{*******************************************************}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, IdFTPCommon, IdFTPList, ComCtrls, IdGlobal,
IdAntiFreezeBase, IdAntiFreeze, FileCtrl;
type
TForm1 = class(TForm)
idftp_Client: TIdFTP;
edt_CurrentDirectory: TEdit;
lst_ServerList: TListBox;
edt_ServerAddress: TEdit;
edt_UserName: TEdit;
edt_UserPassword: TEdit;
lbl1: TLabel;
lbl2: TLabel;
lbl3: TLabel;
lbl4: TLabel;
btn_Connect: TButton;
btn_EnterDirectory: TButton;
btn_Back: TButton;
btn_Download: TButton;
btn_Upload: TButton;
btn_Delete: TButton;
btn_MKDirectory: TButton;
btn_Abort: TButton;
mmo_Log: TMemo;
pb_ShowWorking: TProgressBar;
dlgSave_File: TSaveDialog;
lbl_ShowWorking: TLabel;
idntfrz1: TIdAntiFreeze;
dlgOpen_File: TOpenDialog;
btn_UploadDirectory: TButton;
procedure btn_ConnectClick(Sender: TObject);
procedure btn_EnterDirectoryClick(Sender: TObject);
procedure btn_BackClick(Sender: TObject);
procedure lst_ServerListDblClick(Sender: TObject);
procedure btn_DownloadClick(Sender: TObject);
procedure idftp_ClientWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure idftp_ClientWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure idftp_ClientWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
procedure FormCreate(Sender: TObject);
procedure btn_AbortClick(Sender: TObject);
procedure btn_UploadClick(Sender: TObject);
procedure btn_DeleteClick(Sender: TObject);
procedure btn_MKDirectoryClick(Sender: TObject);
procedure btn_UploadDirectoryClick(Sender: TObject);
private
FTransferrignData: Boolean; //是否在传输数据
FBytesToTransfer: LongWord; //传输的字节大小
FAbortTransfer: Boolean; //取消数据传输
STime : TDateTime; //时间
FAverageSpeed : Double; //平均速度
procedure ChageDir(DirName: String);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{-------------------------------------------------------------------------------
Description: 窗体创建函数
-------------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
Self.DoubleBuffered := True; //开启双缓冲，使得lbl_ShowWorking描述不闪烁
idntfrz1.IdleTimeOut := 50;
idntfrz1.OnlyWhenIdle := False;
end;
{-------------------------------------------------------------------------------
Description: 连接、断开连接
-------------------------------------------------------------------------------}
procedure TForm1.btn_ConnectClick(Sender: TObject);
begin
btn_Connect.Enabled := False;
if idftp_Client.Connected then
begin
//已连接
try
if FTransferrignData then //是否数据在传输
idftp_Client.Abort;
idftp_Client.Quit;
finally
btn_Connect.Caption := '连接';
edt_CurrentDirectory.Text := '/';
lst_ServerList.Items.Clear;
btn_Connect.Enabled := True;
mmo_Log.Lines.Add(DateTimeToStr(Now) + '断开服务器');
end;
end
else
begin
//未连接
with idftp_Client do
try
Passive := True; //被动模式
Username := Trim(edt_UserName.Text);
Password := Trim(edt_UserPassword.Text);
Host := Trim(edt_ServerAddress.Text);
Connect();
Self.ChageDir(edt_CurrentDirectory.Text);
finally
btn_Connect.Enabled := True;
if Connected then
btn_Connect.Caption := '断开连接';
mmo_Log.Lines.Add(DateTimeToStr(Now) + '连接服务器');
end;
end;
end;
{-------------------------------------------------------------------------------
Description: 改变目录
-------------------------------------------------------------------------------}
procedure TForm1.ChageDir(DirName: String);
var
LS: TStringList;
i: Integer;
begin
LS := TStringList.Create;
try
idftp_Client.ChangeDir(AnsiToUtf8(DirName));
idftp_Client.TransferType := ftASCII;
edt_CurrentDirectory.Text := Utf8ToAnsi(idftp_Client.RetrieveCurrentDir);
idftp_Client.List(LS);
LS.Clear;
with idftp_Client.DirectoryListing do
begin
for i := 0 to Count - 1 do
begin
if Items[i].ItemType = ditDirectory then
LS.Add(Format('%-22s%15s%-10s%s',[Utf8ToAnsi(Items[i].FileName),IntToStr(Items[i].Size),' 文件夹',DateTimeToStr(Items[i].ModifiedDate)]))
else
LS.Add(Format('%-22s%15s%-10s%s',[Utf8ToAnsi(Items[i].FileName),IntToStr(Items[i].Size),' 文件',DateTimeToStr(Items[i].ModifiedDate)]));
end;
end;
lst_ServerList.Items.Clear;
lst_ServerList.Items.Assign(LS);
finally
LS.Free;
end;
end;
{-------------------------------------------------------------------------------
Description: 进入目录按钮
-------------------------------------------------------------------------------}
procedure TForm1.btn_EnterDirectoryClick(Sender: TObject);
begin
Self.ChageDir(edt_CurrentDirectory.Text);
end;
{-------------------------------------------------------------------------------
Description: 后退按钮
-------------------------------------------------------------------------------}
procedure TForm1.btn_BackClick(Sender: TObject);
begin
Self.ChageDir('..');
end;
{-------------------------------------------------------------------------------
Description: 双击文件夹名称，进入该目录
-------------------------------------------------------------------------------}
procedure TForm1.lst_ServerListDblClick(Sender: TObject);
begin
if not idftp_Client.Connected then
Exit;
if idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].ItemType = ditDirectory then
Self.ChageDir(Utf8ToAnsi(idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].FileName));
end;
{-------------------------------------------------------------------------------
Description: 下载按钮
-------------------------------------------------------------------------------}
procedure TForm1.btn_DownloadClick(Sender: TObject);
procedure DownloadDirectory(var idFTP: TIdFtp;LocalDir, RemoteDir: string);
var
i,DirCount: Integer;
strName: string;
begin
if not DirectoryExists(LocalDir + RemoteDir) then
begin
ForceDirectories(LocalDir + RemoteDir); //创建一个全路径的文件夹
mmo_Log.Lines.Add('建立目录：' + LocalDir + RemoteDir);
end;
idFTP.ChangeDir(AnsiToUtf8(RemoteDir));
idFTP.TransferType := ftASCII;
idFTP.List(nil);
DirCount := idFTP.DirectoryListing.Count;
for i := 0 to DirCount - 1 do
begin
strName := Utf8ToAnsi(idFTP.DirectoryListing.Items[i].FileName);
mmo_Log.Lines.Add('解析文件：' + strName);
if idFTP.DirectoryListing.Items[i].ItemType = ditDirectory then
if (strName = '.') or (strName = '..') then
Continue
else
begin
DownloadDirectory(idFTP,LocalDir + RemoteDir + '/', strName);
idFTP.ChangeDir('..');
idFTP.List(nil);
end
else
begin
if (ExtractFileExt(strName) = '.txt') or (ExtractFileExt(strName) = '.html') or (ExtractFileExt(strName) = '.htm') then
idFTP.TransferType := ftASCII //文本模式
else
idFTP.TransferType := ftBinary; //二进制模式
FBytesToTransfer := idFTP.Size(AnsiToUtf8(strName)); ;
idFTP.Get(AnsiToUtf8(strName), LocalDir + RemoteDir + '/' + strName, True);
mmo_Log.Lines.Add('下载文件：' + strName);
end;
Application.ProcessMessages;
end;
end;
var
strName: string;
strDirectory: string;
begin
if not idftp_Client.Connected then
Exit;
btn_Download.Enabled := False;
strName := idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].FileName;
if idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].ItemType = ditDirectory then
begin
if SelectDirectory('选择目录保存路径','',strDirectory) then
begin
DownloadDirectory(idftp_Client,strDirectory + '/',Utf8ToAnsi(strName));
idftp_Client.ChangeDir('..');
idftp_Client.List(nil);
end;
end
else
begin
//下载单个文件
dlgSave_File.FileName := Utf8ToAnsi(strName);
if dlgSave_File.Execute then
begin
idftp_Client.TransferType := ftBinary;
FBytesToTransfer := idftp_Client.Size(strName);
if FileExists(dlgSave_File.FileName) then
begin
case MessageDlg('文件已经存在，是否要继续下载？', mtConfirmation, mbYesNoCancel, 0) of
mrCancel: //退出操作
begin
Exit;
end;
mrYes: //断点继续下载文件
begin
FBytesToTransfer := FBytesToTransfer - FileSizeByName(strName);
idftp_Client.Get(strName,dlgSave_File.FileName,False,True);
end;
mrNo: //从头开始下载文件
begin
idftp_Client.Get(strName,dlgSave_File.FileName,True);
end;
end;
end
else
idftp_Client.Get(strName, dlgSave_File.FileName, False);
end;
end;
btn_Download.Enabled := True;
end;
{-------------------------------------------------------------------------------
Description: 读写操作的工作事件
-------------------------------------------------------------------------------}
procedure TForm1.idftp_ClientWork(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
FAverageSpeed := (AWorkCount / 1024) / DLTime; //求平均速度
if FAverageSpeed > 0 then
begin
Sec := Trunc(((pb_ShowWorking.Max - AWorkCount) / 1024) / FAverageSpeed);
S := Format('%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);
S := '剩余时间 ' + S;
end
else
S := '';
S := FormatFloat('0.00 KB/s', FAverageSpeed) + '; ' + S;
case AWorkMode of
wmRead: lbl_ShowWorking.Caption := '下载速度 ' + S;
wmWrite: lbl_ShowWorking.Caption := '上传速度 ' + S;
end;
if FAbortTransfer then //取消数据传输
idftp_Client.Abort;
pb_ShowWorking.Position := AWorkCount;
FAbortTransfer := false;
end;
{-------------------------------------------------------------------------------
Description: 开始读写操作的事件
-------------------------------------------------------------------------------}
procedure TForm1.idftp_ClientWorkBegin(Sender: TObject;
AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
FTransferrignData := True;
btn_Abort.Enabled := True;
FAbortTransfer := False;
STime := Now;
if AWorkCountMax > 0 then
pb_ShowWorking.Max := AWorkCountMax
else
pb_ShowWorking.Max := FBytesToTransfer;
FAverageSpeed := 0;
end;
{-------------------------------------------------------------------------------
Description: 读写操作完成之后的事件
-------------------------------------------------------------------------------}
procedure TForm1.idftp_ClientWorkEnd(Sender: TObject;
AWorkMode: TWorkMode);
begin
btn_Abort.Enabled := False;
FTransferrignData := False;
FBytesToTransfer := 0;
pb_ShowWorking.Position := 0;
FAverageSpeed := 0;
lbl_ShowWorking.Caption := '传输完成';
end;
{-------------------------------------------------------------------------------
Description: 取消按钮
-------------------------------------------------------------------------------}
procedure TForm1.btn_AbortClick(Sender: TObject);
begin
FAbortTransfer := True;
end;
{-------------------------------------------------------------------------------
Description: 上传按钮
-------------------------------------------------------------------------------}
procedure TForm1.btn_UploadClick(Sender: TObject);
begin
if idftp_Client.Connected then
begin
if dlgOpen_File.Execute then
begin
idftp_Client.TransferType := ftBinary;
idftp_Client.Put(dlgOpen_File.FileName, AnsiToUtf8(ExtractFileName(dlgOpen_File.FileName)));
ChageDir(Utf8ToAnsi(idftp_Client.RetrieveCurrentDir));
end;
end;
end;
{-------------------------------------------------------------------------------
Description: 删除按钮
-------------------------------------------------------------------------------}
procedure TForm1.btn_DeleteClick(Sender: TObject);
procedure DeleteDirectory(var idFTP: TIdFtp; RemoteDir: string);
var
i,DirCount: Integer;
strName: string;
begin
idFTP.List(nil);
DirCount := idFTP.DirectoryListing.Count;
if DirCount = 2 then
begin
idFTP.ChangeDir('..');
idFTP.RemoveDir(RemoteDir);
idFTP.List(nil);
Application.ProcessMessages;
mmo_Log.Lines.Add('删除文件夹：' + Utf8ToAnsi(RemoteDir));
Exit;
end;
for i := 0 to 2 do
begin
strName := idFTP.DirectoryListing.Items[i].FileName;
if idFTP.DirectoryListing.Items[i].ItemType = ditDirectory then
begin
if (strName = '.') or (strName = '..') then
Continue;
idFTP.ChangeDir(strName);
DeleteDirectory(idFTP,strName);
DeleteDirectory(idFTP,RemoteDir);
end
else
begin
idFTP.Delete(strName);
Application.ProcessMessages;
mmo_Log.Lines.Add('删除文件：' + Utf8ToAnsi(strName));
DeleteDirectory(idFTP,RemoteDir);
end;
end;
end;
Var
strName: String;
begin
if not idftp_Client.Connected then
exit;
strName := idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].FileName;
if idftp_Client.DirectoryListing.Items[lst_ServerList.ItemIndex].ItemType = ditDirectory then
try
idftp_Client.ChangeDir(strName);
DeleteDirectory(idftp_Client,strName);
ChageDir(Utf8ToAnsi(idftp_Client.RetrieveCurrentDir));
finally
end
else //删除单个文件
try
idftp_Client.Delete(strName);
ChageDir(Utf8ToAnsi(idftp_Client.RetrieveCurrentDir));
finally
end;
end;
{-------------------------------------------------------------------------------
Description: 新建目录按钮
-------------------------------------------------------------------------------}
procedure TForm1.btn_MKDirectoryClick(Sender: TObject);
var
S: string;
begin
if InputQuery('新建目录','文件夹名称',S) and (Trim(S) <> '') then
begin
idftp_Client.MakeDir(AnsiToUtf8(S));
Self.ChageDir(Utf8ToAnsi(idftp_Client.RetrieveCurrentDir));
end;
end;
{-------------------------------------------------------------------------------
Description: 上传目录按钮
-------------------------------------------------------------------------------}
procedure TForm1.btn_UploadDirectoryClick(Sender: TObject);
function DoUploadDir(idftp:TIdFTP;sDirName:String;sToDirName:String):Boolean;
var
hFindFile:Cardinal;
tfile:String;
sCurDir:String[255];
FindFileData:WIN32_FIND_DATA;
begin
//先保存当前目录
sCurDir:=GetCurrentDir;
ChDir(sDirName);
idFTP.ChangeDir(AnsiToUtf8(sToDirName));
hFindFile:=FindFirstFile( '*.* ',FindFileData);
Application.ProcessMessages;
if hFindFile<>INVALID_HANDLE_VALUE then
begin
repeat
tfile:=FindFileData.cFileName;
if (tfile= '.') or (tfile= '..') then
Continue;
if FindFileData.dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY then
begin
try
IdFTP.MakeDir(AnsiToUtf8(tfile));
mmo_Log.Lines.Add('新建文件夹：' + tfile);
except
end;
DoUploadDir(idftp,sDirName+ '/'+tfile,tfile);
idftp.ChangeDir('..');
Application.ProcessMessages;
end
else
begin
IdFTP.Put(tfile, AnsiToUtf8(tfile));
mmo_Log.Lines.Add('上传文件：' + tfile);
Application.ProcessMessages;
end;
until FindNextFile(hFindFile,FindFileData)=false;
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//回到原来的目录下
ChDir(sCurDir);
result:=true;
end;
var
strPath,strToPath,temp: string;
begin
if idftp_Client.Connected then
begin
if SelectDirectory('选择上传目录','',strPath) then
begin
temp := Utf8ToAnsi(idftp_Client.RetrieveCurrentDir);
strToPath := temp;
if Length(strToPath) = 1 then
strToPath := strToPath + ExtractFileName(strPath)
else
strToPath := strToPath + '/' + ExtractFileName(strPath);
try
idftp_Client.MakeDir(AnsiToUtf8(ExtractFileName(strPath)));
except
end;
DoUploadDir(idftp_Client,strPath,strToPath);
Self.ChageDir(temp);
end;
end;
end;
end.运行工程如下图所示：
示例源码下载：https://download.csdn.net/download/akof1314/3236325
再分享一下我老师大神的人工智能教程吧。零基础！通俗易懂！风趣幽默！还带黄段子！希望你也加入到我们人工智能的队伍中来！http://www.captainbed.net
标签：begin,end,完全,Client,Indy9,IdFTP,btn,idftp,strName 来源： https://www.cnblogs.com/sjwics/p/10460962.html