如何使用TIDFTD上传、下载文件?(请大侠指教)30(30分)

  • 主题发起人 主题发起人 dzb110
  • 开始时间 开始时间
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.Name <> 'AbortButton' then
Controls.Enabled := AValue;

with PopupMenu1 do
//设置弹出式菜单中的菜单项的活跃状态
for i := 0 to Items.Count - 1 do
Items.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.


 
你有没有界面呀?
 
接受答案了.
 
后退
顶部