[原创]分享一个基于TIdFTP的上传下载单元

[XiaoLu1984]

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.

还有不少地方可以再优化，欢迎拍砖，谢谢！

[浩南_哥]

看看先

[山东蓝鸟贵薪]

谢谢分享，
学习学习
帮你顶顶先

[nnjnq530031]

俺也来吼吼~···学习学习~··

[iqyely]

谢谢分享。

[zx1292155122]

正在学习，多谢多谢

[XiaoLu1984]

// 统一文件拖拽处理
procedure DragProc(var Message: TMsg; var Handled: Boolean);
var
  FileNum : Word;
  p : array[0..1024] of char;
  TempFileName : string;
begin
  if (Message.message = WM_DropFiles) and (Message.hwnd = lvFile.Handle) then
  begin
    FileNum := DragQueryFile(Message.WParam, $FFFFFFFF, nil, 0);
    // 取得拖放文件总数
    for FileNum := 0 to FileNum - 1 do
    begin
      DragQueryFile(Message.WParam, FileNum , p , 255);
      // 取得拖放文件名
      //Self.MemoDrag.Lines.add(StrPas(p));
      //对文件的处理
      TempFileName := StrPas(P);
      WriteLog(TempFileName);
    end;
    DragFinish(Message.WParam);
    Handled := True;
  end
  else if (Message.message = WM_DropFiles) and (Message.hwnd = tvDirectory.Handle) then
  begin
    FileNum := DragQueryFile(Message.WParam, $FFFFFFFF, nil, 0);
    // 取得拖放文件总数
    for FileNum := 0 to FileNum - 1 do
    begin
      DragQueryFile(Message.WParam, FileNum , p , 255);
      // 取得拖放文件名
      //Self.MemoDrag.Lines.add(StrPas(p));
      //对文件的处理
      TempFileName := StrPas(P);
      WriteLog('directory:' + TempFileName);
    end;

    DragFinish(Message.WParam);
    Handled := True;
  end;
  
end;