Verzeichnisse nach Dateien durchsuchen

[Matze]

Luckie hat hier eine Funktion geschrieben, die Ordner und Unterordner nach Dateien durchsucht und dabei die API Funktion FindFirstFile verwendet.

Eine VCL-Version gibt es hier.

Delphi-Quellcode:

type
  TStringDynArray = array of string;

var
  FileCount: Cardinal = 0;
  Files   : TStringDynArray = nil;

function FindAllFiles(RootFolder: string; Mask: string = '*.*'; Recurse: Boolean
  = True): TStringDynArray;
var
  wfd          : TWin32FindData;
  hFile        : THandle;
begin
  if AnsiLastChar(RootFolder)^ <> '\' then
    RootFolder := RootFolder + '\';
  if Recurse then
  begin
    hFile := FindFirstFile(PChar(RootFolder + '*.*'), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY =
          FILE_ATTRIBUTE_DIRECTORY then
          if (string(wfd.cFileName) <> '.') and (string(wfd.cFileName) <> '..')
            then
            FindAllFiles(RootFolder + wfd.cFileName, Mask, Recurse);
      until FindNextFile(hFile, wfd) = False;
    finally
      windows.FindClose(hFile);
    end;
  end;
  hFile := FindFirstFile(PChar(RootFolder + '*.*'), wfd);
  if hFile <> INVALID_HANDLE_VALUE then
  try
    repeat
      if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <>
        FILE_ATTRIBUTE_DIRECTORY then
      begin
        FileCount := length(Files)+1;
        Setlength(Files, FileCount);
        Files[FileCount - 1] := RootFolder + String(wfd.cFileName);
      end;
    until FindNextFile(hFile, wfd) = False;
  finally
    Windows.FindClose(hFile);
  end;
end;

Beispielaufruf:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  i            : Integer;
begin
  Files := nil;
  FindAllFiles('d:\Dokumente', '*.*', True);
  for i := 0 to length(Files) - 1 do
  begin
    Listbox1.Items.Add(Files[i]);
  end;
end;

Suchworte: finden auflisten

[CalganX]

Von SirThornberry kommt folgende, verbesserte Variante:

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(AnsiLowerCase(LSearchRec.Name), Mask)) then
              FileList.AddObject(AParentFolder + LSearchRec.Name, TObject(True));
            if Recurse then
              LFindAllFiles(AParentFolder + LSearchRec.Name + '\');
          end
          else if Like(AnsiLowerCase(LSearchRec.Name), Mask) 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=Matze][11.07.05] Fehler auf Hinweis von SirThornberry korrigiert. Mfg, Matze[/edit]
[edit=SirThornberry][02.04.06] vertauschte Parameter von "like" korrigiert. Mfg, SirThornberry[/edit]