[原创]分享一个基于TIdFTP的上传下载单元
- Delphi(Pascal) code
unit UnitIdFtpUtil;interfaceuses 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;implementationfunction 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.
还有不少地方可以再优化，欢迎拍砖，谢谢！
[解决办法]
谢谢分享，
学习学习
帮你顶顶先
[解决办法]
俺也来吼吼~···学习学习~··
[解决办法]
正在学习，多谢多谢
[解决办法]
谢谢分享。