📄 375.htm
字号:
<!-- saved from url=(0022)http://internet.e-mail -->
<html>
<head>
<title>递归调用删除整个目录树 </title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="inc.css">
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#000000" vlink="195434" alink="195434">
<table width="621" border="0" cellspacing="0" cellpadding="0" align="center">
<tr>
<td width="621"><a href="http://www.CoDelphi.com"><img src="images/logo.gif" border="0" width="153" height="60"><img src="images/bigbanner.gif" border="0" width="468" height="60"></a></td>
</tr>
</table><br>
<br>
<table width="621" border="0" cellspacing="0" cellpadding="0" align="center">
<tr>
<td align="left" valign="top" class="font9" height="155">
<div align="center" class="btitle">递归调用删除整个目录树 <br>
<br>
</div>
<div align="center"><strong>Den Bedard </strong></div>
<b><br>
摘 要</b>：一个包含删除目录树过程的pascal单元 <br>
<b> 关键字</b>：删除目录树 删除 <br>
<b> 类 别</b>：文件操作
<hr size="1" width="100%">
<span class="content"><br>{使用这个单元递归调用删除整个目录树} <br><br><br>unit DeleTree; <br><br>interface <br>uses Classes, FileCtrl, SysUtils; <br><br>procedure RemoveTree(path: string); <br>procedure RemoveDirectory(path: string); <br>procedure GetFileList(FileSpec: string;<br> NamesOnly: Boolean;<br> var FileList: TStringList); <br>procedure GetSubDirList(DirRoot: string;<br> NamesOnly: Boolean;<br> var SubDirList: TStringList); <br>function BackSlash(FileSpec: string): string; <br>function NoBackSlash(FileSpec: string): string; <br><br>implementation <br><br>{--------------------------------------------------------} <br>{这个过程删除整个目录树} <br>procedure RemoveTree(path: string); <br>var<br> SubDirList: TStringList;<br> FileList: TStringList;<br> i: integer; <br>begin<br> SubDirList := TStringList.Create;<br> GetSubDirList(path,False,SubDirList);<br> {如果这个树含有子目录，递归调用删除每一个子目录树}<br> if SubDirList.Count>0 then<br> begin<br> for i := 0 to SubDirList.Count-1 do<br> begin<br> RemoveTree(SubDirList[i]);<br> end;<br> end;<br> SubDirList.free;<br> {到这一步所有的子目录树都已被删除，或者根本不存在。因而你们仅需要删除所有的文件}<br> FileList := TStringList.Create;<br> GetFileList(BackSlash(path)+'*.*',False,FileList);<br> for i := 0 to FileList.Count-1 do<br> begin<br> DeleteFile(PChar(FileList[i]));<br> end;<br> FileList.Free;<br> RemoveDirectory(path); <br>end; <br><br><br>{--------------------------------------------------------} <br>{这个过程将删除目录(如果它存在)} <br>procedure RemoveDirectory(path: string); <br>var<br> Dir: string; <br>begin<br> {删除反斜线(如果它存在)}<br> Dir := NoBackSlash(path);<br> if DirectoryExists(Dir) then RmDir(Dir); <br>end; <br><br>{--------------------------------------------------------} <br>{这个过程把所有匹配文件规格的文件名加入一个StringList。如果NamesOnly是true，那么不包含文件路径} <br>procedure GetFileList(FileSpec: string;<br> NamesOnly: Boolean;<br> var FileList: TStringList); <br>var<br> SR: TSearchRec;<br> DosError: integer; <br>begin<br> FileList.Clear;<br> DosError := FindFirst(FileSpec, faAnyFile-faDirectory, SR);<br> while DosError=0 do<br> begin<br> if NamesOnly<br> then FileList.Add(SR.Name)<br> else FileList.Add(ExtractFilePath(FileSpec)+SR.Name);<br> DosError := FindNext(SR);<br> end; <br>end; <br><br>{--------------------------------------------------------} <br>{这个过程将指定的目录的全部下级目录名加入StringList。如果NamesOnly是true，那么仅仅包括最下级目录名} <br>procedure GetSubDirList(DirRoot: string;<br> NamesOnly: Boolean;<br> var SubDirList: TStringList); <br>var<br> SR: TSearchRec;<br> DosError: integer;<br> Root: string; <br>begin<br> SubDirList.Clear;<br> {在最后加入一个反斜杠(如果不存在)}<br> Root := BackSlash(DirRoot);<br> {使用FindFirst/FindNext返回下级目录}<br> DosError := FindFirst(Root+'*.*', faDirectory, SR);<br> while DosError=0 do<br> begin<br> {don't include the directories . and ..}<br> if pos('.',SR.Name)<>1 then<br> begin<br> if SR.Attr=faDirectory then<br> begin<br> if NamesOnly<br> then SubDirList.Add(SR.Name)<br> else SubDirList.Add(Root+SR.Name);<br> end;<br> end;<br> DosError := FindNext(SR);<br> end; <br>end; <br><br>{--------------------------------------------------------} <br>{添加一个反斜杠(如果它不存在)} <br>function BackSlash(FileSpec: string): string; <br>begin<br> if (FileSpec[length(FileSpec)]<>'\')<br> then Result := FileSpec+'\'<br> else Result := FileSpec; <br>end; <br><br>{删除一个反斜杠(如果它存在)} <br>function NoBackSlash(FileSpec: string): string; <br>begin<br> if (FileSpec[length(FileSpec)]='\')<br> then Result := Copy(FileSpec,1,length(FileSpec)-1)<br> else Result := FileSpec; <br>end; <br><br>end.</span>
<table border="0" cellspacing="0" cellpadding="1" class="font9" align="center" width="100%">
<tr align="left" valign="middle" bgcolor="195434">
<td height="1"></td>
</tr>
</table>
</td>
</tr>
<tr>
<td bgcolor="#C9C9C6" height="2"></td>
</tr>
</table>
<div align="center"><br>
中文开发在线<a href="http://www.codelphi.com" target="_blank">www.codelphi.com</a>授权使用。
</div>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -