请指教，如何查找一个目录下面所有的文件夹（包括字子文件夹下的文件夹）并在其他位置创建这些文件夹！谢谢

Question

如题：    
    例如我在C:\Temp这个目录下有2个文件夹名字分别为File1  File2， File1目录下面还有其他文件夹....我想要的就是查找出所有文件夹并且在其他位置(比如D盘)重新创建出这些文件夹。
    有谁知道怎么用Delphi写的告诉我下，非常感谢！最好有源代码。

Answer 1

//将指定路径下的所有文件夹拷到另一个路径下
procedure TForm1.CopyDir(OldDir:string;NewDir:string);
var
  sour_path: string;
  FileRec: TSearchrec;
  tmpstr: string;
  Newtmpstr:string;
begin
  sour_path := trim(OldDir);
  Newtmpstr := Trim(NewDir);
  if Newtmpstr[Length(Newtmpstr)] <> '\' then
    Newtmpstr := Newtmpstr + '\';
  if sour_path[Length(sour_path)] <> '\' then
    sour_path := sour_path + '\';  if not DirectoryExists(sour_path) then
  begin
    ShowMessage('源文件夹不存在');
    exit;
  end;  if not DirectoryExists(Newtmpstr) then
    ForceDirectories(Newtmpstr);
  tmpstr := sour_path;
  if FindFirst(sour_path + '*.*', faAnyfile, FileRec) = 0 then
  repeat
    if ((FileRec.Attr and faDirectory) <> 0) then
    begin
      if ((FileRec.Name <> '.') and (FileRec.Name <> '..')) then
      begin
        Newtmpstr := Newtmpstr + FileRec.Name + '\';
        if not DirectoryExists(Newtmpstr) then
          ForceDirectories(Newtmpstr);
        CopyDir(sour_path + FileRec.Name + '\',Newtmpstr);
        tmpstr := '';
        Newtmpstr := '';
      end;
    end
    else if ((FileRec.Attr and faDirectory) = 0) then
    begin
      tmpstr := tmpstr +  FileRec.Name;
      if FileExists(Newtmpstr) then
        CopyFile(PChar(tmpstr),PChar(Newtmpstr),true)
      else
        CopyFile(PChar(tmpstr),PChar(Newtmpstr +  FileRec.Name),False);
    end;  until FindNext(FileRec) <> 0;  FindClose(FileRec);
end;

Answer 2

这样调用就可以完成你想要的功能:
    CopyDir('c:\Temp','d:\');

Answer 3

To:  xiaocai800322(走自己的路)
   我只是想在新目录创建文件夹不想复制文件夹里面的内容，Thank you!

Answer 4

把这段去掉就行了
else if ((FileRec.Attr and faDirectory) = 0) then
    begin
      tmpstr := tmpstr +  FileRec.Name;
      if FileExists(Newtmpstr) then
        CopyFile(PChar(tmpstr),PChar(Newtmpstr),true)
      else
        CopyFile(PChar(tmpstr),PChar(Newtmpstr +  FileRec.Name),False);
    end;

Answer 5

To：xiaocai800322(走自己的路)
执行到这句时出错：ForceDirectories(Newtmpstr);
提示：Unable to create directory
Newtmpstr路径不对。

Answer 6

procedure TForm1.CopyDir(OldDir:string;NewDir:string);
var
  sour_path: string;
  FileRec: TSearchrec;
  tmpstr: string;
  Newtmpstr:string;
begin
  sour_path := trim(OldDir);
  Newtmpstr := Trim(NewDir);
  if Newtmpstr[Length(Newtmpstr)] <> '\' then
    Newtmpstr := Newtmpstr + '\';
  if sour_path[Length(sour_path)] <> '\' then
    sour_path := sour_path + '\';  if not DirectoryExists(sour_path) then
  begin
    ShowMessage('源文件夹不存在');
    exit;
  end;  if not DirectoryExists(Newtmpstr) then
    ForceDirectories(Newtmpstr);
  tmpstr := sour_path;
  if FindFirst(sour_path + '*.*', faAnyfile, FileRec) = 0 then
  repeat
    if ((FileRec.Attr and faDirectory) <> 0) then
    begin
      if ((FileRec.Name <> '.') and (FileRec.Name <> '..')) then
      begin
        Newtmpstr := Newtmpstr + FileRec.Name + '\';
        if not DirectoryExists(Newtmpstr) then
          ForceDirectories(Newtmpstr);
        CopyDir(sour_path + FileRec.Name + '\',Newtmpstr);
        Newtmpstr := Copy(Newtmpstr,1,Length(Newtmpstr) - Length(FileRec.Name)-1);
 //       tmpstr := '';
//        Newtmpstr := '';
      end;
    end ;
 {   else if ((FileRec.Attr and faDirectory) = 0) then
    begin
      tmpstr := tmpstr +  FileRec.Name;
      if FileExists(Newtmpstr) then
        CopyFile(PChar(tmpstr),PChar(Newtmpstr),true)
      else
        CopyFile(PChar(tmpstr),PChar(Newtmpstr +  FileRec.Name),False);
    end;}  until FindNext(FileRec) <> 0;  FindClose(FileRec);
end;//现在好了
//老大,如果再有问题,你自己单步调试一下

Answer 7

To: xiaocai800322(走自己的路)
  非常感谢您的帮助，谢谢！我现在也正努力学习呵呵。