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.