在Delphi中实现对目录拷贝、删除和搬移的操作

笔者在工作中遇到了需要对目录进行拷贝、删除和搬移的需求，Delphi本身提供了一些目录操作函数，但只是针对空目录而言，对目录下带有子目录的情况，更是无能为力。利用Win32 API函数和结构，以及递归的程序设计思想，笔者实现了对任意目录进行拷贝、删除和搬移的功能(分别相当于DOS中的XCopy、DelTree和Move命令)。以下分别给出了实现代码：
源代码网推荐
源代码网推荐 ---- 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

软件开发网 www.mscto.com

源代码网推荐 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;