空フォルダの検出削除をする
解決よろしくお願いします。
winXP Delphi６Personalです。
あるフォルダの下にある無数のフォルダ内のファイルをある条件で削除しますが、
階層にかかわらずその下にファイルがないなら削除したいのです。
下の考え方は、まず階層＋フォルダパス名のリストを作成する。
次にフォルダリストを階層でソートする。
次に階層の深い順にフォルダを取り出しファイルが一個でもないか調べる。
ただし、隠しファイルはあっても無視する。
ファイルがないとフォルダを削除する。
何とも見苦しいコードですが、もっとスマートな方法はないのでしょうか。
よろしくお願いします。
procedure TForm1.KaraFolderDel(Path: string);
var
FolderList:TStringList;
//*************フォルダを削除する***************
procedure DeleteRootin(FromFile:string);
var
hSHFileOpStruct: TSHFileOpStruct;
begin
with hSHFileOpStruct do
begin
wnd := 0;
wFunc := FO_DELETE;
pFrom := PChar(FromFile + #0);
pTo := nil;//同じだったら新しい名前を付ける //FileNameを非表示
fFlags := FOF_NOCONFIRMMKDIR or FOF_NOCONFIRMATION;// or FOF_SIMPLEPROGRESS; //上書きしない
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end;
SHFileOperation(hSHFileOpStruct);
end;
//*************フォルダリストを作成する***************
procedure Build( Path: String; level:integer);
var
SearchRec:TSearchRec;
level2:integer;
str:string;
begin
Path := ExcludeTrailingPathDelimiter(Path); //最後の¥をつける
if (FindFirst(Path + '\*.*', faAnyFile, SearchRec) = 0) then
begin
try
repeat
if ((SearchRec.Name <> '.') and (SearchRec.Name <> '..')) then
begin
if ((SearchRec.Attr and faDirectory) > 0) then
begin
str:= Path + '\'+ SearchRec.Name;
FolderList.Add(AnsiQuotedStr(IntToStr(Level), '"')+','+AnsiQuotedStr(str, '"'));
level2:=level+1;
Build(Path + '\'+ SearchRec.Name, level2)
end;
end;
until (FindNext(SearchRec) <> 0);
finally
FindClose(SearchRec);
end;
end;
end;
//***********フォルダ内にフォルダかファイルの有無を調べる******************
procedure FindFiles(Path:string; var DirList, FileList: integer);
var
SearchRec: TSearchRec;
Attr:integer;
begin
Attr:=(faReadOnly +faSysFile+faVolumeID+faDirectory+faArchive);
Path := ExcludeTrailingPathDelimiter(Path);
if (FindFirst(Path + '\*.*', Attr, SearchRec) = 0) then
begin
try
repeat
if ((SearchRec.Name <> '.') and (SearchRec.Name <> '..')) then
begin
if ((SearchRec.Attr and faDirectory) > 0) then
begin Inc(DirList);break;end
else
begin
if SearchRec.Attr<>faHidden then
begin Inc(FileList);break;end;
end;
end;
until (FindNext(SearchRec) <> 0);
finally
FindClose(SearchRec);
end;
end;
end;
//******************************
var
DirList,FileList:integer;
i:integer;
StrList:TStringList;
FolderPath:string;
begin
FolderList:=TStringList.Create; //フォルダリストを作成する
StrList:=TStringList.Create;
try
Build(Path,0);
FolderList.Sorted:=true;//階層の深さでソートする
//階層の深いフォルダ順にファイルがあるか調べて無ければ削除する
for i:= FolderList.count-1 downto 0 do
begin
StrList.CommaText:=FolderList.Strings[i];
FolderPath:= StrList.Strings[1];
DirList:=0; FileList:=0;
FindFiles(FolderPath, DirList,FileList);
//ファイルもフォルダもなければ削除する
if (DirList=0) and (FileList=0) then
begin
DeleteRootin( FolderPath);
end;
end;
finally
FolderList.Free;
StrList.Free;
end;
end;
手っ取り早く簡単にやりたいなら
SHFileOperationってのがあります。
どうせ検索するのに再帰使ってるんだから
procedure hoge;
begin
サブディレクトリ検索ループ
begin
hoge; ←再帰呼び出し
end;
ファイルがなかったらディレクトリを削除する
end;
で深い順から削除になりませんか？
ついでに FileExists('*.*') みたいにワイルドカードが使えるという裏技？があったようななかったような。
monaaさん、ttt さん有り難うございました。
いろいろトライしましたが、よく理解できませんでした。
すみません。
てとりあしとり。
空ではないフォルダの削除サンプル。
//その１(FindFirst) 要:SysUtils.pas
procedure DeleteFolderA(path:string);
var
sr:TSearchRec;
pathr:string;
begin
pathr:= IncludeTrailingPathDelimiter(path);
if FindFirst(pathr+'*.*', faAnyFile, sr) = 0 then
begin
repeat
if (sr.Name <> '.') and (sr.Name <> '..') then
begin
if ((sr.Attr or faDirectory) = sr.Attr) then
DeleteFolderA(pathr + sr.Name);
DeleteFile(pathr + sr.Name);
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
RemoveDirectory(PChar(path));
end;
//その２(SHFileOperation) 要:ShellAPI.pas
procedure DeleteFolderB(path:string);
var
fs :TSHFileOpStruct;
begin
FillChar(fs,SizeOf(fs),0);
fs.Wnd := Application.Handle;
fs.wFunc := FO_DELETE;
fs.pFrom := PChar(path + '\*.*' + #0#0);
fs.pTo := 0;
fs.fFlags:=FOF_SIMPLEPROGRESS or FOF_NOCONFIRMATION;
SHFileOperation(fs);
RemoveDirectory(PChar(path));
end;
tttさんの言われるとおり再帰で深い順から削除できると思いますよ。
↓はUnicode対応のAPIを使っていますが、やってることはDelphiのFindFirstなどと同じです。
function TForm1.DeleteEmptyFolder(sPath: WideString): Boolean;
//sPathが空のフォルダなら削除してTrueを返す。
var
lh_File: THandle;
lr_Info: TWin32FindDataW;
begin
Result := True;
if (sPath[Length(sPath)] <> '\') then begin
sPath := sPath + '\';
end;
lh_File := FindFirstFileW(PWideChar(sPath + '*.*'), lr_Info);
if (lh_File <> INVALID_HANDLE_VALUE) then begin
try
repeat
if (BOOL(lr_Info.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) then begin
//フォルダ。
if (lr_Info.cFileName <> WideString('.')) //カレントフォルダではなく
and (lr_Info.cFileName <> WideString('..')) //親フォルダでもない
then begin
//サブフォルダ。
if not(DeleteEmptyFolder(sPath + lr_Info.cFileName)) then begin
//サブフォルダは空ではない。
Result := False;
end;
end;
end else begin
//ファイルが存在するのでフォルダは空ではない。
Result := False;
end;
Application.ProcessMessages;
until not(FindNextFileW(lh_File, lr_Info));
finally
Windows.FindClose(lh_File);
end;
end;
if (Result) then begin
//リストに追加＆削除
MyListBox1.Items.Add(sPath);
RemoveDirectoryW(PWideChar(sPath));
end;
end;
あら・・・かぶっちゃった。
monaa さん、Ｄさん手取り足取りで教えて頂き有り難うございました。
うまくいきました。
再帰は何度か使ったことがありましたが
ファイルの有無を調べる理屈が理解できていませんでした。
今後も汎用的に使えるコードであり勉強になりました。
有り難うございました。
| ツイート |  |