AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Rekursiv Suchen

Ein Thema von GroZ · begonnen am 9. Nov 2015 · letzter Beitrag vom 11. Nov 2015
 
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#6

AW: Erneute Hilfe

  Alt 9. Nov 2015, 13:49
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.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:01 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz