我试图以递归方式删除文件夹及其所有子文件夹,但它根本不起作用,所以有人可以查看代码并告诉我这里做错了什么吗?
我在Windows XP下通过D7运行此代码
if FindFirst (FolderPath + '\*', faAnyFile, f) = 0 then
try
repeat
if (f.Attr and faDirectory) <> 0 then
begin
if (f.Name <> '.') and (f.Name <> '..') then
begin
RemoveDir(FolderPath +'\'+ f.Name);
end
else
begin
//Call function recursively...
ClearFolder(FolderPath +'\'+ f.Name, mask, recursive);
end;
end;
until (FindNext (f) <> 0);
finally
SysUtils.FindClose (f)
end;
end;
答案 0 :(得分:29)
我不是自己做所有这些努力工作,而是使用SHFileOperation
:
uses
ShellAPI;
procedure DeleteDirectory(const DirName: string);
var
FileOp: TSHFileOpStruct;
begin
FillChar(FileOp, SizeOf(FileOp), 0);
FileOp.wFunc := FO_DELETE;
FileOp.pFrom := PChar(DirName+#0);//double zero-terminated
FileOp.fFlags := FOF_SILENT or FOF_NOERRORUI or FOF_NOCONFIRMATION;
SHFileOperation(FileOp);
end;
对于它的价值而言,代码的问题在于它不会调用DeleteFile
。因此,目录永远不会被清空,对RemoveDir
的调用失败等等。代码中缺少错误检查并没有多大帮助,但添加代码来删除文件会使代码变得不尽如人意。您还需要注意递归。您必须确保首先删除所有子项,然后确保父容器。这需要一定的技巧才能做到正确。基本方法是这样的:
procedure DeleteDirectory(const Name: string);
var
F: TSearchRec;
begin
if FindFirst(Name + '\*', faAnyFile, F) = 0 then begin
try
repeat
if (F.Attr and faDirectory <> 0) then begin
if (F.Name <> '.') and (F.Name <> '..') then begin
DeleteDirectory(Name + '\' + F.Name);
end;
end else begin
DeleteFile(Name + '\' + F.Name);
end;
until FindNext(F) <> 0;
finally
FindClose(F);
end;
RemoveDir(Name);
end;
end;
为了清楚起见,我省略了错误检查,但您应该检查DeleteFile
和RemoveDir
的返回值。
答案 1 :(得分:6)
procedure DeleteDir(const DirName: string);
var
Path: string;
F: TSearchRec;
begin
Path:= DirName + '\*.*';
if FindFirst(Path, faAnyFile, F) = 0 then begin
try
repeat
if (F.Attr and faDirectory <> 0) then begin
if (F.Name <> '.') and (F.Name <> '..') then begin
DeleteDir(DirName + '\' + F.Name);
end;
end
else
DeleteFile(DirName + '\' + F.Name);
until FindNext(F) <> 0;
finally
FindClose(F);
end;
end;
RemoveDir(DirName);
end;