用delphi的IDFTP控件设计一个FTP客户端,怎么实现想cuteftp那种专业工具那样的把整个文件目录一起上传呢?请哪位大虾指点,小弟先谢了!
有一段示范代码最好,谢谢!

解决方案 »

  1.   

    呵呵,我就是用D7+Indy 9.0.11写的
    http://lyhome.3322.net
    你下载一个试用,绝对专业!!
    整个文件目录一起上传是通过递归遍历目录实现的,其实本质也就是一个个传
      

  2.   

    to ly_liuyang:怎么解决上传abort的问题?
    在上传中abort回产生,connection close gracefully!这算什么意思?
      

  3.   

    我用的笨办法,
    先list.判断有没有目录,是目录进里面一层,是文件上传,是目录再进去。等于手工的文件一个个拖着下传,不过是用机器做罢了。
    :)
    例子:好象能在本地建一个相同的目录结构。试过好象能用,嘿嘿。
    procedure TfrmMain.StepDownFile;
    var
       i:integer;
       intDownCount :integer;
       sFileName    :string;
       sUpdDirect   :string;    //Update路径
       sBakDirect   :string;    //Bak路径
       sWorkDirect  :string;    //Work目录
       sTmpDirect   :string;
       iDirectory   :integer;   //路径深度
       fTermJobFile :TIniFile;
    begin
        memUpdlog.lines.Add('    开始下载');    fTermJobFile := TIniFile.Create('.\'+gTermNo+'.ini');
        intDownCount:=0;
        for i:= 0 to clbfilelist.Items.Count-1 do begin
            sFileName:= clbFileList.Items.Strings[i];
            lbFilename.Caption :=sFileName;
            if clbfilelist.Checked [i]=true then begin
                memUpdlog.lines.Add('        '+sFileName+'已经下载');
                writelog('        '+sFileName+'已经下载',False);
                intDownCount:=intDownCount+1;
                lbUpdDownCount.Caption:=inttostr(intDownCount);
                continue;
            end;
            //先判断是不是目录
            sUpdDirect:=gDownPath;
            sBakDirect:=gBakPath+gCurrJobID+'\';             //先根据JOBID建备份目录
            sWorkDirect:=gWorkPath;
            if not DirectoryExists(sBakDirect) then CreateDir(sBakDirect);        iDirectory:=0;
            while Pos('\', sFileName) > 0 do begin
                sTmpDirect:=copy(sFileName,1,Pos('\', sFileName)-1);
                sUpdDirect:=sUpdDirect+sTmpDirect+'\';
                sBakDirect:=sBakDirect+sTmpDirect+'\';
                sWorkDirect:=sWorkDirect+sTmpDirect+'\';            if not DirectoryExists(sUpdDirect) then CreateDir(sUpdDirect);   //建更新程序子目录
                if not DirectoryExists(sBakDirect) then CreateDir(sBakDirect);   //建备份程序子目录
                if not DirectoryExists(sWorkDirect) then CreateDir(sWorkDirect);
                idFtp.ChangeDir(sTmpDirect);
                delete(sFileName,1,Pos('\', sFileName));   //载断只到只有文件名
                iDirectory:=iDirectory+1;
            end;
            BytesToTransfer := IdFTP.Size(sFileName);
            sleep(500);
            IdFTP.Get(sFileName,sUpdDirect+sFileName, true);
            while iDirectory>0 do begin
                iDirectory:=iDirectory-1;
                idFtp.ChangeDir('..');
            end;        intDownCount:=intDownCount+1;
            lbUpdDownCount.Caption:=inttostr(intDownCount);
            memUpdlog.lines.Add('        '+sFileName+'下载完毕');
            writelog('        '+sFileName+'下载完毕',False);
            fTermJobFile.WriteString('Files',clbfilelist.Items.strings[i],'1');        clbFileList.Checked[i]:=true;
        end;
        sbstat.Panels[1].Text:='下载升级文件完毕';
        memUpdlog.lines.Add('    下载升级文件完毕');
        writelog('    下载升级文件完毕',False);
        fTermJobFile.WriteString('System','FileDown','1');
        fTermJobFile.WriteString('System','FileDownTime',formatdatetime('YYYYMMDD HHMMSS',now));
        fTermJobFile.free;
    end;
      

  4.   

    在上传中abort回产生,connection close gracefully这不是错误!
    是InDy的消息返回,我使用Indy9。0。11的,比Delphi的新!
    注意Indy有Bug的,不一定能完美解决Abort问题,递归查找后上传我的主页关闭了,Sorry,谁有好的空间通知我呀,我很需要哦,不过要Free的。给出部分修正procedure TIdFTP.InternalPut(const ACommand: string; ASource: TStream);的结尾片段
      finally
      if HTTPErr // add to fix HTTP connection bug --- by Liu Yang 2003.1.28
           then Self.DoStatus(ftpAborted, [RSFTPStatusTransferFailed]) else
      if LResponse<>0 then
        begin  // 1 means  get server response --- by Liu Yang 2003.1.25
          // 226 = download successful, 225 = Abort successful}
          LResponse := GetResponse([150, 225, 226, 250, 426, 450]);
          // bug fixed : ArGoFTP server will reply 150 on 10038 error --- by Liu Yang 2003.1.23
          if (LResponse = 426) or (LResponse = 450) or (LResponse=150) or (FAbortFlag) then
             begin
               // some servers respond with 226 on ABOR
               GetResponse([226, 225, 426]);
               DoStatus(ftpAborted, [RSFTPStatusAbortTransfer]);
             end else DoStatus(ftpReady, [RSFTPStatusDoneTransfer]);  // fixed by Liu Yang 2003.1.25
        end else DoStatus(ftpReady, [RSFTPStatusTransferFailed]);  // fixed by Liu Yang 2003.1.25
        // bug fixed : clear all input buffer data --- by Liu Yang 2003.1.22
        ReadFromStack(true, 10, false);
        InputBuffer.Clear;
      end;
      // fixed end
      

  5.   

    请你到Indy下载FAQ,有说明的
    http://www.nevrona.com/Indy/FAQ.html