フォルダーとそのすべてのサブフォルダーを再帰的に削除しようとしていますが、まったく機能していません。コードを確認して、ここで何が間違っているのか教えてください。
私はWindowsXPで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;
このような大変な作業を自分で行うのではなく、 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
の戻り値をチェックする必要があります。
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;