当前位置：魔秘法略 > 程序介绍 > > 正文

delphi ftp下载文件问题

2025-03-31 0条评论

跟着魔秘法略一起了解下delphi下载的信息，希望可以帮你解决你现在所苦恼的问题。

delphi ftp下载文件问题

Delphi FTP例子源码

unit TransferThread;

////////////////////////////////////////////////////////////////////////////////

// 模块说明: FTP传输核心模块类

// 功能: 指定一个下载（上传)的日期或文件名，系统执行传输功能(支持续传）

// 备注：该模块属于传输类的一个子线程模块.

////////////////////////////////////////////////////////////////////////////////

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs,ComCtrls,StdCtrls,IniFiles,IdIntercept, IdLogBase, IdLogEvent, IdAntiFreezeBase,

IdAntiFreeze, IdFTPList,IdBaseComponent,IdGlobal,IdComponent, IdTCPConnection, IdTCPClient,IdFTPCommon,

IdFTP;

type

TTransferThread = class(TObject)

private

{ Private declarations }

//进度显示

FProgressbar:TProgressbar;

//上传核心组件

FFTP:TIdFTP;

//上传列表内部类

FCombobox:TCombobox;

//上传信息显示

FLabel:TLabel;

//FTP地址

FFTP_STR_HOST:String;

//FTP用户名

FFTP_STR_USN:String;

//FTP用户密码

FFTP_STR_PWD:String;

//FTP端口

FFTP_STR_PORT:String;

//FTP上传标记

FFTP_STR_UTAG:String;

//FTP下载标记

FFTP_STR_DTAG:String;

//FTP指定的文件夹

FFTP_STR_FLODER:STring;

//传输文件大小

FFTP_LWD_BYTES:LongWord;

//传输开始时间

FFTP_DT_BEGINTIME:TDateTime;

//传输

FFTP_DUB_SPEED:Double;

//是否删除源文件.

FFTP_BOL_DEL:Boolean;

//是否正在传输文件

FFTP_BOL_ISTRANSFERRING:Boolean;

//类内部通用对话框函数

function MsgBox(Msg:string;iValue:integer):integer;

//获取用户当前的Windows临时文件夹

function GetWinTempPath:String;

//根据日期生成的日期文件名

function DateToFileName(DateTime:TDateTime):String;

//根据上传/下载标记生成完整的文件名

function GetFileFullName(sTag:String;DateTime:TDateTime):String;

protected

//传输核心函数

function TransferKernel(iTag:Integer;sFile:string;bDelSFile:boolean=False):boolean;

//传输组件的WorkBegin事件

procedure FFTPOnWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);

//传输组件的WorkEnd事件

procedure FFTPOnWorkEnd(Sender: TObject; AWorkMode: TWorkMode);

//传输组件的Work事件

procedure FFTPOnWork(Sender: TObject; AWorkMode: TWorkMode;const AWorkCount: Integer);

public

//构造函数

constructor Create;

//析构函数

destructor Destroy;

//进度条控件属性

property Progressbar:TProgressbar read FProgressbar write FProgressbar default nil;

//列表控件属性

property Combobox:TCombobox read FCombobox write FCombobox default nil;

//只读的FTP核心组件

property FTP:TidFTP read FFTP;

//标签控件

property oLabel:TLabel read FLabel write FLabel default nil;

//列表方法(该方法需要指定Combobox,否则无效）

procedure List;

//依据日期下载文件

procedure DownLoad(dDate:TDateTime);overload;

//依据文件名下载文件

procedure DownLoad(sFileName:String);overload;

//依据日期上传文件

procedure UpLoad(dDate:TDateTime);overload;

//依据文件名上传文件

procedure UpLoad(sFileName:String);overload;

// procedure Execute; override;

end;

implementation

constructor TTransferThread.Create;

var

FFini:TIniFile;

FFilePath:String;

begin

//完成FTP相关参数的读取.

FFTP_BOL_ISTRANSFERRING:=False;

Try

FFilePath:=ExtractFilePath(APPlication.exeName)+'setup.ini';

FFini:=TIniFile.Create(FFilePath);

FFTP_STR_HOST:=FFini.ReadString('文件传输','服务器地址','');

FFTP_STR_PORT:=FFini.ReadString('文件传输','服务器端口','');

FFTP_STR_USN:=FFini.ReadString('文件传输','用户名','');

FFTP_STR_PWD:=FFini.ReadString('文件传输','密码','');

FFTP_STR_FLODER:=FFini.ReadString('文件传输','文件夹','');

FFTP_STR_UTAG:=FFini.ReadString('文件传输','上传标识码','');

FFTP_STR_DTAG:=FFini.ReadString('文件传输','上传标识码','');

FFTP_BOL_DEL:=FFini.ReadBool('文件传输','删源文件',FALSE);

FFIni.Free;

Except

MsgBox('读取FTP连接配置信息失败!请检查您的Setup.ini文件.',MB_OK+MB_ICONERROR);

Exit;

Abort;

End;

//设置FTP相关参数

Try

FFTP:=TId;

//事件驱动

Except

MsgBox('连接远程FTP服务器失败!'#10#13'1.服务器地址错误,或服务器不可用.'#10#13'2.用户名或密码不正确.'#10#13'3.FTP服务端口设置不正确.',MB_OK+MB_ICONERROR);

Exit;

Abort;

End;

end;

function TTransferThread.DateToFileName(DateTime: TDateTime): String;

var

Year, Month, Day:Word;

sYear,sMonth,sDay:String;

begin

DecodeDate(DateTime, Year, Month, Day); //日期

sYear:=inttostr(Year);

sMonth:=inttostr(Month);

sDay:=inttostr(Day);

//年

case Length(sYear) of

4: sYear:=sYear;

3: sYear:='0'+sYear;

2: sYear:='00'+sYear;

1: sYear:='000'+sYear;

else

sYear:='';

end;

//月

case Length(sMonth) of

2: sMonth:=sMonth;

1: sMonth:='0'+sMonth;

else

sMonth:='';

end;

//日

case Length(sDay) of

2: sDay:=sDay;

1: sDay:='0'+sDay;

else

sDay:='';

end;

if (sYear='') or (sMonth='') or (sDay='') then

begin

Result:='';

Exit;

end;

if (sYear<>'') and (sMonth<>'') and (sDay<>'') then

begin

Result:=sYear+sMOnth+sDay;

end;

destructor TTransferThread.Destroy;

begin

FProgressbar:=nil;

FCombobox:=nil;

FLabel:=nil;

end;

procedure TTransferThread.DownLoad(dDate: TDateTime);

begin

if Not FFTP_BOL_ISTRANSFERRING then

begin

TransferKernel(1,GetFileFullName(FFTP_STR_DTAG,dDate),FFTP_BOL_DEL);

end;

procedure TTransferThread.DownLoad(sFileName: String);

begin

if Not FFTP_BOL_ISTRANSFERRING then

TransferKernel(1,sFileName,FFTP_BOL_DEL);

end;

procedure TTransferThread.FFTPOnWork(Sender: TObject; AWorkMode: TWorkMode;

const AWorkCount: Integer);

var

S,E: String;

H, M, Sec, MS: Word;

TotalTime: TDateTime;

DLTime: Double;

begin

TotalTime := Now - FFTP_DT_BEGINTIME; //总用时

DecodeTime(TotalTime, H, M, Sec, MS); //取出时\分\秒\毫秒

Sec := Sec + M * 60 + H * 3600; //转换成秒

DLTime := Sec + MS / 1000; //最终的下载时间

E:= Format(' 使用时间:%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);

if DLTime > 0 then

//每秒的平均:XX K/s

FFTP_DUB_SPEED := {(AverageSpeed + }(AWorkCount / 1024) / DLTime{) / 2};

if FFTP_DUB_SPEED > 0 then

begin

Sec := Trunc(((FFTP_LWD_BYTES - AWorkCount) / 1024) / FFTP_DUB_SPEED);

S := Format(' 剩余时间:%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);

S:=': ' + FormatFloat('0.00 KB/秒',FFTP_DUB_SPEED) + S + E ;

end

else

S:='';

if (FLabel<>nil) and (assigned(FLabel)) then

begin

FLabel.AutoSize:=True;

FLabel.Caption:=S;

FLabel.Update;

end;

if (FProgressBar<>nil) and (assigned(FProgressBar)) then

begin

FProgressBar.Position:=AWorkCount; //进度显示

FProgressBar.Update;

end;

procedure TTransferThread.FFTPOnWorkBegin(Sender: TObject;

AWorkMode: TWorkMode; const AWorkCountMax: Integer);

begin

FFTP_BOL_ISTRANSFERRING:=True;

FFTP_DT_BEGINTIME:=Now; //开始时间

FFTP_DUB_SPEED:=0.0; //初始化速率

if (FProgressBar<>nil) and (assigned(FProgressBar)) then

begin

if AWorkCountMax>0 then

begin

FProgressBar.Max:=AWorkCountMax;

FFTP_LWD_BYTES:=FProgressBar.Max;

end

else

FProgressBar.Max:=FFTP_LWD_BYTES;

end;

procedure TTransferThread.FFTPOnWorkEnd(Sender: TObject;

AWorkMode: TWorkMode);

begin

FFTP_BOL_ISTRANSFERRING:=False;

FFTP_DUB_SPEED:=0.00;

if (FLabel<>nil) and (assigned(FLabel)) then

begin

FLabel.AutoSize:=True;

FLabel.Caption:='';

FLabel.Update;

end;

if (FProgressBar<>nil) and (assigned(FProgressBar)) then

begin

FProgressBar.Position:=0;

end;

function TTransferThread.GetFileFullName(sTag:String;DateTime:TDateTime):String;

begin

Result:=sTag+DateToFileName(DateTime)+'FD.HXD';

end;

function TTransferThread.GetWinTempPath: String;

var

TempDir:array [0255] of char;

begin

GetTempPath(255,@TempDir);

Result:=strPas(TempDir);

end;

procedure TTransferThread.List;

var

Dir_List:TStringList;

FoundFolder:Boolean;

iCount:Integer;

begin

if (FCombobox=nil) or (Not Assigned(FCombobox)) then

begin

Exit;

Abort;

end;

Dir_List:=TStringList.Create; //创建字符串列表类

Try

if Not F then F;

F('/');//根目录 //到服务器的根目录

F(Dir_List,'',True); //获取目录列表

FoundFolder:=False;

F; //更改传输类型(ASCII类型)

for iCount:=0 to Dir_List.Count-1 do

begin

if F[iCount].ItemType=ditDirectory then

begin

if Dir_List.IndexOf(FFTP_STR_FLODER)= -1 then //判断该文件夹不存在

begin

//如果不存继续循环查找.

Continue;

end

else

begin

//如果存在,则直接退出循环

FoundFolder:=True;

Break;

end;

if FoundFolder then //判断该文件夹不存在

begin

F; //不存在，则创建一个新的文件夹

end;

F(Dir_List,'*.HXD',False);

if Dir_List.Count>0 then

begin

FCombobox.Items:=Dir_List;

end;

Finally

Dir_List.Free;

End;

end;

function TTransferThread.MsgBox(Msg: string; iValue: integer): integer;

begin

Result:=MessageBox(application.Handle,pChar(Msg),'系统信息',iValue+MB_APPLMODAL);

end;

function TTransferThread.TransferKernel(iTag: Integer; sFile: string;

bDelSFile: boolean): boolean;

var

sTmpPath:String;

Dir_List:TStringList;

FoundFolder:Boolean;

iCount:Integer;

begin

sTmpPath:=GetWinTempPath; //获取本地系统临时目录

Dir_List:=TStringList.Create; //创建字符串列表类

Try

if Not F then F;

F('/');//根目录 //到服务器的根目录

F; //更改传输类型(ASCII类型)

F(Dir_List,'',True); //获取目录列表

FoundFolder:=False;

for iCount:=0 to Dir_List.Count-1 do

begin

if F[iCount].ItemType=ditDirectory then //是目录

begin

if Dir_List.IndexOf(FFTP_STR_FLODER)= -1 then //判断该文件夹不存在

begin

//如果不存继续循环查找.

Continue;

end

else

begin

//如果存在,则直接退出循环

FoundFolder:=True;

Break;

end;

if FoundFolder then //判断该文件夹不存在

begin

F; //不存在，则创建一个新的文件夹

end;

//更改传输类型

Try

//找到相应的目录,则更换路径.

//0为上传

if iTag=0 then

begin

Try

Except

MsgBox('上传文件失败！原因如下:'#13#10'1.服务器没有开启写文件的权限!'#10#13'2.程序发生异常，请重新上传！',MB_OK+MB_ICONERROR);

Abort;

End;

FFTP_LWD_BYTES:=F;

if bDelSFile then //删除本地源文件

begin

DeleteFile(sTmpPath+sFile);

end;

Result:=True;

end;

//1为下载

if iTag=1 then

begin

//文件已经存在

Try

FFTP_LWD_BYTES:=F;

if FileExists(sTmpPath+sFile) then

begin

case MsgBox('文件已经存在，要续传吗？'#13#10'是--续传'#10#13'否--覆盖'#13#10'取消--取消操作',MB_YESNOCANCEL+MB_ICONINFORMATION) of

IDYES: begin

FFTP_LWD_BYTES:=FFTP_LWD_BYTES-FileSizeByName(sTmpPath+sFile);

//参数说明: 源文件，目标文件,是否覆盖,是否触发异常（True为不触发)。

end;

IDNO: begin

end;

IDCANCEL:

begin

FFTP_BOL_ISTRANSFERRING:=False;

end;

end

else //文件不存在

begin

end;

Except

MsgBox('上传文件失败！原因如下:'#13#10'1.服务器没有开启写文件的权限!'#10#13'2.程序发生异常，请重新上传！',MB_OK+MB_ICONERROR);

Abort;

End;

if bDelSFile then //删除远程源文件

begin

end;

Except

Result:=False;

End;

Finally

Dir_List.Free;

End;

end;

procedure TTransferThread.UpLoad(dDate: TDateTime);

begin

if Not FFTP_BOL_ISTRANSFERRING then

TransferKernel(0,GetFileFullName(FFTP_STR_DTAG,dDate),FFTP_BOL_DEL);

end;

procedure TTransferThread.UpLoad(sFileName: String);

begin

if Not FFTP_BOL_ISTRANSFERRING then

TransferKernel(0,sFileName,FFTP_BOL_DEL);

end;

end.

delphi2005、2008、2009下载地址。

版权声明

1.本站遵循行业规范，任何转载的稿件都会明确标注作者和来源；2.本站的原创文章，请转载时务必注明文章作者和来源，不尊重原创的行为我们将追究责任；3.作者投稿可能会经我们编辑修改或补充。

转载请注明来自，本文标题：delphi ftp下载文件问题
本文地址：https://www.mmfalv.com/down/18509.html

标签：