2008年8月2日

ディレクトリツリーを削除する

指定されたディレクトリをその中身ごと削除するには、再帰しながらそのディレクトリに含まれる全てのファイルとサブディレクトリを削除していきます。
uses
  Windows, SysUtils, Classes;

procedure DeleteDirTree(const Path: String);
var
  Index: Integer;
  DirNames: TStringList;
  FileNames: TStringList;
  SearchRec: TSearchRec;
  Pathname: String;
begin

  if Path = '' then
  begin
    Exit;
  end;

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

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

          Pathname := IncludeTrailingPathDelimiter(Path) + SearchRec.Name;

          if (SearchRec.Attr and faDirectory) <> 0 then
          begin
            DirNames.Add(Pathname);
          end
          else
          begin
            FileNames.Add(Pathname);
          end;

        until (FindNext(SearchRec) <> 0);

      finally
        FindClose(SearchRec);
      end;
    end;

    { Delete sub directories }
    for Index := 0 to DirNames.Count - 1 do
    begin
      DeleteDirTree(DirNames.Strings[Index]);  // recursive call
    end;

    { Delete files }
    for Index := 0 to FileNames.Count - 1 do
    begin
      if DeleteFile(FileNames.Strings[Index]) = False then
      begin
        RaiseLastOSError;
      end;
    end;

    { Delete current directory }
    if RemoveDir(Path) = False then
    begin
      RaiseLastOSError;
    end;

  finally
    DirNames.Free;
    FileNames.Free;
  end;

end;
よくあるミスはFincCloseせずにディレクトリを削除しようとしてアクセス拒否を食らう、というやつです(普通にトラバースするだけならFindCloseしなくてもエラーにならないので気付きにくい)。

0 件のコメント: