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: