Neue Version von FindAllFiles

[SirThornberry]

In der Codelib gibt es bereits die Funktion FindAllFiles. Jedoch liest diese funktion den Ordnerinhalt 2 mal ein, einmal um alle ordner aufzulisten für die rekursion und ein weiteres mal mit einer Maske um nur bestimmte Dateien aufzulisten. Bei Win98 welches solche Anfragen nicht cacht dauert somit das auflisten des Verzeichnisinhaltes doppelt so lange als es eigentlich müsste (und bekanntlich ist die Festplatte nicht gerade das schnellste an einem Rechner). Dementsprechend hab ich die Funktion nocheinmal nachprogrammiert.
Durch Verwendung einer InlineProcedure braucht "IncludeTrailingPathDelimiter" nur einmal aufgerufen werden und nicht bei jedem rekursiven aufruf erneut.
Desweiteren kann man per parameter angeben (AddFolderNames) ob Verzeichnisnamen mit aufgelistet werden sollen. In diesem Zusammenhang kann man außerdem festlegen ob auch Verzeichnisse mit aufgelistet werden sollen wo die Maske nicht zutrifft (hat auf die Rekursion keine Auswirkung).
Zusätzlich wird im Property Object von TStrings auch noch festgehalten ob es sich bei dem Eintrag um einen Ordner handelt oder nicht (das Property Object wurde dazu auf einen Boolean gecastet). Ist der Wert True so handelt es sich um einen Ordner.
Somit ist es zum Beispiel möglich nur TXT-Dateien eines Ordners anzuzeigen + Unterordner.
Zu beachten ist dabei das die Ordner und Dateien unsortiert sind, also nicht die Ordner ganz oben in der Liste aufgeführt sind und darunter die Dateien (würde sich aber auch noch anpassen lassen falls das jemandem sooo wichtig ist).

um das ganze lauffähig zu bekommen wird noch folgende Datei benötigt:
http://www.delphi-fundgrube.de/files/like.txt

Delphi-Quellcode:

procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string ='*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
  procedure LFindAllFiles(AParentFolder: String);
  var LSearchRec: TSearchRec;
  begin
    if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then
    begin
      repeat
        if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then
        begin
          if LSearchRec.Attr and faDirectory = faDirectory then
          begin
            if AddFolderNames and
               (IgnoreMaskAtFolderNames or Like(Mask, AnsiLowerCase(LSearchRec.Name))) then
              FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True));
            if Recurse then
              LFindAllFiles(FileList, AParentFolder + LSearchRec.Name + '\');
          end
          else if Like(Mask, AnsiLowerCase(LSearchRec.Name)) then
            FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False));
        end;
      until FindNext(LSearchRec) <> 0;
      FindClose(LSearchRec);
    end;
  end;
begin
  Mask := AnsiLowerCase(Mask);
  LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder));
end;

[edit=alcaeus]Kleinen Fehler auf Wunsch korrigiert. Mfg, alcaeus[/edit]

[Luckie]

Könntest du mal bitte ein Beispiel machen, wie man deine Funktion anwendet?

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  sl                     : TStringList;
  i: Integer;
begin
  sl := TStringList.Create;
  try
    FindAllFiles(sl, 'd:\Dokumente', '*', True, True, True);
    for i := 0 to sl.Count - 1 do
    begin
      ListBox1.Items.Add((sl.Strings[i]));
    end;
  finally
    FreeAndnIl(sl);
  end;
end;

Das liefert mir nur die Unterordner in dem Root Ordner, aber wo sind die Dateien?
Und das:
FindAllFiles(sl, 'd:\Dokumente'); liefert mir gar nichts zurück.

Und wo werden die Objekte wieder zerstört / freigegeben?

Zitat:

The TStrings object does not own the objects you add this way. Objects added to the TStrings object still exist even if the TStrings instance is destroyed.
They must be explicitly destroyed by the application.

Finde ich etwas blöd, dass eine nicht von mir impelentierte Funktion Speicher belegt, ihn aber nicht wieder frei gibt.

[runger]

Hallo,

mir gehts wie Luckie:
FindAllFiles(listbox1.items,'c:\','*',True,True,True); liefert nichts zurück. Machen wir was falsch?

Rainer

[Flocke]

Zitat von SirThornberry:

Delphi-Quellcode:

if Recurse then
  FindAllFiles(FileList, AParentFolder + LSearchRec.Name + '\');

an dieser Stelle muss es LFindAllFiles heißen.

[SirThornberry]

Oh, da hab ich wohl beim zusammenkopieren das testen vergessen Flocke hat die Lösung (den Fehler) gepostet..

[Luckie]

Hm, so ganz war es das aber auch nicht:

Delphi-Quellcode:

procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string = '*'; Recurse: Boolean = True;
  AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);

  procedure LFindAllFiles(AParentFolder: string);
  var LSearchRec         : TSearchRec;
  begin
    if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then
    begin
      repeat
        if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then
        begin
          if LSearchRec.Attr and faDirectory = faDirectory then
          begin
            if AddFolderNames and
              (IgnoreMaskAtFolderNames or Like(Mask, AnsiLowerCase(LSearchRec.Name))) then
              FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True));
            if Recurse then
              //FindAllFiles(FileList, AParentFolder + LSearchRec.Name + '\');
              LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder));
          end
          else if Like(Mask, AnsiLowerCase(LSearchRec.Name)) then
            FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False));
        end;
      until FindNext(LSearchRec) <> 0;
      FindClose(LSearchRec);
    end;
  end;
begin
  Mask := AnsiLowerCase(Mask);
  LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FindAllFiles(ListBox1.Items, 'd:\Dokumente'); //, '*', True, True, True);
end;

Das bringt mir das CPU fenster mit einer AccesViolation. Ich kann leider mit dem CPU fenster nichts anfangen.

[jfheins]

Vielleicht geht es ja so:LFindAllFiles(IncludeTrailingPathDelimiter(AParentFolder + LSearchRec.Name));

[SirThornberry]

@fjeins: "IncludeTrailingPathDelimiter" ist nicht mehr nötig an der Stelle - das ganze wurde bewusst so geändert das der Aufruf dieser Funktion nur ein einziges mal getätigt wird.
Haub auch noch die Fehler rausgemacht:

Delphi-Quellcode:

procedure FindAllFiles(FileList: TStrings; RootFolder: string; Mask: string ='*'; Recurse: Boolean = True; AddFolderNames: Boolean = False; IgnoreMaskAtFolderNames: Boolean = True);
  procedure LFindAllFiles(AParentFolder: String);
  var LSearchRec: TSearchRec;
  begin
    if FindFirst(AParentFolder + '*', faAnyFile, LSearchRec) = 0 then
    begin
      repeat
        if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then
        begin
          if LSearchRec.Attr and faDirectory = faDirectory then
          begin
            if AddFolderNames and
               (IgnoreMaskAtFolderNames or Like(Mask, AnsiLowerCase(LSearchRec.Name))) then
              FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True));
            if Recurse then
              LFindAllFiles(AParentFolder + LSearchRec.Name + '\');
          end
          else if Like(Mask, AnsiLowerCase(LSearchRec.Name)) then
            FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(False));
        end;
      until FindNext(LSearchRec) <> 0;
      FindClose(LSearchRec);
    end;
  end;
begin
  Mask := AnsiLowerCase(Mask);
  LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder));
end;

Beispielaufruf um alle ".txt" dateien aufzulisten die auf Laufwerk C oder in unterordnern von Laufwerk C sich befinden.

Delphi-Quellcode:

  ListBox1.Items.BeginUpdate;
  FindAllFiles(ListBox1.Items, 'c:\', '*.txt', True);
  ListBox1.Items.EndUpdate;

Bei diesem Beispiel werden die Dateien dann in einer Listbox angezeigt.

[Flocke]

Zitat von Luckie:

Delphi-Quellcode:

if Recurse then
  //FindAllFiles(FileList, AParentFolder + LSearchRec.Name + '\');
  LFindAllFiles(IncludeTrailingPathDelimiter(RootFolder));

Die Zeile, die du eingesetzt hast, hat ja auch mit der Ursprungszeile wenig zu tun
So sollte es gehen:

Delphi-Quellcode:

if Recurse then
  LFindAllFiles(FileList, AParentFolder + LSearchRec.Name + '\');