Rekursiv Suchen

[Sir Rufo]

Ich würde mir schon mal gar keine spezielle Routine dafür bauen, sondern eine generelle und diese dann verwenden. Dann wird auch der gesamte Code übersichtlicher.

Hier etwas zum Herumspielen

Delphi-Quellcode:

program Project1;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  SysUtils;

type
  TProcessFileCallback = procedure( const AFilename: string );

procedure ProcessFiles( const ADirectory, ASearchPattern: string; ACallback: TProcessFileCallback; AAttr: Integer = faAnyFile; ARecursive: Boolean = False );
var
  SearchRec: TSearchRec;
begin
  // Dateien suchen
  if FindFirst( IncludeTrailingPathDelimiter( ADirectory ) + ASearchPattern, AAttr, SearchRec ) = 0
  then
    try
      repeat
        ACallback( IncludeTrailingPathDelimiter( ADirectory ) + SearchRec.Name );
      until FindNext( SearchRec ) <> 0;
    finally
      FindClose( SearchRec );
    end;

  // Wenn rekursiv
  if ARecursive
  then // dann
    begin
      // Verzeichnisse suchen
      if FindFirst( IncludeTrailingPathDelimiter( ADirectory ) + '*.*', faDirectory, SearchRec ) = 0
      then
        try
          repeat
            if ( SearchRec.Name <> '.' ) and ( SearchRec.Name <> '..' )
            then
              ProcessFiles( IncludeTrailingPathDelimiter( ADirectory ) + SearchRec.Name, ASearchPattern, ACallback, AAttr, ARecursive );
          until FindNext( SearchRec ) <> 0;
        finally
          FindClose( SearchRec );
        end;
    end;
end;

procedure ProcessSomeFiles( const AFilename: string );
begin
  // Hier erledigen wir die eigentliche Arbeit
  WriteLn(AFilename);
end;

procedure Test;
begin
  WriteLn('=== STARTING ===');
  ProcessFiles( 'C:\Users', '*.png', ProcessSomeFiles, faAnyFile, True );
  WriteLn('=== FINISHED ===');
end;

begin
  try
    Test;
  except
    on E: Exception do
      Writeln( E.ClassName, ': ', E.Message );
  end;

end.