老问题：如何复制文件夹（包括内部的文件夹）？（50分）--好多问题问的没有人回答，所以累计给回答对者

Question

问题相信很老，一经解决50分！
就是复制一个文件夹，文件夹中可能还有文件夹（不限层数）；要全部复制到一个指定的文件夹中！
等待回答正确者！！

Answer 1

Winexec(PChar('cmd /c xcopy c:\1 d:\1 /s/y/k/i'),SW_HIDE);
这样可不可以？？

Answer 2

procedure TForm1.copyPathFile( strSourFilePath:string;  DeFieldpath:string);//将一个文件夹内文件复制到另外一个文件夹内
var
 OpStruc:TSHFileOpStruct;
  FromBuf,ToBuf:Array[0..128] of Char;
begin
  try
    FillChar(FromBuf,Sizeof(FromBuf),0);
    FillChar(ToBuf,Sizeof(ToBuf),0);
    StrPCopy(FromBuf,Pchar(strSourFilePath));
//strSourFilePath
    StrPCopy(ToBuf,Pchar(DeFieldpath));
       with OpStruc do
    begin
      Wnd:=handle;
      wFunc:=FO_COPY;
      pFrom:=@FromBuf;
      pTo:=@ToBuf;
      fFlags:=FOF_NOCONFIRMATION or FOF_MULTIDESTFILES or FOF_SIMPLEPROGRESS;// or FOF_RENAMEONCOLLISION;
      fAnyOperationsAborted:=False;
      hNameMappings:=nil;
      lpszProgressTitle:=nil;
    end;
    if SHFileOperation(OpStruc)=0 then
    begin
    end;
  except
    raise Exception.Create('错误');
  end;
end;

Answer 3

遍历文件夹，然后复制文件，如果目标文件夹不存在，则创建之。AOptions是自定义的一个枚举类型，不用管它。procedure TMainForm.BackupFile(ASource, ADest: String;
  AOptions: TBackupOptions);
var
  sr, dr: TSearchRec;
  iReturn: integer;
  OverWriteFile: Boolean;
begin
// Search all files and directorys.
  if Copy(ASource, Length(ASource), 1) <> '\' then
    ASource := ASource + '\';
  if Copy(ADest, Length(ADEst), 1) <> '\' then
    ADest := ADest + '\';
// remove target file not exists in source.
  if boRemoveTargetFile in AOptions then RemoveTargetFile(ASource, ADest);
  iReturn := FindFirst(ASource + '*.*', faAnyFile, sr);
  while iReturn = 0 do
  begin
    if (sr.Name <> '.')and (sr.Name <> '..')then
    begin
// if destine not exits this directory, create it.
      if sr.Attr and faDirectory <> 0 then
      begin
        if not DirectoryExists(ADest + sr.Name) then
          MkDir(ADest + sr.Name);
        BackupFile(ASource + sr.Name, ADest + sr.Name, AOptions)
      end
      else
// Create source file in destine directory.
        OverWriteFile := True;
        if boSmartOverwrite in AOptions then
        begin
          iReturn := FindFirst(ADest + sr.Name, faAnyFile, dr);
          if iReturn = 0 then OverWriteFile := sr.Time > dr.Time;
          FindClose(dr);
        end;
        if OverWriteFile then
        begin
//          DeleteFile(ADest + sr.Name );
          CopyFile(PAnsiChar(ASource + sr.Name), PAnsiChar(ADest + sr.Name),
              False);
        end;
    end;
    iReturn := FindNext(sr);
  end;
  FindClose(sr);
end;代码可能比较片面，自己修改修改吧。

Answer 4

补充的一个过程。procedure TMainForm.RemoveTargetFile(ASource, ADest: String);
var
  sr, dr: TSearchRec;
  iRet: Integer;
begin
  iRet := FindFirst(ADest + '*.*', faAnyFile, dr);
  While iRet = 0 do
  begin
    if (dr.Name <> '.') and (dr.Name <> '..')
        and (dr.Attr and faDirectory = 0) then
    begin
      iRet := FindFirst(ASource + dr.Name, faAnyFile - faDirectory, sr);
      if iRet <> 0 then DeleteFile(ADest + dr.Name);
      FindClose(sr);
    end;
    iRet := FindNext(dr);
  end;
  FindClose(dr);
end;

Answer 5

给个简便的函数uses ShellApi;procedure CopyFileDirectory(FromDir,ToDir: string);
//FromDir:要复制的文件夹
//ToDir: 目标文件夹
var
  SHFileOpStruct:TSHFileOpStruct;
begin
  with SHFileOpStruct do
    begin
      Wnd:=0;
      wFunc:=FO_COPY;
      pFrom:=PChar(FromDir+chr(0));
      pTo:=PChar(ToDir+chr(0));
      fFlags:=FOF_NOCONFIRMATION or FOF_NOERRORUI;
    end;
  SHFileOperation(SHFileOpStruct);
end;

Answer 6

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;}
{
   在这个地方，发现是内部文件中有文件夹的话就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;
        windows.FindClose(hFindFile);
   end
   else
   begin
        ChDir(sCurDir);
        result:=false;
        exit;
   end;
   ChDir(sCurDir);
   result:=true;
end;

Answer 7

我这里的代码就是判断搜索出来的结果 sr 是不是一个文件夹。
你的代码中是 FileFindData。      if sr.Attr and faDirectory <> 0 then
      begin
        if not DirectoryExists(ADest + sr.Name) then
          MkDir(ADest + sr.Name);
        BackupFile(ASource + sr.Name, ADest + sr.Name, AOptions)
      end