客服电话
APP下载
迪恩网络APP
随时随地掌握行业动态
官方微信
扫描二维码
关注迪恩网络微信公众号
|
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:=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: 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; 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; 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:String;DateTime: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: 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 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 全部评论
专题导读
上一篇：[DELPHI][转]Delphi中的容器类发布时间：2022-07-18下一篇：（转载）c++builder/delphi中透明panel及透明窗口的实现方法_delphi教程 ...发布时间：2022-07-18热门推荐
热门话题
 阅读排行榜
|
请发表评论