笔者在工作中遇到了需要对目录进行拷贝、删除和搬移的需求,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$#@60; $#@62;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)]$#@60; $#@62;\
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)$#@60; =0 then exit; //拷贝... Result:=DoCo
ir(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$#@60; $#@62;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)]$#@60; $#@62;\
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)$#@60; =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;
没有相关教程
|