投稿
  1. 首页
  2. 教程

delphi ftp下载文件问题

绿营兵 • 2023-5-21 • 教程 • 阅读 15

delphi ftp下载文件问题,第1张

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:stringiValue:integer):integer

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

function GetWinTempPath:String

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

function DateToFileName(DateTime:TDateTime):String

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

function GetFileFullName(sTag:StringDateTime:TDateTime):String

protected

//传输核心函数

function TransferKernel(iTag:IntegersFile:stringbDelSFile:boolean=False):boolean

//传输组件的WorkBegin事件

procedure FFTPOnWorkBegin(Sender: TObjectAWorkMode: TWorkModeconst AWorkCountMax: Integer)

//传输组件的WorkEnd事件

procedure FFTPOnWorkEnd(Sender: TObjectAWorkMode: TWorkMode)

//传输组件的Work事件

procedure FFTPOnWork(Sender: TObjectAWorkMode: TWorkModeconst 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 Executeoverride

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:=TIdFTP.Create(nil)

FFTP.Host:=FFTP_STR_HOST

FFTP.Port:=strtoint(FFTP_STR_PORT)

FFTP.UserName:=FFTP_STR_USN

FFTP.Password:=FFTP_STR_PWD

FFTP.TransferType:=ftASCII

//事件驱动

FFTP.OnWork:=FFTPOnWork

FFTP.OnWorkBegin:=FFTPOnWorkBegin

FFTP.OnWorkEnd:=FFTPOnWorkEnd

FFTP.Connect(True,-1)

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

end

destructor TTransferThread.Destroy

begin

FProgressbar:=nil

FCombobox:=nil

FLabel:=nil

FFTP.Quit

FFTP.Free

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

end

procedure TTransferThread.DownLoad(sFileName: String)

begin

if Not FFTP_BOL_ISTRANSFERRING then

TransferKernel(1,sFileName,FFTP_BOL_DEL)

end

procedure TTransferThread.FFTPOnWork(Sender: TObjectAWorkMode: 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

end

procedure TTransferThread.FFTPOnWorkBegin(Sender: TObject

AWorkMode: TWorkModeconst 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

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

end

function TTransferThread.GetFileFullName(sTag:StringDateTime:TDateTime):String

begin

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

end

function TTransferThread.GetWinTempPath: String

var

TempDir:array [0..255] 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 FFTP.Connected then FFTP.Connect

FFTP.ChangeDir('/')//根目录 //到服务器的根目录

FFTP.List(Dir_List,'',True)//获取目录列表

FoundFolder:=False

FFTP.TransferType:=ftASCII//更改传输类型(ASCII类型)

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

begin

if FFTP.DirectoryListing.Items[iCount].ItemType=ditDirectory then

begin

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

begin

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

Continue

end

else

begin

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

FoundFolder:=True

Break

end

end

end

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

begin

FFTP.MakeDir(FFTP_STR_FLODER)//不存在，则创建一个新的文件夹

end

FFTP.ChangeDir(FFTP_STR_FLODER)

FFTP.List(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: stringiValue: integer): integer

begin

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

end

function TTransferThread.TransferKernel(iTag: IntegersFile: string

bDelSFile: boolean): boolean

var

sTmpPath:String

Dir_List:TStringList

FoundFolder:Boolean

iCount:Integer

begin

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

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

Try

if Not FFTP.Connected then FFTP.Connect

FFTP.ChangeDir('/')//根目录 //到服务器的根目录

FFTP.TransferType:=ftASCII//更改传输类型(ASCII类型)

FFTP.List(Dir_List,'',True)//获取目录列表

FoundFolder:=False

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

begin

if FFTP.DirectoryListing.Items[iCount].ItemType=ditDirectory then //是目录

begin

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

begin

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

Continue

end

else

begin

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

FoundFolder:=True

Break

end

end

end

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

begin

FFTP.MakeDir(FFTP_STR_FLODER)//不存在，则创建一个新的文件夹

end

//更改传输类型

FFTP.TransferType:=ftBinary

Try

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

FFTP.ChangeDir(FFTP_STR_FLODER)

//0为上传

if iTag=0 then

begin

Try

FFTP.Put(sTmpPath+sFile,sFile)

Except

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

Abort

End

FFTP_LWD_BYTES:=FFTP.Size(sFile)

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

begin

DeleteFile(sTmpPath+sFile)

end

Result:=True

FFTP.Disconnect

end

//1为下载

if iTag=1 then

begin

//文件已经存在

Try

FFTP_LWD_BYTES:=FFTP.Size(sFile)

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为不触发)。

FFTP.Get(sFile,sTmpPath+sFile,False,True)

end

IDNO: begin

FFTP.Get(sFile,sTmpPath+sFile,True)

end

IDCANCEL:

begin

FFTP_BOL_ISTRANSFERRING:=False

end

end

end

else //文件不存在

begin

FFTP.Get(sFile,sTmpPath+sFile,True)

end

Except

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

Abort

End

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

begin

FFTP.Delete(sFile)

end

FFTP.Disconnect

end

Except

FFTP.Quit

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.

你的服务端返回数据时先发送数据包的长度，然后再发送数据包。这样你在接收时先调用ReadInteger得到将要接收的数据包的长度，然后再调用ReadString接收数据。含雹我不确定ReadString的用法族告，如果不行的话，兆老明改为ReadStream方法，但服务端也要改为发送

1.IdTcpServer中有Connected和DisConnected事件,易于进行悄庆销管理,而且当Client非正常关闭也可以用.

2.阻塞方式的通信方式虽然"笨"点,但当一个"笨"办法有效,那它就不是一个笨办法.

3.由于是Tcp方式的连接,可靠性高了很多,而且使得内网连接也可靠了许多.

一.关于组件的一般无错处理和应用

虽然IdTcpClient没有Execute事件,但可以用线程的办法解决,这个网上很多

TClientHandleThread = class(TThread)

private

servercmd:integer

procedure HandleInput

protected

procedure Executeoverride

end

再在主窗口定义一全局变量

ClientHandleThread: TClientHandleThread

两个过程:

procedure TClientHandleThread.Execute

begin

while not Terminated do

begin

if not fmclient.cTcpC.Connected then

Terminate

else

try

servercmd:=fmclient.cTcpC.Socket.ReadInteger

Synchronize(HandleInput)

except

end

end

end

procedure TClientHandleThread.HandleInput

begin

case servercmd of

....

else

end

end

在Client连接时创建线程

if ClientHandleThread<>nil then ClientHandleThread.Terminate

try

ctcpc.Connect

if ctcpc.Connected then begin

ClientHandleThread := TClientHandleThread.Create(True)

ClientHandleThread.FreeOnTerminate:=True

ClientHandleThread.Resume

end

except

ctcpc.Disconnect

end

在Client的DisConnected事件中释放线程

ClientHandleThread.Terminate

IdTcpServer在还有Client连接时要断开可不是件容易事,网上对它也作启游了些讨论,但没什么结果,在本人的使用过程中,可以用以下方法解决

1.当然是释放所有Connection

一般在Server中都会用一个ListView来登记登录进来的Client,我是这样来释放的

i:=clist.Items.Count-1

while i>=0 do begin

TIdContext(clist.Items[i].Data).Connection.Disconnect

dec(i)

end

try

ctcps.Contexts.UnlockList

ctcps.Active:=false

except

end

2.后续无错处理

这样还没有完,因为一定会在DisConnected事件中有若干代码,而关闭不成功的主要原因我猜测不是来自于IdTcpServer本身,而是这些后续代码引起的.所以这步很有必要.

例如：

在Form的Close事件中让IdTcpServer.Tag=-1

在DisConnected中

If IdTcpServer.Tag<0 then exit

1.Client对Server的数据传输

这个简单的很,基本上可以用一问一答的方式来作比方(阻塞差辩方式的优点啊).

Client用Socket来喊话,它的Write方法很有意思,可以Write多种类型的数据,当然,都是定长或可以判断出长度的类型,而服务器的Execute事件就能用AContext.Connection.IOHandler的各种Read方法来读出相应的内容.

由于是阻塞状态,所以所有的 *** 作都可以在一次Server的Execute事件中完成,哪怕是传输大文件.而在这个Execute的对话中,不会触发Client的监视线程!这个尤其重要.

2.Server对Client的数据传输

与其说是数据传输,事实上不如说是指令传输.这是在服务器主动的方式下进行的一次性指令传输.注意,与Client对Server交流不同,服务器的所有内容必须在这一次传输中进行完毕!也就是说,这次传输必须是：指令+数据大小+数据内容。

欢迎分享，转载请注明来源：内存溢出

原文地址: http://outofmemory.cn/tougao/12160568.html

赞 (0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
绿营兵 绿营兵 一级用户组
0 0
上一篇 2023-05-21
下一篇 2023-05-21

发表评论

登录后才能评论

评论列表（0条）

保存