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
//找到相應的目錄,則更換路徑.
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.