Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Leere Verzeichnisse rekursiv löschen (https://www.delphipraxis.net/133724-leere-verzeichnisse-rekursiv-loeschen.html)

Andreas L. 7. Mai 2009 15:23


Leere Verzeichnisse rekursiv löschen
 
Hi,
ich möchte alle leeren Verzeichnisse + Unterverzeichnisse löschen. Mein Code verursacht leider eine Endlosschleife:
Delphi-Quellcode:
procedure DeleteEmptyDirectories(Path: String);
var
  iFolder, iFile: Integer;
  Folders, Files: TStrings;
begin
  Folders := TStringList.Create;
  FindAllFiles(Folders, Path, '*', False, True, True);
  for iFolder := Folders.Count -1 downto 0 do
  begin
    Files := TStringList.Create;
    FindAllFiles(Files, Folders[iFolder], '*', True, True, True);
    for iFile := Files.Count -1 downto 0 do
    begin
      if DirectoryExists(Files[iFile]) then
        DeleteEmptyDirectories(Path);
    end;
    if Files.Count > 0 then
      RemoveDir(Folders[iFolder]);
    Files.Free;
  end;
  Folders.Free;
end;
Hab' da wohl einen Denkfehler drin. Nur welchen? :wall:

mleyen 7. Mai 2009 15:29

Re: Leere Verzeichnisse rekursiv löschen
 
Du rufst die Funktion immer wieder rekursiv mit dem gleichen Parameter auf.
Ich hoffe das ist jetzt der einzige Fehler.
Delphi-Quellcode:
if DirectoryExists(Files[iFile]) then
  DeleteEmptyDirectories(Files[iFile]);

Fridolin Walther 7. Mai 2009 15:46

Re: Leere Verzeichnisse rekursiv löschen
 
Bei dem Code gäbe es übrigens gleich mehrere Möglichkeiten der Performance Steigerung. Die wohl offensichtlichste ist: Wieso enumerierst Du alle Dateien wenn Dich doch eh nur die Verzeichnisse interessieren?

SirThornberry 7. Mai 2009 15:51

Re: Leere Verzeichnisse rekursiv löschen
 
Ich würde hier aus Performancegründen direkt mit FindFirst etc. arbeiten. Denn da bekommt man schon mit ob es sich bei dem gefundenen Eintrag um eine Datei oder ein Verzeichnis handelt und erspart sich somit das Directoryexists.

Pseudocode:
Delphi-Quellcode:
function rmdir(dir: string);
var
  isEmpty: Boolean;
begin
  isEmpty := TRUE;

  if FindFirst() then
  begin
    repeat
      if ((FoundItem.Attr and FA_DIRECTORY) = FA_DIRECTORY) then
        rmdir(dir + '\' FoundItem.Name)
      else
        isEmpty := FALSE;
    until (FindNext() <> 0);
    FindClose();
  end;

  if (isEmpty) then
    RemoveDir(dir);
end;

Fridolin Walther 7. Mai 2009 16:09

Re: Leere Verzeichnisse rekursiv löschen
 
Oder vollständig:

Delphi-Quellcode:
program Project1;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils;

procedure DeleteEmptyDirectories(Path : string);
var
  SearchRecord : TSearchRec;
begin

  if FindFirst(IncludeTrailingPathDelimiter(Path) + '*.*', faAnyFile, SearchRecord) = 0 then
    begin
      repeat
        if (SearchRecord.Name <> '.') and (SearchRecord.Name <> '..') and (SearchRecord.Attr and faDirectory = faDirectory) then
          DeleteEmptyDirectories(IncludeTrailingPathDelimiter(Path) + SearchRecord.Name);
      until FindNext(SearchRecord) <> 0;
      FindClose(SearchRecord);
    end;

  RemoveDirectory(PChar(IncludeTrailingPathDelimiter(Path)));
end;

begin
  if DirectoryExists(ParamStr(1)) then
    DeleteEmptyDirectories(ParamStr(1));
end.
Prinzipiell könnte man faAnyFile durch eine Maske ersetzen, die spezifischer ist (faDirectory or faHidden or faReadOnly or ...). Da FindFirst intern aber die Windows API MSDN-Library durchsuchenFindFirstFile benutzt und selbige stets alle Dateien zurückliefert und diese Masken nicht unterstüzt, ist die Verwendung von faAnyFile deutlich einfacher ohne dabei großartig Performance einzubußen.

Andreas L. 7. Mai 2009 16:25

Re: Leere Verzeichnisse rekursiv löschen
 
Ich hab den Pseudocode von SirThornberry so umgesetzt:
Delphi-Quellcode:
procedure DeleteEmptyDirectories(Path: String);
var
  SearchRec: TSearchRec;
  IsEmpty: Boolean;
begin
  IsEmpty := True;

  if FindFirst(IncludeTrailingPathDelimiter(Path) + '*.*', faAnyFile, SearchRec) = 0 then
  begin
    repeat
      if ((SearchRec.Attr and faDirectory) = faDirectory) and (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
        DeleteEmptyDirectories(IncludeTrailingPathDelimiter(Path) + SearchRec.Name)
      else
        IsEmpty := False;
    until (FindNext(SearchRec) <> 0);
    FindClose(SearchRec);
  end;

  if IsEmpty then
    RemoveDir(Path);
end;
Funktioniert aber nicht. Was ist denn falsch?

Fridolin Walther 7. Mai 2009 16:34

Re: Leere Verzeichnisse rekursiv löschen
 
Delphi-Quellcode:
      if ((SearchRec.Attr and faDirectory) = faDirectory) and (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
        DeleteEmptyDirectories(IncludeTrailingPathDelimiter(Path) + SearchRec.Name)
      else
        IsEmpty := False;
IsEmpty ist immer False, weil jedes Verzeichnis einen Eintrag . und .. enthält. Prinzipiell müsste Deine Funktion so abgeändert werden:

Delphi-Quellcode:
      if ((SearchRec.Attr and faDirectory) = faDirectory) and (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
        DeleteEmptyDirectories(IncludeTrailingPathDelimiter(Path) + SearchRec.Name)
      else
        if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then IsEmpty := False;
Prinzipiell ist der Versuch zu Tracken ob eine Datei enthalten ist oder nicht aber völlig sinnbefreit. Wenn eine Datei im Verzeichnis ist, schlägt ein RemoveDir ohnehin fehl ;).

Andreas L. 7. Mai 2009 16:42

Re: Leere Verzeichnisse rekursiv löschen
 
Ok, jetzt gehts. Vielen Dank :thumb:

Delphi-Quellcode:
procedure DeleteEmptyDirectories(Path: String);
var
  SearchRec: TSearchRec;
begin
  if FindFirst(IncludeTrailingPathDelimiter(Path) + '*.*', faAnyFile, SearchRec) = 0 then
  begin
    repeat
      if ((SearchRec.Attr and faDirectory) = faDirectory) and (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
        DeleteEmptyDirectories(IncludeTrailingPathDelimiter(Path) + SearchRec.Name);
    until (FindNext(SearchRec) <> 0);
    FindClose(SearchRec);
  end;
  RemoveDir(Path);
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 19:28 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz