怎么样复制目录下的所有文件包括子目录下的所有文件到另一个指定的文件夹里。  
请大家多多指教。谢谢!

解决方案 »

  1.   

    ---- 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;---- 2、删除目录 ---- 删除目录与拷贝目录很类似,但为了能删除位于根目录下的一个空目录,需要在辅助函数中设置一个标志变量,即:如果删除的是空目录,则置bEmptyDir为True,这一句已经用深色框表示了。 ---- 2.1删除目录的递归辅助函数:DoRemoveDir function DoRemoveDir(sDirName:String):Boolean;
    var
       hFindFile:Cardinal;
       tfile:String;
       sCurDir:String;
       bEmptyDir:Boolean;
       FindFileData:WIN32_FIND_DATA;
    begin
       //如果删除的是空目录,则置bEmptyDir为True
       //初始时,bEmptyDir为True
       bEmptyDir:=True;
       //先保存当前目录
       sCurDir:=GetCurrentDir;
       SetLength(sCurDir,Length(sCurDir));
       ChDir(sDirName);
       hFindFile:=FindFirstFile('*.*',FindFileData);
       if hFindFile< >INVALID_HANDLE_VALUE then
       begin
            repeat
                  tfile:=FindFileData.cFileName;
                  if (tfile='.') or (tfile='..') then
                  begin
                     bEmptyDir:=bEmptyDir and True;
                     Continue;
                  end;
                  //不是空目录,置bEmptyDir为False
                  bEmptyDir:=False;
                  if FindFileData.dwFileAttributes=
                  FILE_ATTRIBUTE_DIRECTORY then
                  begin
                       if sDirName[Length(sDirName)]< >'\' then
                          DoRemoveDir(sDirName+'\'+tfile)
                       else
                          DoRemoveDir(sDirName+tfile);
                       if not RemoveDirectory(PChar(tfile)) then
                          result:=false
                       else
                          result:=true;
                  end
                  else
                  begin
                       if not DeleteFile(PChar(tfile)) then
                          result:=false
                       else
                          result:=true;
                  end;
            until FindNextFile(hFindFile,FindFileData)=false;
            FindClose(hFindFile);
       end
       else
       begin
            ChDir(sCurDir);
            result:=false;
            exit;
       end;
       //如果是空目录,则删除该空目录
       if bEmptyDir then
       begin
            //返回上一级目录
            ChDir('..');
            //删除空目录
            RemoveDirectory(PChar(sDirName));
       end;   //回到原来的目录下
       ChDir(sCurDir);
       result:=true;
    end;---- 2.2删除目录的函数:DeleteDir function DeleteDir(sDirName:String):Boolean;
    begin
          if Length(sDirName)< =0 then
             exit;
          //删除...
          Result:=DoRemoveDir(sDirName) and RemoveDir(sDirName);
    end;---- 3、移动目录 ---- 有了拷贝目录和删除目录的函数,移动目录就变得很简单,只需顺序调用前两个函数即可: function MoveDir(sDirName:String;
    sToDirName:string):Boolean;
    begin
         if CopyDir(sDirName,sToDirName) then
            if RemoveDir(sDirName) then
               result:=True
            else
               result:=false;
    end;///////////////////////////////////////////////
    procedure TForm1.Button2Click(Sender: TObject);
    var
      OpStruc: TSHFileOpStruct;
      frombuf, tobuf: Array [0..128] of Char;
    Begin
      FillChar( frombuf, Sizeof(frombuf), 0 );
      FillChar( tobuf, Sizeof(tobuf), 0 );
      StrPCopy( frombuf, 'd:\brief\*.*' );
      StrPCopy( tobuf, 'd:\temp\brief' );
      With OpStruc DO Begin
        Wnd:= Handle;
        wFunc:= FO_COPY;
        pFrom:= @frombuf;
        pTo:=@tobuf;
        fFlags:= FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
        fAnyOperationsAborted:= False;
        hNameMappings:= Nil;
        lpszProgressTitle:= Nil;  end;
      ShFileOperation( OpStruc );
    end;
      

  2.   

    uses shellpai;var
      Source,Dest:String;
      FData : TShFileOpStruct;
    begin
      Source:='c:\sss';//sss为目录
      dest:='\\computername\kkk';
      //首先建立文件目录
      if not DirectoryExists(Dest) then
         begin
         if not CreateDir(Dest) then
            begin
            MessageDlg('建立目录出现错误!',mtWarning,[mbOK],0);
            Exit;
            end;
          Fdata.pFrom :=PChar(Source);
          Fdata.pTo := PChar(Dest);
          Fdata.wFunc := FO_COPY ;
          Fdata.Wnd := Application.Handle ;
          Fdata.lpszProgressTitle := 'Wait';
          Fdata.fFlags :=FOF_SIMPLEPROGRESS;
          ShFileOperation(FData);
          end;
    end;end;
      

  3.   

    复制目录:
    ///复制Source整个目录到DEST目录,如果Dest不存在,自动建立,如果DEST存在,那么Source将作为Dest的子目录!
    //例如如果要复制E:\Temp整个目录到E:\那么代码为: copydirectory('e:\temp','e:\');
    ///如果要复制E:\Temp到E:\Test目录下面,那么代码为:CopyDirecotry('E:\Temp','E:\TEST');
    function CopyDirectory(const Source, Dest: string): boolean;
    var
      fo: TSHFILEOPSTRUCT;
    begin
      FillChar(fo, SizeOf(fo), 0);
      with fo do
      begin
        Wnd := 0;
        wFunc := FO_COPY;
        pFrom := PChar(source+#0);
        pTo := PChar(Dest+#0);
        fFlags := FOF_NOCONFIRMATION+FOF_NOCONFIRMMKDIR    ;
      end;
      Result := (SHFileOperation(fo) = 0);
    end;重新命名:
    用MoveFile()或者下面的函数也可以。
    RenameFile('c:\a','c:\b')好想也可以?Win2K。
    //RenDirectory('d:\wt2','d:\bcde');
    function RenDirectory(const OldName,NewName:string): boolean;
    var
      fo: TSHFILEOPSTRUCT;
    begin
      FillChar(fo, SizeOf(fo), 0);
      with fo do
      begin
        Wnd := 0;
        wFunc := FO_RENAME;
        pFrom := PChar(OldName+#0);
        pTo := pchar(NewName+#0);
        fFlags := FOF_NOCONFIRMATION+FOF_SILENT;
      end;
      Result := (SHFileOperation(fo) = 0);
    end;
    //Copy 多个文件的处理:
    function CopyFiles(const Source,Dest: string): boolean;
    var
      fo: TSHFILEOPSTRUCT;
    begin
      FillChar(fo, SizeOf(fo), 0);
      with fo do
      begin
        Wnd := 0;
        wFunc := FO_COPY;
        pFrom := @source[1];
        pTo :=pchar(dest);
        fFlags := FOF_NOCONFIRMATION+FOF_NOCONFIRMMKDIR    ;
      end;
      Result := (SHFileOperation(fo) = 0);
    end;procedure TForm1.Button1Click(Sender: TObject);
    var
      str:string;
      i:integer;
    begin
      if opendialog1.Execute then
      begin
        for i:=0 to OpenDialog1.Files.Count-1 do
         str:=str+OpenDialog1.Files.strings[i]+#0;
        showmessage(str);
        str:=str+#0;
        CopyFiles(str,'d:\temp');
      end;
    end;