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

unit MpuFindFilesCls;

interface

uses
  Windows;

type
  TOnFindFile = procedure(Filename: string; CountFiles: Cardinal; const Info: TWin32FindData; var Cancel: Boolean) of object;
  TOnFindDirectory = procedure(Directory: string; CountDirectories: Cardinal; Level: Cardinal; 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;
    FLevel: 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);
              Inc(FLevel);
              Ignore := False;
              if Assigned(FOnFindDirectory) then
                FOnFindDirectory(RootFolder + wfd.cFileName, FCountDirectories, FLevel, wfd, FCancel, Ignore);
              if not FCancel and not Ignore then
                Search(RootFolder + wfd.cFileName + '\');
              if not FCancel and Assigned(FOnDirectoryUp) then
              begin
                FOnDirectoryUp(RootFolder + wfd.cFileName, RootFolder, FCancel);
              end;
              Dec(FLevel);
            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, FCountFiles, 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;
  FCountFiles := 0;
  FCountDirectories := 0;
  FLevel := 0;
  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.