捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  沪ICP备05001939号 DELPHI盒子 | 盒子论坛 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 论坛检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
盒子资源分类
全部展开 - 全部合拢
可以下载整个目录的简单实现
关键字:IdFTP 下载 整个目录 File Directory
来 自:原创
平 台:Win9x,Win2k/XP/NT,Win2003 下载所需:0 火柴
深浅度:初级 完成时间:2005/3/8
发布者:xyedyguoguo 发布时间:2005/3/8
编辑器:DELPHI6 语  种:简体中文
分 类:网络 下载浏览:1/17385
加入到我的收藏
下载错误报错
登陆以后才能下载
 用户名:
 密 码:
自动登陆(30天有效)
无图片
这个代码绝对原创,网上找的代码不是文件下不全,就是用不了。
代码可能还是有问题。请大家指正。谢谢。

function IsFileInUse(fName : string ):boolean; //检测文件是否正在使用
var 
  HFileRes : HFILE; 
begin 
  Result := false; 
  if not FileExists(fName) then 
    exit; 
  HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE,0, nil, OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE); 
  if not Result then 
    CloseHandle(HFileRes); 
end;

procedure TDownForm.DownLoadDir(LocalPath,ServerPath:string);
var
   i,count1:integer;
   att:TIdDirItemType;
   FileList  : TStrings;
   Name{, Line}: String;
   ss:string;
begin
   try begin
       FileList := TStringList.Create;
       ChageDir(serverpath);
       Application.ProcessMessages;
       if AnsiLastChar(serverpath) <> '/' then
         serverpath := serverpath + '/';
       if AnsiLastChar(localpath) <> '\' then
         localpath := localpath + '\';
       if not DirectoryExists(localpath+serverpath) then ForceDirectories(localpath+serverpath);
       IdFTP1.List(FileList);
       Application.ProcessMessages;
       count1:=IdFTP1.DirectoryListing.Count;
       for i:=0 to count1-1  do begin
          ss:=IdFTP1.DirectoryListing.Items[i].FileName;
          att:=IdFTP1.DirectoryListing.Items[i].ItemType;
        if (att<>ditDirectory) then begin
          if not DirectoryExists(localpath+serverpath) then ForceDirectories(localpath+serverpath);
          BytesToTransfer := IdFTP1.Size(ss);
          if IsFileInUse(ss)=False then
          IdFTP1.Get(ss,localpath+serverpath+ss,true)
          else Exit;
          Application.ProcessMessages;
          lbl1.Caption:='已下载:'+ss;
          lbl1.Update;
         end
       end;
       for i:=0 to count1-1 do begin
          ss:=IdFTP1.DirectoryListing.Items[i].FileName;
          att:=IdFTP1.DirectoryListing.Items[i].ItemType;
          BytesToTransfer := IdFTP1.Size(ss);
          if (att=ditDirectory) and (ss <> '.') AND (ss <> '..') then begin
          Name := ss;
          if not DirectoryExists(localpath+serverpath+Name) then ForceDirectories(localpath+serverpath+Name);
          DownLoadDir(localpath+serverpath,Name);
          Application.ProcessMessages
          end;
       end;
        ChageDir('..');//这句是返回前一个目录,写的另一个函数,可以用IdFTP1.ChangeDir替换
        Filelist.Free;  
   end
   except
   end;
end;
Google
 
本站原创作品,未经作者许可,严禁任何方式转载;转载作品,如果侵犯了您的权益,请联系我们
龙脉加密锁 15元起 Grid++Report 报表 申请支付@网
 相关文章
没有相关文章
相关评论
共有评论7条 当前显示最后6条评论
yujiu 2005/3/15 17:47:44
procedure Tf_yrdwfileinfo.FTP_DownloadDir(remote_dir,local_dir:string);         //下载整个目录,并遍历所有子目录  使用clftp
var
i,j,count1:integer;
att,ss:string;
current_dir,remote_dir2,currfile:string;
temp_dir,ftpdir:string;
F:textfile;
diratt:string;
filei:TFtpFileInfo;
lst : TStringList;
begin
      ftpdir:=FtpClient1.HostDirName;
      remote_dir2:=ftpdir+'/'+remote_dir;
      FtpClient1.HostDirName :=remote_dir2;
      //==========刷新目录
      ftprefurbish(False );
      //==========
      current_dir:=remote_dir2;    //主目录
      temp_dir :=remote_dir ;
      if not DirectoryExists(local_dir) then CreateDir(local_dir);
      if not directoryexists(local_dir+'\'+temp_dir) then createdir(local_dir+'\'+temp_dir);

         lst := TStringList.Create;
         lst.LoadFromFile(TEMP_FILE_NAME);
          for i :=2 to lst.Count - 1 do
          begin
          diratt:=lst[i];
          filei:=GetFileInfo(diratt);
          if (copy(filei.Attrib ,1,1)<>'d')  then
          begin
          //if not DirectoryExists(local_dir) then CreateDir(local_dir); //创退本地目录
          //==========下载文件
          ftpclient1.Pwd ;
          currfile:=ftpclient1.DirResult ;
          currfile:=currfile+'/'+filei.FileName ;
          ftpclient1.HostFileName :=currfile;
          Ftpclient1.Binary :=true;
          FtpClient1.TypeSet ;
          ftpclient1.LocalFileName :=local_dir+'\'+temp_dir+'\'+filei.FileName ;
          ftpclient1.Get ;
          Ftpclient1.Binary :=false;
          FtpClient1.TypeSet ;
          //==========
          end
          else
          begin
          if not (filei.Filename ='..') then
          begin
          FTP_DownloadDir(filei.FileName,local_dir+'\'+remote_dir);
          end;
          end;
      end;
lst.Free ;
end;
shling 2005/3/16 1:48:47
http://www.ddvip.net/program/delphi/index1/59.htm
vagrant2005 2005/3/21 7:57:07
http://www.ddvip.net/program/delphi/index1/59.htm
这个地方的代码更为详细
china_Peng 2005/4/22 11:55:29
樓主
A:\B\C
  \D    這樣的目錄不能下載
kindows 2005/7/14 15:37:55
 这个代码好像是有问题的,我在本机上试验时,总是出现List index out of bounds(9)的错误
liyong0775 2007/7/24 12:03:20
不能用
我要发表评论 查看全部评论
 
  DELPHI盒子版权所有 1999-2023 V4.01 粤ICP备10103342号-1 更新RSS列表