2009年2月27日

ディレクトリツリーから空のディレクトリだけを削除する

指定されたディレクトリの下にあるファイルを持たない空のディレクトリだけを再帰しながら削除していきます。
uses
  SysUtils, Classes;

function DeleteEmptyDir(const Path: String): Boolean;
var
  Index: Integer;
  DirNames: TStringList;
  SearchRec: TSearchRec;
begin

  Result := True;

  if Path = '' then
  begin
    Exit;
  end;

  DirNames := nil;
  try
    DirNames := TStringList.Create;

    { Search }
    if FindFirst(IncludeTrailingPathDelimiter(Path) + '*.*',faAnyFile,SearchRec) = 0 then
    begin
      try
        repeat
          if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
          begin
            Continue;
          end;

          if (SearchRec.Attr and faDirectory) <> 0 then
          begin
            DirNames.Add(IncludeTrailingPathDelimiter(Path) + SearchRec.Name);
          end
          else
          begin
            Result := False;
          end;

        until (FindNext(SearchRec) <> 0);

      finally
        FindClose(SearchRec);
      end;
    end;

    { Delete sub directories }
    for Index := 0 to DirNames.Count - 1 do
    begin
      if DeleteEmptyDir(DirNames.Strings[Index]) = True then
      begin
        { Delete }
        if RemoveDir(DirNames.Strings[Index]) = False then
        begin
          RaiseLastOSError;
        end;
      end
      else
      begin
        Result := False;
      end;
    end;

  finally
    DirNames.Free;
  end;

end;
最初に指定したディレクトリは削除されません。戻値がTrueであれば削除可能(指定したディレクトリの下がすべて削除された)であることを示します。

0 件のコメント: