Klasse für FindFirstFile/FindNextFile

[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.

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.
(auch wenn man ja eh keine relativen Pfade verwenden soll )

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.