110502_05.htm

来自「对于学习很有帮助」· HTM 代码 · 共 224 行
HTM
224 行
<html>

<head>
<link REL="stylesheet" HREF="/style.css" TYPE="text/css">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>计算机世界日报:
在Delphi中实现对目录拷贝、删除和搬移的操作
</title>
<!--***********-->
</head>

<body bgcolor="#FFFFFF" >














<p><br>
<font color="#b904e8"><b><em><a href="class.htm">返回</a></em></b></font>
<center>
<font color="#0000c0"><h2>
在Delphi中实现对目录拷贝、删除和搬移的操作
</h2></font>
<h3>
深圳市特发泰科通信有限公司
<br>吴成宾
</h3>
</center>
<p><font color="#ffffff">----</font>

笔者在工作中遇到了需要对目录进行拷贝、删除和搬移的需求，Delphi本身提供了一些目录操作函数，但只是针对空目录而言，对目录下带有子目录的情况，更是无能为力。利用Win32 API函数和结构，以及递归的程序设计思想，笔者实现了对任意目录进行拷贝、删除和搬移的功能(分别相当于DOS中的XCopy、DelTree和Move命令)。以下分别给出了实现代码：
<p><font color="#ffffff">----</font>
<b>1、拷贝目录</b>
<p><font color="#ffffff">----</font>
为了能拷贝目录下带有子目录的情况，先定义一个辅助的拷贝函数，它是递归执行的，直到把目录下的所有文件和子目录都拷贝完。
<p><font color="#ffffff">----</font>
1.1拷贝目录的递归辅助函数：DoCopyDir
<pre>
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;
</pre>
<p><font color="#ffffff">----</font>
1.2拷贝目录的函数：CopyDir
<pre>
function CopyDir(sDirName:String;
sToDirName:string):Boolean;
begin
      if Length(sDirName)< =0 then
         exit;
      //拷贝...
      Result:=DoCopyDir(sDirName,sToDirName);
end;
</pre>
<p><font color="#ffffff">----</font>
<b>2、删除目录</b>
<p><font color="#ffffff">----</font>
删除目录与拷贝目录很类似，但为了能删除位于根目录下的一个空目录，需要在辅助函数中设置一个标志变量，即：如果删除的是空目录,则置bEmptyDir为True，这一句已经用深色框表示了。
<p><font color="#ffffff">----</font>
2.1删除目录的递归辅助函数：DoRemoveDir
<pre>
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;
</pre>
<p><font color="#ffffff">----</font>
2.2删除目录的函数：DeleteDir
<pre>
function DeleteDir(sDirName:String):Boolean;
begin
      if Length(sDirName)< =0 then
         exit;
      //删除...
      Result:=DoRemoveDir(sDirName) and RemoveDir(sDirName);
end;
</pre>
<p><font color="#ffffff">----</font>
3、移动目录
<p><font color="#ffffff">----</font>
有了拷贝目录和删除目录的函数，移动目录就变得很简单，只需顺序调用前两个函数即可：
<pre>
function MoveDir(sDirName:String;
sToDirName:string):Boolean;
begin
     if CopyDir(sDirName,sToDirName) then
        if RemoveDir(sDirName) then
           result:=True
        else
           result:=false;
end;
</pre>



 



<p align="right"><small><em>中国计算机世界出版服务公司版权所有</em></small> 
<br>
</p>
</body>
</html>
⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?
110502_05.htm

110502_05.htm - 源码说明

⌨️ 快捷键说明
