Klasse für FindFirstFile/FindNextFile

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

[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