Klasse für FindFirstFile/FindNextFile

[Luckie]

Da es immer wieder gefragt wird und ich es jetzt auch mal wieder gebraucht habe, habe ich die API-Funktionen zum Durchsuchen von Verzeichnisses mal in eine kleine Klasse gepackt:

Delphi-Quellcode:

// FindFiles - Klasse zum Durchsuchen von Ordnern
// Michael Puff [[url]http://www.michael-puff.de][/url]

unit FindFilesCls;

interface

uses
  Windows;

type
  TOnFindFile = procedure(Filename: string) of object;
  TOnDirectoryFind = procedure(Directory: string) of object;
  TFindFiles = class(TObject)
  private
    FSubfolders: Boolean;
    FMask: string;
    FOnFindFile: TOnFindFile;
    FOnFindDirectory: TOnDirectoryFind;
  public
    constructor Create;
    procedure Find(RootFolder: string);
    property SubFolders: Boolean read FSubFolders write FSubFolders;
    property Mask: string read FMask write FMask;
    property OnFileFind: TOnFindFile read FOnFindFile write FOnFindFile;
    property OnDirectoryFind: TOnDirectoryFind read FOnFindDirectory write FOnFindDirectory;
  end;

implementation

{ TFindFiles }

constructor TFindFiles.Create;
begin
  inherited;
  FSubfolders := False;
  FMask := '*.*';
end;

procedure TFindFiles.Find(RootFolder: string);
var
  wfd: TWin32FindData;
  hFile: THandle;
begin
  if RootFolder[Length(RootFolder)] <> '\' then
    RootFolder := RootFolder + '\';
  if Self.SubFolders 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
          begin
            if Assigned(OnDirectoryFind) then
              OnDirectoryFind(RootFolder + wfd.cFileName);
            Find(RootFolder + wfd.cFileName);
          end;
      until FindNextFile(hFile, wfd) = False;
    finally
      windows.FindClose(hFile);
    end;
  end;
  hFile := FindFirstFile(PChar(RootFolder + Self.Mask), wfd);
  if hFile <> INVALID_HANDLE_VALUE then
  try
    repeat
      if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <>
        FILE_ATTRIBUTE_DIRECTORY then
      begin
        if Assigned(OnFileFind) then
          OnFileFind(RootFolder + wfd.cFileName);
      end;
    until FindNextFile(hFile, wfd) = False;
  finally
    Windows.FindClose(hFile);
  end;
end;

end.

Delphi-Quellcode:

procedure TForm9.Button1Click(Sender: TObject);
var
  FindFiles: TFindFiles;
begin
  FindFiles := TFindFiles.Create;
  try
    FindFiles.SubFolders := True;
    FindFiles.Mask := '*.dpr';
    FindFiles.OnFileFind := OnFindFile;
    FindFiles.OnDirectoryFind := OnFindDirecetory;
    FindFiles.Find(Edit1.Text);
  finally
    FindFiles.Free;
  end;
end;

procedure TForm9.OnFindDirecetory(Directory: string);
begin
  Memo1.Lines.Add(Directory);
  Application.ProcessMessages;
end;

procedure TForm9.OnFindFile(Filename: string);
begin
  Memo1.Lines.Add(Filename);
  Application.ProcessMessages;
end;

@CodeLib Manager: Eventuell kann man das an den von mir schon vorhandenen Beitrag anhängen.

[HeikoAdams]

Also erst einmal :thumb:

Aber warum benutzt Du anstelle von

Delphi-Quellcode:

  if RootFolder[Length(RootFolder)] <> '\' then
    RootFolder := RootFolder + '\';

nicht einfach IncludeTrailingPathDelimiter?

Delphi-Quellcode:

RootFolder := IncludeTrailingPathDelimiter(RootFolder);

[Luckie]

Weil ich die Unit SysUtils nicht unnötig einbinden will für diese eine Funktion.

[Daniel]

Jetzt noch einen Dreizeiler, der die Verwendung demonstriert und dann ist's perfekt.
:-)

[himitsu]

Bei den Folders wäre es wohl besser '*' oder '*.*' als Maske zu nehmen.
(sonst klappt es mit dem rekursiven Suchen eventuell nicht wie geplant)


Es wäre auch ganz praktisch, wenn TWin32FindData auch mit in den Event-Prozeduren (TOnFindFile und Co.) verfügbar wäre.
So hätte man da dann auch gleich einige Zusatzdaten zur Verfügung.
(Dateigröße oder einige Datumangaben sind doch oftmals recht brauchbar und wenn man sie hier schonmal zu Hand hat ...)

Eine Möglichkeit zum Abbrechen ist auch nie verkehrt. :stupid:

PS: Warum greifst du von innen auf "externe" Property (z.B. Self.SubFolders) zu, obwohl du direkten Zugriff auf das Feld hast?

PSS: Bei RootFolder einen Leerstring zu übergeben, ergibt bestimmt einen netten Effekt. :shock:
(auch wenn man ja eh keine relativen Pfade verwenden soll :lol: )

Und wie war das nochmal mit den =False- oder =True-Verleichen?

Delphi-Quellcode:

// FindFiles - Klasse zum Durchsuchen von Ordnern
// Michael Puff [[url]http://www.michael-puff.de][/url]
// Weitere Autoren: himitsu, omata

unit FindFiles;

{.$DEFINE UsesSysUtils}

interface

uses
  Windows
  {$IFDEF UseSysUtils} , SysUtils, DateUtils {$ENDIF}
  {$IFDEF UseClasses} , Classes {$ENDIF};

type
  TFindFiles = class;
  TOnFindFile = procedure(Sender: TFindFiles; Directory, FileName: string; 
                          Level: Integer; const Info: TWin32FindData;
                          var Cancel: Boolean) of object;
  TOnFindDirectory = procedure(Sender: TFindFiles; Directory, DirName: string;
                               Level: Integer; const Info: TWin32FindData;
                               var Cancel: Boolean; var IgnoreDirectory: Boolean) of object;
  TOnDirectoryUp = procedure(Sender: TFindFiles; FromDirectory, ToDirectory: string;
                             var Cancel: Boolean) of object;

  // Cancel           > Cancels the entire search process.
  // IgnoreDirectory  > Skips the reading of this directory and all its subdirectories.
  // Errors (HRESULT) > NO_ERROR = S_OK      = 0
  //                  > ERROR_FILE_NOT_FOUND = 2 > The system cannot find the file.
  //                  > ERROR_PATH_NOT_FOUND = 3 > The system cannot find the path.
  //                  > ERROR_NO_MORE_FILES = 18 > The user set "Cancel" in the callback to TRUE.

  TFindFiles = class
  private
    FMask: string;
    FSubfolders: Boolean;
    FOnFindFile: TOnFindFile;
    FOnFindDirectory: TOnFindDirectory;
    FOnDirectoryUp: TOnDirectoryUp;
    FCountFiles: Integer;
    FCountDirectories: Integer;
    FMaxDirectoryLevel: Integer; 
    FCancel: Boolean;
    {$IF Declared(TStrings)}
      FStrings: TStrings;
      procedure StringsFindFile(Sender: TFindFiles; Directory, FileName: string;
        Level: Integer; const Info: TWin32FindData; var Cancel: Boolean);
    {$IFEND}
    function Search(RootFolder: string; Level: Integer): HRESULT;
  public
    constructor Create;

    property Mask: string read FMask write FMask;
    property SubFolders: Boolean read FSubFolders write FSubFolders;
    property OnFindFile: TOnFindFile read FOnFindFile write FOnFindFile;
    property OnFindDirectory: TOnFindDirectory read FOnFindDirectory write FOnFindDirectory;
    property OnDirectoryUp: TOnDirectoryUp read FOnDirectoryUp write FOnDirectoryUp;

    function Find(RootFolder: string): HRESULT;

    // This can also be accessed via "Sender" by the callbacks from.
    property CountOfFiles: Integer read FCountFiles;
    property CountOfDirectories: Integer read FCountDirectories;
    property MaximumDirectoryLevel: Integer read FMaxDirectoryLevel;
    property Cancel: Boolean read FCancel;

    class function FindEx(RootFolder, Mask: string; SubFolders: Boolean; OnFindFile: TOnFindFile;
      OnFindDirectory: TOnFindDirectory = nil; OnDirectoryUp: TOnDirectoryUp = nil): HRESULT;
    class function isOK(E: HRESULT): Boolean;
    class function GetErrorStr(E: HRESULT): String;
    class function DecodeFiletime(const FileTime: TFileTime): TDateTime;

    {$IF Declared(TStrings)}
      class function FindEx(RootFolder, Mask: string; SubFolders: Boolean; SL: TStrings): HRESULT; overload;
    {$IFEND}
  end;

implementation

{$IF Declared(TStrings)}
  procedure TFindFiles.StringsFindFile(Sender: TFindFiles; Directory, FileName: string;
    Level: Integer; const Info: TWin32FindData; var Cancel: Boolean);
  begin
    FStrings.Add(Directory + FileName);
  end;
{$IFEND}

function TFindFiles.Search(RootFolder: string; Level: Integer): HRESULT;
var
  wfd: TWin32FindData;
  hFile: THandle;
  Ignore: Boolean;
  Error: HRESULT;
begin
  Result := NO_ERROR;
  if (RootFolder <> '') and (RootFolder[Length(RootFolder)] <> '\') then
    RootFolder := RootFolder + '\';
  if Level > FMaxDirectoryLevel then
    FMaxDirectoryLevel := Level;
  if FSubFolders then
  begin
    hFile := FindFirstFile(PChar(RootFolder + '*.*'), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    begin
      try
        repeat
          if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
            if     (string(wfd.cFileName) <> '.')
               and (string(wfd.cFileName) <> '..') then
            begin
              Ignore := False;
              if Assigned(FOnFindDirectory) then
                FOnFindDirectory(Self, RootFolder, wfd.cFileName, Level, wfd, FCancel, Ignore);
              if not FCancel and not Ignore then
              begin
                Inc(FCountDirectories);
                Error := Search(RootFolder + wfd.cFileName + '\', Level + 1);
                if Error <> S_OK then Result := Error;
              end;
              if not FCancel and Assigned(FOnDirectoryUp) then
                FOnDirectoryUp(Self, RootFolder + wfd.cFileName, RootFolder, FCancel);
            end;
        until FCancel or not FindNextFile(hFile, wfd);
      finally
        windows.FindClose(hFile);
      end;
    end
    else
      if GetLastError <> ERROR_FILE_NOT_FOUND then
        Result := GetLastError;
  end;
  if not FCancel then
  begin
    hFile := FindFirstFile(PChar(RootFolder + FMask), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    begin
      try
        repeat
          if wfd.dwFileAttributes and (FILE_ATTRIBUTE_DIRECTORY or FILE_ATTRIBUTE_DEVICE) = 0 then
          begin
            Inc(FCountFiles);
            if Assigned(FOnFindFile) then
              FOnFindFile(Self, RootFolder, wfd.cFileName, Level, wfd, FCancel);
          end;
        until FCancel or not FindNextFile(hFile, wfd);
      finally
        Windows.FindClose(hFile);
      end;
    end
    else
      if GetLastError <> ERROR_FILE_NOT_FOUND then
        Result := GetLastError;
  end;
end;

constructor TFindFiles.Create;
begin
  inherited;
  FMask := '*.*';
  FSubFolders := True;
end;

function TFindFiles.Find(RootFolder: string): HRESULT;
begin
  FCountFiles := 0;
  FCountDirectories := 0;
  FMaxDirectoryLevel := 0;
  FCancel := False;
  Result := Search(RootFolder, 0);
  if (Result = NO_ERROR) and (FCountFiles = 0) then
    Result := ERROR_FILE_NOT_FOUND;
  if FCancel then Result := ERROR_NO_MORE_FILES;
end;

class function TFindFiles.FindEx(RootFolder, Mask: string; SubFolders: Boolean; OnFindFile: TOnFindFile;
  OnFindDirectory: TOnFindDirectory = nil; OnDirectoryUp: TOnDirectoryUp = nil): HRESULT;
var
  FF: TFindFiles;
begin
  FF := TFindFiles.Create;
  try
    FF.Mask := Mask;
    FF.SubFolders := SubFolders;
    FF.OnFindFile := OnFindFile;
    FF.OnFindDirectory := OnFindDirectory;
    FF.OnDirectoryUp := OnDirectoryUp;
    Result := FF.Find(RootFolder);
  finally
    FF.Free;
  end;
end;

class function TFindFiles.isOK(E: HRESULT): Boolean;
begin
  Result := (E <> NO_ERROR) and (E <> ERROR_FILE_NOT_FOUND);
end;

class function TFindFiles.GetErrorStr(E: HRESULT): String;
{$IF Declared(SysErrorMessage)}
  begin
    Result := SysErrorMessage(E);
  end;
{$ELSE}
  var
    Buffer: array[0..255] of Char;
    Len: Integer;
  begin
    Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS or
      FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, E, 0, Buffer, SizeOf(Buffer), nil);
    SetString(Result, Buffer, Len);
  end;
{$IFEND}

class function TFindFiles.DecodeFiletime(const FileTime: TFileTime): TDateTime;
{$IF Declared(EncodeDateTime)}
  var
    LocalFileTime: TFileTime;
    SystemTime: TSystemTime;
  begin
    if FileTimeToLocalFileTime(FileTime, LocalFileTime)
      and FileTimeToSystemTime(LocalFileTime, SystemTime) then
    begin
      with SystemTime do
        Result := EncodeDateTime(wYear, wMonth, wDay, wHour, wMinute, wSecond, wMilliseconds);
    end
    else
      Result := -1;
  end;
{$ELSE}
  const
    MonthDays: array[Boolean] of array[1..12] of Word =
      ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
       (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
  var
    LocalFileTime: TFileTime;
    SystemTime: TSystemTime;
  begin
    if FileTimeToLocalFileTime(FileTime, LocalFileTime)
      and FileTimeToSystemTime(LocalFileTime, SystemTime) then
    begin
      with SystemTime do
      begin
        Dec(wYear);
        Result := wYear * 365 + wYear div 4 - wYear div 100 + wYear div 400 + wDay - 693594
          + MonthDays[(wYear mod 4 = 0) and ((wYear mod 100 <> 0) or (wYear mod 400 = 0))][wMonth]
          + wHour / 24 + wMinute / 1440 + wSecond / 86400 + wMilliseconds / 86400000;
      end;
    end
    else
      Result := -1;
  end;
{$IFEND}

{$IF Declared(TStrings)}
  class function TFindFiles.FindEx(RootFolder, Mask: string; SubFolders: Boolean; SL: TStrings): HRESULT;
  var
    FF: TFindFiles;
  begin
    FF := TFindFiles.Create;
    try
      FF.Mask := Mask;
      FF.SubFolders := SubFolders;
      FF.OnFindFile := FF.StringsFindFile;
      FF.FStrings := SL;
      FF.FStrings.BeginUpdate;
      try
        Result := FF.Find(RootFolder);
      finally
        FF.FStrings.EndUpdate;
      end;
    finally
      FF.Free;
    end;
  end;
{$IFEND}

end.

[edit]
Code entsprechend einiger Kriterienen nachfolgender Posts/Wünsche/Fehler verändert.

[Luckie]

@himitsu: Verbesserungen akzeptiert. Das mit dem Abbrechen ist eine gute Idee. Die Struktur habe ich nicht weitergegeben, weil ich in meinem Programm nur den Dateinamen brauchte. ;)

[himitsu]

Zitat:

Zitat von Luckie

Die Struktur habe ich nicht weitergegeben, weil ich in meinem Programm nur den Dateinamen brauchte. ;)

Joar, aber vielleicht ist es ja für Andere praktisch und es ergibt sich dadurch nichtmal vom Speicher oder der Laufzeit her einen Nachteil, wenn man es dennoch weitergibt, auch wenn es nicht nötig ist.

PS: Hatte oben noch schnell einen Fehler beseitigt.

[edit] ständig verschreibt man sich -.-°

[DeddyH]

Dann korrigier die Zeile

Zitat:

Delphi-Quellcode:

hFile := FindFirstFile(PChar(RootFolder + '*.*), wfd);

doch auch gleich noch, da fehlt das abschließende '.

[Luckie]

Das habe ich jetzt schon zwei mal gemacht und jedes mal hat er es wieder rückgängig gemacht. ;)

[himitsu]

Ohhh, das ist dann aber blöd ... woher soll ich wissen, daß die DP auf solche Änderungen nicht hinweißt. :shock:

[DeddyH]

Pöhser Frank, pöhser :lol:

[negaH]

@Luckie,

mal so nebenbei und aus aktuellem Anlass ein Kompliment für deinen sauberen Programmierstil, da kann man sagen: das lässt sich sehr flüssig lesen und man sieht sofort die Fehler die hätten drinnen sein können wenn es anders formatiert wäre ;) Zum Glück keine Fehler, weil sauber geschrieben.

Gruß Hagen

[Luckie]

Zitat:

Zitat von negaH

@Luckie,

mal so nebenbei und aus aktuellem Anlass ein Kompliment für deinen sauberen Programmierstil, da kann man sagen: das lässt sich sehr flüssig lesen und man sieht sofort die Fehler die hätten drinnen sein können wenn es anders formatiert wäre ;) Zum Glück keine Fehler, weil sauber geschrieben.

Danke. Das geht runter wie Öl. :P Aber ich habe auch lange gebraucht, bis ich soweit war. Habe mich allerdings in letzter Zeit etwas damit auseinander gesetzt. Nicht zu Letzt, weil ich beruflich jetzt überwiegend mit PHP arbeite und da muss man sauberen Code schreiben. ;)

[Luckie]

Kann man da irgendwie noch ein Ereignis einbauen, wenn wieder in das übergeordnete Verzeichnis gewechselt wird? Als Parameter wären beide Verzeichnisse, also aus dem zurückgesprungen wird und in welches zurückgesprungen wird, wünschenswert.

[omata]

Was soll die Frage? Wie wäre es mit realisieren...

Delphi-Quellcode:

unit FindFilesCls;

interface

uses
  Windows;

type
  TOnFindFile = procedure(Filename: string;
                          const Info: TWin32FindData;
                          var Cancel: Boolean) of object;
  TOnDirectoryFind = procedure(Directory: string;
                               const Info: TWin32FindData;
                               var Cancel: Boolean) of object;
  TOnDirectoryUp = procedure(FromDirectory, ToDirectory: string;
                             var Cancel: Boolean) of object;
  TFindFiles = class
  private
    FSubfolders: Boolean;
    FMask: string;
    FOnFindFile: TOnFindFile;
    FOnFindDirectory: TOnDirectoryFind;
    FOnDirectoryUp: TOnDirectoryUp;
    FCancel: Boolean;
    procedure Search(RootFolder: string);
  public
    constructor Create;
    property SubFolders: Boolean
      read FSubFolders write FSubFolders;
    property Mask: string
      read FMask write FMask;
    property OnFileFind: TOnFindFile
      read FOnFindFile write FOnFindFile;
    property OnDirectoryFind: TOnDirectoryFind
      read FOnFindDirectory write FOnFindDirectory;
    property OnDirectoryUp: TOnDirectoryUp
      read FOnDirectoryUp write FOnDirectoryUp;
    procedure Find(RootFolder: string);
  end;

implementation

{ TFindFiles }

constructor TFindFiles.Create;
begin
  inherited;
  FSubfolders := False;
  FMask := '*.*';
  FOnFindFile:=nil;
  FOnFindDirectory:=nil;
  FOnDirectoryUp:=nil;
end;

procedure TFindFiles.Search(RootFolder: string);
var
  wfd: TWin32FindData;
  hFile: THandle;
begin
  if (RootFolder <> '') and (RootFolder[Length(RootFolder)] <> '\') then
    RootFolder := RootFolder + '\';
  if not FCancel and FSubFolders then
  begin
    hFile := FindFirstFile(PChar(RootFolder + '*.*'), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
          if     (string(wfd.cFileName) <> '.')
             and (string(wfd.cFileName) <> '..') then
          begin
            if Assigned(OnDirectoryFind) then
              OnDirectoryFind(RootFolder + wfd.cFileName, wfd, FCancel);
            Find(RootFolder + wfd.cFileName + '\');
            if Assigned(OnDirectoryUp) then
              OnDirectoryUp(RootFolder + wfd.cFileName, RootFolder, FCancel);
          end;
      until FCancel or not FindNextFile(hFile, wfd);
    finally
      windows.FindClose(hFile);
    end;
  end;
  if not FCancel and Assigned(OnFileFind) then
  begin
    hFile := FindFirstFile(PChar(RootFolder + FMask), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
          OnFileFind(RootFolder + wfd.cFileName, wfd, FCancel);
      until FCancel or not FindNextFile(hFile, wfd);
    finally
      Windows.FindClose(hFile);
    end;
  end;
end;

procedure TFindFiles.Find(RootFolder: string);
begin
  FCancel := False;
  Search(RootFolder);
end;

end.

[himitsu]

Nur noch eine kleine Änderung,

Code:

if [b]not FCancel and[/b] Assigned(FOnDirectoryUp) then

damit OnDirectoryUp nicht aufgerufen wird, wenn in damit OnDirectoryFind abgerochen wurde.


[edit]
Code hier entfernt und dafür in Beitrag #5 geändert

[NormanNG]

Hi,

wäre es nicht auch nützlich, in das FOnDirectoryFind noch einen Parameter IgnoreDirectory einzuführen?

Delphi-Quellcode:

  TOnDirectoryFind = procedure(Directory: string;
                               const Info: TWin32FindData;
                               var Cancel: Boolean;
                               var IgnoreDirectory: Boolean) of object;

[himitsu]

Zitat:

Zitat von NormanNG

wäre es nicht auch nützlich

In Beitrag #5 mit drinnen.

Hatte zwar überlegt, ob man die beiden sich beeinflussenden Cancel und IgnoreDirectory kombinieren könnte und es dann nur einen Parameter gäbe,
aber nur für diese eine Prozedur einen neuen Enum einzuführen spart nicht wirklich was ein.

[Daniel]

Dann sollte in die Doku mit rein, ob der neue Parameter nur dazu führt, das aktuelle Verzeichnis zu überspringen oder auch ggf. alle Unterverzeichnisse gleich mit.

[Luckie]

@omata: Ja, hätte ich auch machen können, nur ich hatte gestern Abend etwas Matsch in der Birne und habe die Stelle einfach nicht mehr gesehen. ;)

Hier jetzt der aktuelle Code:

Delphi-Quellcode:

// FindFiles - Klasse zum Durchsuchen von Ordnern
// Michael Puff [[url]http://www.michael-puff.de][/url], himitsu, omata

unit MpuFindFilesCls;

interface

uses
  Windows;

type
  TOnFindFile = procedure(Filename: string; const Info: TWin32FindData; var Cancel: Boolean) of object;
  TOnFindDirectory = procedure(Directory: string; const Info: TWin32FindData; var Cancel: Boolean; var IgnoreDirectory: Boolean) of object;
  TOnDirectoryUp = procedure(FromDirectory, ToDirectory: string; var Cancel: Boolean) of object;
  TFindFiles = class(TObject)
  private
    FSubfolders: Boolean;
    FMask: string;
    FCancel: Boolean;
    FOnFindFile: TOnFindFile;
    FOnFindDirectory: TOnFindDirectory;
    FOnDirectoryUp: TOnDirectoryUp; 
    procedure Search(RootFolder: string);
  public
    constructor Create;
    procedure Find(RootFolder: string);
    property SubFolders: Boolean read FSubFolders write FSubFolders;
    property Mask: string read FMask write FMask;
    property OnFindFile: TOnFindFile read FOnFindFile write FOnFindFile;
    property OnFindDirectory: TOnFindDirectory read FOnFindDirectory write FOnFindDirectory;
    property OnDirectoryUp: TOnDirectoryUp read FOnDirectoryUp write FOnDirectoryUp;
  end;

implementation

{ TFindFiles }

constructor TFindFiles.Create;
begin
  inherited;
  FSubfolders := False;
  FMask := '*.*';
end;

procedure TFindFiles.Search(RootFolder: string);
var
  wfd: TWin32FindData;
  hFile: THandle;
  Ignore: Boolean;
begin
  if (RootFolder <> '') and (RootFolder[Length(RootFolder)] <> '\') then
    RootFolder := RootFolder + '\';
  if not FCancel and FSubFolders then
  begin
    hFile := FindFirstFile(PChar(RootFolder + '*.*'), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
          if     (string(wfd.cFileName) <> '.')
             and (string(wfd.cFileName) <> '..') then
          begin
            Ignore := False;
            if Assigned(FOnFindDirectory) then
              FOnFindDirectory(RootFolder + wfd.cFileName, wfd, FCancel, Ignore);
            if not FCancel and not Ignore then
              Find(RootFolder + wfd.cFileName + '\');
            if not FCancel and Assigned(FOnDirectoryUp) then
              FOnDirectoryUp(RootFolder + wfd.cFileName, RootFolder, FCancel);
          end;
      until FCancel or not FindNextFile(hFile, wfd);
    finally
      windows.FindClose(hFile);
    end;
  end;
  if not FCancel and Assigned(OnFindFile) then
  begin
    hFile := FindFirstFile(PChar(RootFolder + FMask), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
          OnFindFile(RootFolder + wfd.cFileName, wfd, FCancel);
      until FCancel or not FindNextFile(hFile, wfd);
    finally
      Windows.FindClose(hFile);
    end;
  end;
end;

procedure TFindFiles.Find(RootFolder: string);
begin
  FCancel := False;
  Search(RootFolder);
end;

end.

Ich habe mal himitsu und omata* als Co-Autoren eingetragen. Falls ich jemanden vergessen habe, bitte melden.

@himitsu: Du hattest zwei kleine Fehler drin. Und ich habe die Ereignisse umbenannte, so klingt es besser, finde ich.

@Daniel: Ja der Parameter IgnoreDirectory müsste Dokumentiert werden, es sei denn uns fällt noch ein besserer Name ein, was mir eigentlich lieber wäre.

*) Falls ihr mit richtigen Namen genannt werden wollt, sagt Bescheid.

[Tryer]

Da ich das ganze in einem laufenden Projekt gerade gebrauchen könnte hab ich mich mal ans "erweitern" gemacht. Vielleicht etwas zu lang als "Schnipsel" für die CodeLib, aber vielleicht doch interessant.
Ich freu mich auf Eure Verbesserungsvorschläge.
Entwickelt unter D7 / XP

Grüsse, Dirk

Delphi-Quellcode:

unit DSFindFilesCls;
(* FindFiles - Klasse zum Durchsuchen von Ordnern
   basierend auf der Entwicklung von
   Michael Puff [[url]http://www.michael-puff.de][/url], himitsu, omata,
   modifiziert/erweitert von Dirk S. aka Tryer

 Im Forum unter [url]http://www.delphipraxis.net/topic177139,0,asc,15.html[/url] 
 "Klasse für FindFirstFile/FindNextFile"

 Meine Änderungen:
 - einheitlich "Folder" an Stelle von "Directory" verwendet
 - SysUtils eingebunden für Exception / DirectoryExists  
   TODO: ggf. Funktionen anderweitig implementieren/ersetzen
 - Bei ScanSubFolders = False wird OnFindFolder/OnFindFolders für die
   enthaltenen Unterverzeichnisse von RootFolder ausgelöst.
 - Nur einmalige Korrektur von Rootfolder in Find(), da abschliessendes '\' in
   Search() sichergestellt ist
 - Laufzeitreduzierung durch gemeinsame Suchschleife für Verzeichnise und Dateien
   da für die Suche nach Verzeichnissen eh vollständig durchsucht wird.
   Die Funktion MatchesMask() wird zur Auswahl der Dateien genutzt
   TODO: MatchesMask und somit Unit Masks ersetzen
 - "gebündelte Events" (s.u.) natürlich auch bei synchroner Ausführung
 - Duration: simple Laufzeitanalyse per GetTickCount

 >>>>>>>>>>>>>>>>>>         Asynchrone Ausführung        <<<<<<<<<<<<<<<<<<<<<<<
    -> FindAsync(RootFolder: string; SyncEvents: Boolean = True)
    - Abbruch von außen mit TFindFiles.Abort;
    - an/abwählbarer Synchronisierung von den OnFindFolder/OnFindFile/OnFolderUp
      über optionalen Parameter "SyncEvents"
      (Standard "True" -> Events werden mit dem VCL-MainThread synchronisiert
      Abschaltbar um z.b. VCL-unabhängig eine TStringList zu füllen
    - Stets synchronisierte Events "OnBeginScan" und "OnEndScan" um
      beispielsweise eine (asynchron) erstellte Stringliste in ein VCL-Objekt
      (z.B.TMemo) zu übernehmen bzw. Begin-/EndUpdate von TStrings zu nutzen
    - Ohne genauere Analyse habe ich das Setzen der Events und der Maske
      während der asynchronen Ausführung erstmal per TryLock verhindert.
      TODO: Konzept überprüfen, ggf. parallele Aufrufe ermöglichen
    - gebündelte Events: OnFindFiles() und OnFindFolders() (Plural!):
       - Unabhängig vom Flag "SyncEvents" werden diese Events immer
         synchronisiert ausgeführt da die sinnvolle Auswertung sowieso nur
         "threadsicher" möglich ist.
       - Hier werden maximal <MaxEventListSize> Dateien/Verzeichnisse gesammelt
         und dann einmalig in OnFindFiles/OnFindFolders zur Verfügung gestellt,
         d.h. es stehen immer die seit dem letzten Event hinzugekommenen Daten
         zur Verfügung ("FFiles.Clear" nach OnFindFiles).
         MaxEventListSize = 128 scheint auf meinem Rechner praktikabel.
         MaxEventListSize <= 0 setzt die Länge auf Classes.MaxListSize
       - In diesen Events stehen keine erweiterten Daten
         (TWin32FindData) zur Verfügung.

  TODO: Sinn/Unsinn der Exceptions prüfen
  TODO: ggf. Kommentare / Dokumentation / Beispielprojekt
*)

interface

uses
  Windows, Classes, SysUtils, Masks;

type
  TFindFiles = class;

  //Events für einzelne Dateien/Verzeichnisse
  TFindFileEvent = procedure(Filename: string; const  Info: TWin32FindData;
    var Cancel: Boolean) of object;
  TFindFolderEvent = procedure(Folder: string; const Info: TWin32FindData;
    var Cancel: Boolean; var SkipFolder: Boolean) of object;

  //Gebündelte Events
  TFindFilesEvent = procedure(Filenames: TStrings;
    var Cancel: Boolean) of object;
  TFindFoldersEvent = procedure(Folders: TStrings;
    var Cancel: Boolean) of object;

  TFolderUpEvent = procedure(FromFolder, ToFolder: string;
    var Cancel: Boolean) of object;
  TEndScanEvent = procedure(Sender: TFindFiles; const Canceled: Boolean) of object;
  TBeginScanEvent = procedure(Sender: TFindFiles) of object;


  TFindFilesThread = class(TThread)
  private
    FParent: TFindFiles;
  protected
    procedure Execute; override;
  public
    constructor Create(Parent: TFindFiles);
  end;

  TFindFiles = class
  private
    FLock: TRTLCriticalSection;
    FScanSubFolders: Boolean;
    FMask: string;
    FRootFolder: string;
    FThread: TFindFilesThread;
    FOnFindFile: TFindFileEvent;
    FOnFindFolder: TFindFolderEvent;
    FOnFolderUp: TFolderUpEvent;
    FCancel: Boolean;
    FSkipDir: Boolean;
    FAsync: Boolean;
    FSyncEvents: Boolean;
    FOnBeginScan: TBeginScanEvent;
    FOnEndScan: TEndScanEvent;
    FFromFolder: string;
    FToFolder: string;
    FFilename: string;
    FFiles: TStringList;
    FFolders: TStringList;
    FFindData: TWin32FindData;
    FOnFindFolders: TFindFoldersEvent;
    FOnFindFiles: TFindFilesEvent;
    FMaxEventListSize: Integer;
    FDuration: Cardinal;
    FTicks: Cardinal;
    procedure SetOnBeginScan(const Value: TBeginScanEvent);
    procedure SetOnFolderUp(const Value: TFolderUpEvent);
    procedure SetOnEndScan(const Value: TEndScanEvent);
    procedure SetOnFindFolder(const Value: TFindFolderEvent);
    procedure SetOnFindFile(const Value: TFindFileEvent);
    procedure SetOnFindFolders(const Value: TFindFoldersEvent);
    procedure SetOnFindFiles(const Value: TFindFilesEvent);
    procedure SetMaxEventListSize(const Value: Integer);
    procedure SetEvent(var Event: TMethod; const Value: TMethod);
    procedure SetMask(const Value: string);
  protected
    procedure Search(RootFolder: string);
    procedure DoProc(Proc: TThreadMethod; ForceSync: Boolean);
    procedure Lock;
    function TryLock: Boolean;
    procedure Unlock;
    procedure AddDirToDirList;
    procedure AddFileToFileList;
    procedure DoFolderUp;
    procedure DoFindFile;
    procedure DoFindFolder;
    procedure DoFindFiles;
    procedure DoFindFolders;
    procedure DoEndScan;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Find(RootFolder: string);

    procedure FindAsync(RootFolder: string; SyncEvents: Boolean = True);
    procedure Abort;

    property ScanSubFolders: Boolean read FScanSubFolders write FScanSubFolders;
    property Mask: string read FMask write SetMask;

    property MaxEventListSize: Integer read FMaxEventListSize write SetMaxEventListSize;
    property Duration: Cardinal read FDuration;

    property OnBeginScan: TBeginScanEvent read FOnBeginScan write SetOnBeginScan;
    property OnEndScan: TEndScanEvent read FOnEndScan write SetOnEndScan;
    property OnFindFile: TFindFileEvent read FOnFindFile write SetOnFindFile;
    property OnFindFolder: TFindFolderEvent read FOnFindFolder write SetOnFindFolder;
    property OnFindFiles: TFindFilesEvent read FOnFindFiles write SetOnFindFiles;
    property OnFindFolders: TFindFoldersEvent read FOnFindFolders write SetOnFindFolders;
    property OnFolderUp: TFolderUpEvent read FOnFolderUp write SetOnFolderUp;
  end;

implementation

{ TFindFiles }

constructor TFindFiles.Create;
begin
  inherited Create;
  InitializeCriticalSection(FLock);
  FScanSubfolders := False;
  FFolders := TStringList.Create;
  FFiles := TStringList.Create;
  FMaxEventListSize := -1;
  FMask := '*.*';
end;

procedure TFindFiles.Search(RootFolder: string);
var
  wfd: TWin32FindData;
  hFile: THandle;
begin
  if not FCancel then
  begin
    hFile := FindFirstFile(PChar(RootFolder + '*'), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if (wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) then
        begin // Verzeichnisse
          if (wfd.cFileName[0] <> '.') then
          begin
            FSkipDir := False;
            FFindData := wfd;
            FFilename := RootFolder + wfd.cFileName;
            DoProc(DoFindFolder, False);
            AddDirToDirList;
            if FScanSubFolders and not FCancel and not FSkipDir then
            begin
              Search(RootFolder + wfd.cFileName + '\');
              FFromFolder := RootFolder + wfd.cFileName + '\';
              FToFolder := RootFolder;
              DoProc(DoFolderUp, False);
            end;
          end
        end else
        begin // Dateien
          if Assigned(FOnFindFile) or Assigned(FOnFindFiles) and
            MatchesMask(wfd.cFileName, FMask) then
          begin
            FFilename := RootFolder + wfd.cFileName;
            FFindData := wfd;
            DoProc(DoFindFile, False);
            AddFileToFileList;
          end;
        end;
      until FCancel or not FindNextFile(hFile, wfd);
    finally
      Windows.FindClose(hFile);
    end;
  end;
end;

procedure TFindFiles.Find(RootFolder: string);
begin
  if not DirectoryExists(RootFolder) then
    raise Exception.Create(
      'TFindFiles.Find: Verzeichnis "' + RootFolder + '" existiert nicht!');
  if TryLock then //sicherstellen das Thread nicht mehr läuft
  begin
    try
      FTicks := GetTickCount;
      FDuration := 0;
      FCancel := False;
      FAsync := False;
      FSyncEvents := False;
      FRootFolder := IncludeTrailingPathDelimiter(RootFolder);
      FFolders.Clear;
      FFiles.Clear;

      if Assigned(FOnBeginScan) then
        FOnBeginScan(Self);
      try
        Search(FRootFolder);

        //ggf. Listenreste ausgeben
        if FFolders.Count > 0 then
          DoFindFolders;
        if FFiles.Count > 0 then
          DoFindFiles;

        FDuration := GetTickCount - FTicks;
      finally
        if Assigned(FOnEndScan) then
          FOnEndScan(Self, FCancel);
      end;
    finally
      Unlock;
    end;
  end else
    raise Exception.Create(
      'TFindFiles.Find() darf nicht während der Suche aufgerufen werden');
end;

procedure TFindFiles.FindAsync(RootFolder: string; SyncEvents: Boolean = True);
begin
  if not DirectoryExists(RootFolder) then
    raise Exception.Create(
      'TFindFiles.FindAsync: Verzeichnis "' + RootFolder + '" existiert nicht!');
  if TryLock then
  begin
    try
      FTicks := GetTickCount;
      FDuration := 0;
      FCancel := False;
      FAsync := True;
      FSyncEvents := SyncEvents;
      FRootFolder := IncludeTrailingPathDelimiter(RootFolder);
      FFolders.Clear;
      FFiles.Clear;
      if Assigned(FOnBeginScan) then
        FOnBeginScan(Self);
      if Assigned(FThread) then
        FThread.Free; //Versuch FThread.Resume schlägt fehl?! Wohl kein "Neustart" mgl.
      FThread := TFindFilesThread.Create(Self);
    finally
      Unlock;
    end;
  end else
    raise Exception.Create(
      'TFindFiles.FindAsync() darf nicht während der Suche aufgerufen werden');
end;

procedure TFindFiles.Lock;
begin
  EnterCriticalSection(FLock);
end;

procedure TFindFiles.Unlock;
begin
  LeaveCriticalSection(FLock);
end;

destructor TFindFiles.Destroy;
begin
  if Assigned(FThread) then
  begin
    if not FThread.Terminated then
    begin
      FCancel := True;
      FThread.WaitFor;
    end;
    FThread.Free;
    FThread := nil;
  end;
  FFiles.Free;
  FFolders.Free;
  DeleteCriticalSection(FLock);
  inherited Destroy;
end;

procedure TFindFiles.SetOnBeginScan(const Value: TBeginScanEvent);
begin
  SetEvent(TMethod(FOnBeginScan), TMethod(Value));
end;

procedure TFindFiles.SetOnFolderUp(const Value: TFolderUpEvent);
begin
  SetEvent(TMethod(FOnFolderUp), TMethod(Value));
end;

procedure TFindFiles.SetOnEndScan(const Value: TEndScanEvent);
begin
  SetEvent(TMethod(FOnEndScan), TMethod(Value));
end;

procedure TFindFiles.SetOnFindFolder(const Value: TFindFolderEvent);
begin
  SetEvent(TMethod(FOnFindFolder), TMethod(Value));
end;

procedure TFindFiles.SetOnFindFile(const Value: TFindFileEvent);
begin
  SetEvent(TMethod(FOnFindFile), TMethod(Value));
end;

procedure TFindFiles.SetOnFindFolders(const Value: TFindFoldersEvent);
begin
  SetEvent(TMethod(FOnFindFolders), TMethod(Value));
end;

procedure TFindFiles.SetOnFindFiles(const Value: TFindFilesEvent);
begin
  SetEvent(TMethod(FOnFindFiles), TMethod(Value));
end;

procedure TFindFiles.DoProc(Proc: TThreadMethod; ForceSync: Boolean);
begin
  if FAsync and (FSyncEvents or ForceSync) then
    FThread.Synchronize(Proc)
  else
    Proc;
end;

procedure TFindFiles.DoFolderUp;
begin
  if Assigned(FOnFolderUp) then
    FOnFolderUp(FFromFolder, FToFolder, FCancel);
end;

procedure TFindFiles.DoEndScan;
begin
  if Assigned(FOnEndScan) then
    FOnEndScan(Self, FCancel);
end;

procedure TFindFiles.DoFindFolder;
begin
  if Assigned(FOnFindFolder) then
    FOnFindFolder(FFilename, FFindData, FCancel, FSkipDir);
end;

procedure TFindFiles.DoFindFile;
begin
  if Assigned(FOnFindFile) then
    FOnFindFile(FFilename, FFindData, FCancel);
end;

procedure TFindFiles.AddDirToDirList;
begin
  if Assigned(FOnFindFolders) then
  begin
    FFolders.Add(FFilename);
    if FFolders.Count >= FMaxEventListSize then
    begin
      DoProc(DoFindFolders, True);
      FFolders.Clear;
    end;
  end;
end;

procedure TFindFiles.AddFileToFileList;
begin
  if Assigned(FOnFindFiles) then
  begin
    FFiles.Add(FFilename);
    if FFiles.Count >= FMaxEventListSize then
    begin
      DoProc(DoFindFiles, True);
      FFiles.Clear;
    end;
  end;
end;

procedure TFindFiles.DoFindFolders;
begin
  if Assigned(FOnFindFolders) then
    FOnFindFolders(FFolders, FCancel);
end;

procedure TFindFiles.DoFindFiles;
begin
  if Assigned(FOnFindFiles) then
    FOnFindFiles(FFiles, FCancel);
end;

procedure TFindFiles.SetMaxEventListSize(const Value: Integer);
begin
  if (Value > 0) and (Value <= MaxListSize) then
    InterlockedExchange(FMaxEventListSize, Value)
  else
    InterlockedExchange(FMaxEventListSize, MaxListSize);
end;

procedure TFindFiles.SetEvent(var Event: TMethod; const Value: TMethod);
begin
  if TryLock then
  begin
    try
      Event := Value;
    finally
      UnLock;
    end;
  end else
    raise Exception.Create(
      'TFindFiles: Events können nicht während der Suche zugewiesen werden');
end;

function TFindFiles.TryLock: Boolean;
begin
  Result := TryEnterCriticalSection(FLock);
end;

procedure TFindFiles.Abort;
begin
  FCancel := True;
end;

procedure TFindFiles.SetMask(const Value: string);
begin
  if TryLock then
  begin
    try
      FMask := Value;
    finally
      UnLock;
    end;
  end else
    raise Exception.Create(
      'TFindFiles: Maske kann nicht während der Suche verändert werden');
end;

{ TFindFilesThread }

constructor TFindFilesThread.Create(Parent: TFindFiles);
begin
  inherited Create(True);
  FParent := Parent;
  Resume;
end;

procedure TFindFilesThread.Execute;
begin
  FParent.Lock;
  try
    FParent.Search(FParent.FRootFolder);
    if FParent.FFolders.Count > 0 then
      Synchronize(FParent.DoFindFolders);
    if FParent.FFiles.Count > 0 then
      Synchronize(FParent.DoFindFiles);
    FParent.FDuration := GetTickCount - FParent.FTicks;
  finally
    Synchronize(FParent.DoEndScan);
    FParent.Unlock;
  end;
end;

end.

[Luckie]

Zitat:

Zitat von Tryer

- SysUtils eingebunden für Exception / DirectoryExists
TODO: ggf. Funktionen anderweitig implementieren/ersetzen

Genau das wollte ich vermeiden, weil ich die Klasse in einem nonVCL Projekt benötigt habe. Die Units SysUtils und Classes machen die Exe dann doch erheblich größer.

[himitsu]

Abgesehn davon, daß man kein DirectoryExists benötigt ... wozu auch, wenn das auch FindFirst/FindFirstFile supergut erledigt?

Der Code in Beitrag #5 wurde jetzt aber noch um eine kleine Fehlerbehandlung/-rückmeldung erweitert.
(die #19 hatte ich gestern schon still und heimlich mit reingemacht und die #20 sollte auch beachtet worden sein)

[Luckie]

Ich glaube, wir brauchen hier ein Repository. Ich habe nämlich gestern Abend auch noch was geändert:

Delphi-Quellcode:

// FindFiles - Klasse zum Durchsuchen von Ordnern
// Michael Puff [[url]http://www.michael-puff.de][/url], himitsu, omata

unit MpuFindFilesCls;

interface

uses
  Windows;

type
  TOnFindFile = procedure(Filename: string; const Info: TWin32FindData; var Cancel: Boolean) of object;
  TOnFindDirectory = procedure(Directory: string; const Info: TWin32FindData; var Cancel: Boolean; var IgnoreDirectory: Boolean) of object;
  TOnDirectoryUp = procedure(FromDirectory, ToDirectory: string; var Cancel: Boolean) of object;
  TFindFiles = class(TObject)
  private
    FSubfolders: Boolean;
    FMask: string;
    FCancel: Boolean;
    FOnFindFile: TOnFindFile;
    FOnFindDirectory: TOnFindDirectory;
    FOnDirectoryUp: TOnDirectoryUp;
    function DirectoryExists(const Directory: string): Boolean;
    procedure Search(RootFolder: string);
  public
    constructor Create;
    procedure Find(RootFolder: string);
    property SubFolders: Boolean read FSubFolders write FSubFolders;
    property Mask: string read FMask write FMask;
    property OnFindFile: TOnFindFile read FOnFindFile write FOnFindFile;
    property OnFindDirectory: TOnFindDirectory read FOnFindDirectory write FOnFindDirectory;
    property OnDirectoryUp: TOnDirectoryUp read FOnDirectoryUp write FOnDirectoryUp;
  end;

type
  Exception = class(TObject)
  private
    FMsg: string;
    class function SysErrorMessage(ErrorCode: Integer): string;
  public
    constructor Create(Msg: string);
    property Msg: string read FMsg;
  end;

implementation

{ TFindFiles }

constructor TFindFiles.Create;
begin
  inherited;
  FSubfolders := False;
  FMask := '*.*';
end;

procedure TFindFiles.Search(RootFolder: string);
var
  wfd: TWin32FindData;
  hFile: THandle;
  Ignore: Boolean;
begin
  if (RootFolder <> '') and (RootFolder[Length(RootFolder)] <> '\') then
    RootFolder := RootFolder + '\';
  if not FCancel and FSubFolders then
  begin
    hFile := FindFirstFile(PChar(RootFolder + '*.*'), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
          if (string(wfd.cFileName) <> '.')
            and (string(wfd.cFileName) <> '..') then
          begin
            Ignore := False;
            if Assigned(FOnFindDirectory) then
              FOnFindDirectory(RootFolder + wfd.cFileName, wfd, FCancel, Ignore);
            if not FCancel and not Ignore then
              Find(RootFolder + wfd.cFileName + '\');
            if not FCancel and Assigned(FOnDirectoryUp) then
              FOnDirectoryUp(RootFolder + wfd.cFileName, RootFolder, FCancel);
          end;
      until FCancel or not FindNextFile(hFile, wfd);
    finally
      windows.FindClose(hFile);
    end;
  end;
  if not FCancel and Assigned(OnFindFile) then
  begin
    hFile := FindFirstFile(PChar(RootFolder + FMask), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    try
      repeat
        if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
          OnFindFile(RootFolder + wfd.cFileName, wfd, FCancel);
      until FCancel or not FindNextFile(hFile, wfd);
    finally
      Windows.FindClose(hFile);
    end;
  end;
end;

procedure TFindFiles.Find(RootFolder: string);
begin
  if not DirectoryExists(RootFolder) then
  begin
    raise Exception.Create(Exception.SysErrorMessage(GetLastError));
  end;
  FCancel := False;
  Search(RootFolder);
end;

function TFindFiles.DirectoryExists(const Directory: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Directory));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

{ Exception }

constructor Exception.Create(Msg: string);
begin
  FMsg := Msg;
end;

class function Exception.SysErrorMessage(ErrorCode: Integer): string;
var
  Len: Integer;
  Buffer: array[0..255] of Char;
begin
  Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
    FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer,
    SizeOf(Buffer), nil);
  while (Len > 0) and (Buffer[Len - 1] in [#0..#32, '.']) do
    Dec(Len);
  SetString(Result, Buffer, Len);
end;

end.

Neu ist die Exception Klasse.

@himitsu: Es wäre schön, wenn du Änderungen markieren oder erwähnen würdest, dann würde man das schneller sehen. ;)

[himitsu]

Die letzen Änderungen waren (wenn ich mich richtig erinnere):

das IgnoreDirectory von NormanNG

Daniels Doku-Wunsch

Delphi-Quellcode:

// Cancel           > bricht den gesamten Suchvorgang ab
// IgnoreDirectory  > überspringt das Auslesen dieses Verzeichnisses
//                      und aller seiner Unterverzeichnisse
// Errors (HRESULT) > NO_ERROR = S_OK      = 0
//                  > ERROR_FILE_NOT_FOUND = 2 > The system cannot find the file specified.
//                  > ERROR_PATH_NOT_FOUND = 3 > The system cannot find the path specified.
//                  > ERROR_NO_MORE_FILES = 18 > The user set "Cancel" in the callback to TRUE.

ein etwas kürzerer Aufruf
und ein paar Prüffunktionen des neuen Rpckgabewertes

Delphi-Quellcode:

class function FindEx(RootFolder, Mask: string; SubFolders: Boolean; OnFindFile: TOnFindFile;
  OnFindDirectory: TOnFindDirectory = nil; OnDirectoryUp: TOnDirectoryUp = nil): HRESULT;
class function isOK(E: HRESULT): Boolean;
class function GetErrorStr(E: HRESULT): String;

Die Fehlerprüfung, bzw. Fehlerrückgabe als Result
> siehe alle Zeilen mit Result, Error, GetLastError in .Search
und eine zugehörige Auswertung in .Find,
wozu auch das neue Feld FFound gehört

Delphi-Quellcode:

function TFindFiles.Find(RootFolder: string): HRESULT;
begin
  FFound := False;
  FCancel := False;
  Result := Search(RootFolder);
  if (Result = NO_ERROR) and not FFound then Result := ERROR_FILE_NOT_FOUND;
  if FCancel then Result := ERROR_NO_MORE_FILES;
end;

[edit]
noch schnell ein DecodeFiletime verbaut, da viele mit TFileTime ja nicht viel anfangen können.
DecodeFiletime

Delphi-Quellcode:

class function DecodeFiletime(const FileTime: TFileTime): TDateTime;

[Luckie]

Ich werde mal gucken, ob ich deine Fehlerbehandlung bei mir einbaue. Aber ich werde dann eine Exception werfen. Jetzt kommt aber erst mal Snooker. :P

[himitsu]

In dem Suchthread eine Exception zu werfen ... ist das nicht etwas unsinnig?


Abgesehn davon, wenn du noch im Hauptthread prüfen könntest, ob das Root-Verzeichnis existiert und da schon um dich wirfst, aber die anderen "Fehler", wie "nix gefunden" und "Userabbruch" kannste natürlich nicht werfen.

PS: Du solltest mal selber spielen.

PSS: Ohne die Exceptionbehandlung, von z.B. der SysUtils, bringt es doch garnichts, wenn man mit Exceptions um sich wirft, welche ja keiner versteht/auswertet.

ich handhabe es daher so:
> entweder Exceptions werfen und die SysUtils einbinden
> oder keine Exceptions (Fehler über System.Error auslösen oder nur als Fehlercode zurückgeben)

[Luckie]

Ich kann meine Exception genauso mit try-except abfangen wie andere auch.

[himitsu]

Du nutzt aber ein eigenes Exceptionobjekt, welches z.B. die Exceptionbehandlung von Delphi nicht kennt.

Sowas macht sich etwas blöd, wenn dann im Programm dennoch die SysUtils eingebunden wurde.

[Luckie]

Meine aktuelle Version:

Delphi-Quellcode:

// FindFiles - Klasse zum Durchsuchen von Ordnern
// Michael Puff [[url]http://www.michael-puff.de][/url], himitsu, omata

unit MpuFindFilesCls;

interface

uses
  Windows;

type
  TOnFindFile = procedure(Filename: string; const Info: TWin32FindData; var Cancel: Boolean) of object;
  TOnFindDirectory = procedure(Directory: string; const Info: TWin32FindData; var Cancel: Boolean; var IgnoreDirectory: Boolean) of object;
  TOnDirectoryUp = procedure(FromDirectory, ToDirectory: string; var Cancel: Boolean) of object;
  TFindFiles = class(TObject)
  private
    FSubfolders: Boolean;
    FMask: string;
    FCountFiles: Cardinal;
    FCountDirectories: Cardinal;
    FCancel: Boolean;
    FOnFindFile: TOnFindFile;
    FOnFindDirectory: TOnFindDirectory;
    FOnDirectoryUp: TOnDirectoryUp;
    procedure Search(RootFolder: string);
  public
    constructor Create;
    procedure Find(RootFolder: string);
    property SubFolders: Boolean read FSubFolders write FSubFolders;
    property Mask: string read FMask write FMask;
    property CountFiles: Cardinal read FCountFiles;
    property CountDirectories: Cardinal read FCountDirectories;
    property OnFindFile: TOnFindFile read FOnFindFile write FOnFindFile;
    property OnFindDirectory: TOnFindDirectory read FOnFindDirectory write FOnFindDirectory;
    property OnDirectoryUp: TOnDirectoryUp read FOnDirectoryUp write FOnDirectoryUp;
  end;

type
  Exception = class(TObject)
  private
    FMsg: string;
    class function SysErrorMessage(ErrorCode: Integer): string;
  public
    constructor Create(Msg: string);
    property Msg: string read FMsg;
  end;

  EFindFiles = class(Exception)
  public
    constructor Create(Msg: string);
  end;


implementation

{ TFindFiles }

constructor TFindFiles.Create;
begin
  inherited;
  FSubfolders := False;
  FMask := '*.*';
  FCountFiles := 0;
  FCountDirectories := 0;
end;

procedure TFindFiles.Search(RootFolder: string);
var
  wfd: TWin32FindData;
  hFile: THandle;
  Ignore: Boolean;
begin
  if (RootFolder <> '') and (RootFolder[Length(RootFolder)] <> '\') then
    RootFolder := RootFolder + '\';
  if not FCancel and FSubFolders then
  begin
    hFile := FindFirstFile(PChar(RootFolder + '*.*'), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    begin
      try
        repeat
          if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then
            if (string(wfd.cFileName) <> '.') and (string(wfd.cFileName) <> '..') then
            begin
              Inc(FCountDirectories);
              Ignore := False;
              if Assigned(FOnFindDirectory) then
                FOnFindDirectory(RootFolder + wfd.cFileName, wfd, FCancel, Ignore);
              if not FCancel and not Ignore then
                Find(RootFolder + wfd.cFileName + '\');
              if not FCancel and Assigned(FOnDirectoryUp) then
                FOnDirectoryUp(RootFolder + wfd.cFileName, RootFolder, FCancel);
            end;
        until FCancel or not FindNextFile(hFile, wfd);
      finally
        windows.FindClose(hFile);
      end;
    end
    else
    begin
      raise EFindFiles.Create(Exception.SysErrorMessage(GetLastError));
    end;
  end;
  if not FCancel and Assigned(OnFindFile) then
  begin
    hFile := FindFirstFile(PChar(RootFolder + FMask), wfd);
    if hFile <> INVALID_HANDLE_VALUE then
    begin
      try
        repeat
          Inc(FCountFiles);
          if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
            OnFindFile(RootFolder + wfd.cFileName, wfd, FCancel);
        until FCancel or not FindNextFile(hFile, wfd);
      finally
        Windows.FindClose(hFile);
      end;
    end
    else
    begin
      if GetLastError <> ERROR_FILE_NOT_FOUND then
        raise EFindFiles.Create(Exception.SysErrorMessage(GetLastError));
    end;
  end;
end;

procedure TFindFiles.Find(RootFolder: string);
begin
  FCancel := False;
  Search(RootFolder);
end;

{ Exception }

constructor Exception.Create(Msg: string);
begin
  FMsg := Msg;
end;

class function Exception.SysErrorMessage(ErrorCode: Integer): string;
var
  Len: Integer;
  Buffer: array[0..255] of Char;
begin
  Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
    FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer,
    SizeOf(Buffer), nil);
  while (Len > 0) and (Buffer[Len - 1] in [#0..#32, '.']) do
    Dec(Len);
  SetString(Result, Buffer, Len);
end;

{ EFindFiles }

constructor EFindFiles.Create(Msg: string);
begin
  inherited Create(Msg);
end;

end.

Allerdings lässt er bei mir einen ganzen Ordner aus. Und zwar den Ordner D:\Programmierung\Delphi\Programme er wird zwar aufgelistet, dann springt er aber nicht in den Ordner und listet dessen Unterordner aus. Der Ordner unterscheidet sich nicht von den anderen Ordnern.

Code:

D:\Programmierung\Delphi\Komponenten
D:\Programmierung\Delphi\Komponenten\DEC
D:\Programmierung\Delphi\Komponenten\DEC\Archive
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D5
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D5\DECTest
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D5\Demo
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D5\Factorial
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D6
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D6\DECTest
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D6\Demo
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D6\Factorial
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D7
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D7\DECTest
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D7\Demo
D:\Programmierung\Delphi\Komponenten\DEC\Archive\D7\Factorial
D:\Programmierung\Delphi\Komponenten\DEC\Archive\Part_II
D:\Programmierung\Delphi\Komponenten\DEC\Archive\Part_II\LibIntf
D:\Programmierung\Delphi\Komponenten\DEC\Part_I
D:\Programmierung\Delphi\Komponenten\DEC\Part_I\DECTest
D:\Programmierung\Delphi\Programme
D:\Programmierung\Delphi\Sonstiges
D:\Programmierung\Delphi\Template
D:\Programmierung\Delphi\Template\Dialog
D:\Programmierung\Delphi\Template\Dialog\source
D:\Programmierung\Delphi\Template\Dialog\source\includes
D:\Programmierung\Delphi\Template\Dialog\source\res
D:\Programmierung\Delphi\Template\Dialog\source\__history
D:\Programmierung\Delphi\Template\Dialog\source\~dcu
D:\Programmierung\Delphi\Template\Window
D:\Programmierung\Delphi\Template\Window\source
D:\Programmierung\Delphi\Template\Window\source\res
D:\Programmierung\Delphi\Template\Window\source\units
D:\Programmierung\Delphi\Template\Window\source\~dcu
D:\Programmierung\Delphi\Tutorials
D:\Programmierung\Delphi\Tutorials\COM
D:\Programmierung\Delphi\Tutorials\COM\Demos

[DeddyH]

Müssten nicht in der Find-Methode FCountFiles und FCountDirectories wieder auf 0 gesetzt werden?

[Luckie]

Ja, sollte man machen, hat aber nichts mit dem Problem zu tun.

[DeddyH]

*Huch* da stand ja noch was drunter, ich hatte nur den Code gelesen. Tja, da hab ich auch keine Idee dazu, außer durchdebuggen.

[mkinzler]

Zitat:

Zitat von Luckie

Ja, sollte man machen, hat aber nichts mit dem Problem zu tun.

Ist aber ein Verbesserungsvorschlag, en man vor Aufnahme in die CL einpflegen sollte :zwinker:

[himitsu]

Dein CountFiles, CountDirectories und dazu noch das Property Cancel hab ich in den Beitrag #5 mit eingepflegt.

Aber ich wüßte auch nicht, warum dein eines Verzeichnis übersprungen werden sollte. :gruebel:
Der Code aus Beitrag #5 ließtet dieses doch bestimmt auch nicht auf?


PS: mir ist noch eine Änderung eingefallen, welche ich gemacht hatte.
Ich hatte mal die Property und Funktionen in der Klassendefinition so angeordnet, in welcher Reihenfolge man diese nutzen würde.
> Suchparameter setzen und Callbacks angeben
> Suchen
> Rückgabewerte auslesen/auswerten

[Luckie]

Man könnte die Zähler noch an die Ereignisse übergeben. Dann kann man "live" mitzählen.

[DeddyH]

Das könnte man zur Not aber auch "von außen", indem man mitzählt, wie oft die Events ausgelöst werden.

[himitsu]

Zitat:

Zitat von Luckie

Man könnte die Zähler noch an die Ereignisse übergeben. Dann kann man "live" mitzählen.

Statt die beiden Zähler bau ich mal schnell in der Fünf noch einen "Sender" ein. :-D

Und wie ist das nun mit dem Programme-Verzeichnis? Wird es da nun gefunden oder auch nicht?
PS: Mal debuggen und schauen was bei/nach Auffinden dieses Verzeichnisses passiert.

[Luckie]

Zitat:

Zitat von DeddyH

Das könnte man zur Not aber auch "von außen", indem man mitzählt, wie oft die Events ausgelöst werden.

Dann braucht man aber eine globale Variable

Zitat:

Zitat von himitsu

Zitat:

Zitat von Luckie

Man könnte die Zähler noch an die Ereignisse übergeben. Dann kann man "live" mitzählen.

Statt die beiden Zähler bau ich mal schnell in der Fünf noch einen "Sender" ein. :-D

Wie kann man jetzt mit Hilfe des Senders zählen?

Zitat:

Und wie ist das nun mit dem Programme-Verzeichnis? Wird es da nun gefunden oder auch nicht?
PS: Mal debuggen und schauen was bei/nach Auffinden dieses Verzeichnisses passiert.

Ich habe mich noch nicht drum gekümmert. Habe ein Nickerchen gehalten. ;)

[himitsu]

Zitat:

Zitat von Luckie

Zitat:

Zitat von DeddyH

Das könnte man zur Not aber auch "von außen", indem man mitzählt, wie oft die Events ausgelöst werden.

Dann braucht man aber eine globale Variable

Nicht unbedingt.
Sowas würde auch in das Objekt reinpassen, in welchem die aufgerufene Methode liegt. :stupid: