Delphi 拷贝目录

来源:互联网 发布:网吧商品销售软件 编辑:程序博客网 时间:2024/04/29 14:54
 

Delphi 拷贝目录  

----   1、拷贝目录  

----   为了能拷贝目录下带有子目录的情况,先定义一个辅助的拷贝函数,它是递归执行的,直到把目录下的所有文件和子目录都拷贝完。  

----   1.1拷贝目录的递归辅助函数:DoCopyDir  

function   DoCopyDir(sDirName:String;
sToDirName:String):Boolean;
var
      hFindFile:Cardinal;
      t,tfile:String;
      sCurDir:String[255];
      FindFileData:WIN32_FIND_DATA;
begin
      //先保存当前目录
      sCurDir:=GetCurrentDir;
      ChDir(sDirName);
      hFindFile:=FindFirstFile( '*.* ',FindFileData);
      if   hFindFile <   > INVALID_HANDLE_VALUE   then
      begin
                if   not   DirectoryExists(sToDirName)   then
                      ForceDirectories(sToDirName);
                repeat
                            tfile:=FindFileData.cFileName;
                            if   (tfile= '. ')   or   (tfile= '.. ')   then
                                  Continue;
                            if   FindFileData.dwFileAttributes=
                            FILE_ATTRIBUTE_DIRECTORY   then
                            begin
                                      t:=sToDirName+ '\ '+tfile;
                                      if     not   DirectoryExists(t)   then
                                              ForceDirectories(t);
                                      if   sDirName[Length(sDirName)] <   > '\ '   then
                                            DoCopyDir(sDirName+ '\ '+tfile,t)
                                      else
                                            DoCopyDir(sDirName+tfile,sToDirName+tfile);
                            end
                            else
                            begin
                                      t:=sToDirName+ '\ '+tFile;
                                      CopyFile(PChar(tfile),PChar(t),True);
                            end;
                until   FindNextFile(hFindFile,FindFileData)=false;
                FindClose(hFindFile);
      end
      else
      begin
                ChDir(sCurDir);
                result:=false;
                exit;
      end;
      //回到原来的目录下
      ChDir(sCurDir);
      result:=true;
end;

----   1.2拷贝目录的函数:CopyDir  

function   CopyDir(sDirName:String;
sToDirName:string):Boolean;
begin
            if   Length(sDirName) <   =0   then
                  exit;
            //拷贝...
            Result:=DoCopyDir(sDirName,sToDirName);
end;

原创粉丝点击