unit UnitIdFtpUtil;
interface
uses
Classes, SysUtils, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdFTP, IdFTPList, IdFTPCommon;
// FTP根目录
const CONST_FTP_BOOT_PATH = '/';
// FTP路径的分割符
const CONST_FTP_PATH_SEPARATOR = '/';
// XP操作系统路径的分割符
const CONST_OS_PATH_SEPARATOR = '\';
// 输出当前系统时间，格式为 yyyy-MM-dd hh:mm:ss
function GetTime(d : TDateTime) : string;
//写日志文件
procedure WriteLog(aLogStr : String);
// 解析远程目录，用于判断并创建目录 'a\b\c' 解析出'a', 'b', 'c'
function ParseFullPathString(FullPathName : string) : TStringList;
// 强制往FTP指定目录上传文件，当远程文件夹不存在时将自动创建
function ForceUploadLocalFile(FtpClient : TIdFTP; FullPathName : string; FileName : string) : Boolean;
// 尝试下载远程指定目录下的文件，如成功则返回临时下载文件的完整路径
function TryDownloadRemoteFile(FtpClient : TIdFTP; FullPathName : string; FileName : string) : string;
implementation
function GetTime(d : TDateTime) : string;
begin
Result := FormatDateTime('yyyy-MM-dd HH:mm:ss', d);
end;
procedure WriteLog(aLogStr : String);
var
LogFile : TextFile;
LogFileName, TmpStr: string;
begin
TmpStr := ExtractFilePath(ParamStr(0)) + 'Temp';
if not DirectoryExists(TmpStr) then
begin
CreateDir(TmpStr);
end;
TmpStr := ExtractFilePath(ParamStr(0)) + 'Logs\';
if not DirectoryExists(TmpStr) then
begin
CreateDir(TmpStr);
end;
LogFileName := ExtractFilePath(ParamStr(0))
+ 'Logs\'
+ FormatDateTime('yyyy-mm-dd', Now) + '.txt';
aLogStr := GetTime(Now) + ' ' + aLogStr;
if FileExists(LogFileName) then
begin
AssignFile(LogFile, LogFileName);
Append(LogFile);
Writeln(LogFile, aLogStr);
CloseFile(LogFile);
end
else
begin
AssignFile(LogFile, LogFileName);
Rewrite(LogFile);
Writeln(LogFile, aLogStr);
CloseFile(LogFile);
end;
end;
// 解析远程目录，用于判断并创建目录 'a\b\c' 解析出'a', 'b', 'c'
function ParseFullPathString(FullPathName : string) : TStringList;
var
L : TStringList;
begin
L := TStringList.Create;
if Trim(FullPathName) <> '' then
begin
L.Text := StringReplace(FullPathName, CONST_FTP_PATH_SEPARATOR, #13, [rfReplaceAll]);
L.Text := Trim(L.Text);
end;
Result := L;
end;
// 强制往FTP指定目录上传文件，当远程文件夹不存在时将自动创建
function ForceUploadLocalFile(FtpClient : TIdFTP; FullPathName : string;
FileName : string) : Boolean;
var
L, TempList : TStringList;
I, J, PathLen : Integer;
TempStr, CurrentRemotePath : string;
IsPathExist : Boolean;
begin
if not FtpClient.Connected then
begin
WriteLog('强制上传文件' + FileName + '失败:FTP未连接!!');
Result := False;
Exit;
end
else
begin
try
L := ParseFullPathString(FullPathName);
TempList := TStringList.Create;
PathLen := L.Count - 1;
//先从根目录开始对比
FtpClient.ChangeDir(CONST_FTP_BOOT_PATH);
FtpClient.List(TempList);
TempList.Clear;
CurrentRemotePath := ''; //当前所处远程目录，动态变化
for I := 0 to PathLen do
begin
try
TempStr := L.Strings[I];
//WriteLog('开始尝试分析第' + IntToStr(I + 1) + '级目录:' + TempStr);
// 找到目录标志
IsPathExist := False;
with FtpClient.DirectoryListing do
begin
for J := 0 to Count - 1 do
begin
if Items[J].ItemType = ditDirectory then
begin
//WriteLog('开始对比文件夹 ' + Items[J].FileName + ' VS ' + TempStr);
if Items[J].FileName = TempStr then
begin
IsPathExist := True;
end;
end;
end;
end;
if not IsPathExist then
begin
FtpClient.MakeDir(TempStr);
WriteLog('未在FTP文件夹找到目录:' + TempStr + ' 自动创建成功!');
end;
CurrentRemotePath := CurrentRemotePath + CONST_FTP_PATH_SEPARATOR +
TempStr;
FtpClient.ChangeDir(CurrentRemotePath);
FtpClient.TransferType := ftASCII;
FtpClient.List(TempList);
TempList.Clear;
//WriteLog('成功切入:' + TempStr);
except
on Err : Exception do
begin
WriteLog('分析对比目录:' + TempStr + '发生异常:' + Err.Message);
Break;
Result := False;
end;
end;
end;
//WriteLog('最后成功切入目录:' + CurrentRemotePath);
FtpClient.TransferType := ftBinary;
FtpClient.Put(FileName, AnsiToUtf8(ExtractFileName(FileName)));
finally
L.Free;
TempList.Free;
end;
Result := True;
end;
end;
// 尝试下载远程指定目录下的文件，如成功则返回临时下载文件的完整路径
function TryDownloadRemoteFile(FtpClient : TIdFTP; FullPathName : string; FileName : string) : string;
var
L, TempList : TStringList;
I, J, PathLen : Integer;
TempStr, CurrentRemotePath : string;
IsPathExist : Boolean;
begin
if not FtpClient.Connected then
begin
WriteLog('下载文件' + FileName + '失败:FTP未连接!!');
Result := '';
Exit;
end
else
begin
try
L := ParseFullPathString(FullPathName);
TempList := TStringList.Create;
PathLen := L.Count - 1;
//先从根目录开始对比
FtpClient.ChangeDir(CONST_FTP_BOOT_PATH);
FtpClient.List(TempList);
TempList.Clear;
CurrentRemotePath := ''; //当前所处远程目录，动态变化
for I := 0 to PathLen do
begin
try
TempStr := L.Strings[I];
//WriteLog('开始尝试分析第' + IntToStr(I + 1) + '级目录:' + TempStr);
// 找到目录标志
IsPathExist := False;
with FtpClient.DirectoryListing do
begin
for J := 0 to Count - 1 do
begin
if Items[J].ItemType = ditDirectory then
begin
//WriteLog('开始对比文件夹 ' + Items[J].FileName + ' VS ' + TempStr);
if Items[J].FileName = TempStr then
begin
IsPathExist := True;
end;
end;
end;
end;
if not IsPathExist then
begin
FtpClient.MakeDir(TempStr);
WriteLog('未在FTP文件夹找到目录:' + TempStr + ' 自动创建成功!');
end;
CurrentRemotePath := CurrentRemotePath + CONST_FTP_PATH_SEPARATOR +
TempStr;
FtpClient.ChangeDir(CurrentRemotePath);
FtpClient.TransferType := ftASCII;
FtpClient.List(TempList);
TempList.Clear;
//WriteLog('成功切入:' + TempStr);
except
on Err : Exception do
begin
WriteLog('下载文件过程中在分析对比目录:' + TempStr + '时发生异常:' + Err.Message);
Break;
Result := '';
end;
end;
end;
WriteLog('最后成功切入目录:' + CurrentRemotePath);
try
FtpClient.TransferType := ftBinary;
TempStr := ExtractFilePath(ParamStr(0)) + 'Temp/' + FullPathName;
TempStr := StringReplace(TempStr, CONST_FTP_PATH_SEPARATOR, CONST_OS_PATH_SEPARATOR, [rfReplaceAll]);
WriteLog(TempStr);
ForceDirectories(TempStr);
TempStr := TempStr + CONST_OS_PATH_SEPARATOR + FileName;
FtpClient.Get(AnsiToUtf8(FileName), TempStr, True);
except
on Err : Exception do
begin
WriteLog('在远程目录:' + CurrentRemotePath + '下载文件:' + FileName + '时发生异常:' + Err.Message);
Result := '';
end;
end;
Result := TempStr;
finally
L.Free;
TempList.Free;
end;
end;
end;
end.
还有不少地方可以再优化，欢迎拍砖，谢谢！
