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

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


------解决方案--------------------
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;

//现在好了
//老大,如果再有问题,你自己单步调试一下