type art = (UnterOrdner, Dateien, beides); 
 
procedure findDatei(pfad, maske: string; was: art; gefunden: TStrings); 
var sr: TWin32FindData; 
  h: THandle; 
begin 
  h := FindFirstFile(PChar(pfad + maske), sr); 
  if h <> INVALID_HANDLE_VALUE then repeat 
      if sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin 
        if was = Dateien then gefunden.add(sr.cFileName) 
        else gefunden.add(pfad + sr.cFileName); 
      end; 
    until Findnextfile(h, sr) = false; 
  windows.FindClose(h); 
end; 
 
procedure findDir(pfad, maske: string; was: art; Tiefer: boolean; gefunden: 
  TStrings); 
var sr: TWin32FindData; 
  h: THandle; 
  omask: string; 
begin 
  if ansilastchar(pfad) <> '\' then pfad := pfad + '\'; 
  if was <> UnterOrdner then begin 
    findDatei(pfad, maske, was, gefunden); 
    if not Tiefer then exit; 
    omask := '*.*'; 
  end else omask := maske; 
  h := FindFirstFile(PChar(pfad + omask), sr); 
  if h <> INVALID_HANDLE_VALUE then repeat 
      if (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0) 
        and (string(sr.cFileName) <> '.') and (string(sr.cFileName) <> '..') 
          then begin 
        if was = UnterOrdner then gefunden.add(pfad + sr.cFileName); 
        if Tiefer then 
          findDir(pfad + sr.cFileName, maske, was, true, gefunden); 
      end; 
    until Findnextfile(h, sr) = false; 
  windows.FindClose(h); 
end; 
 
// Bitmaps in einem speziellen Ordner finden 
// und in einem TRichedit anzeigen. 
procedure TForm1.Button2Click(Sender: TObject); 
var sl: TStringlist; 
begin 
  screen.cursor := crHourGlass; 
  Button2.enabled := false; 
  sl := TStringlist.create; 
  findDir('d:\Bilder', '*.bmp', Dateien, false, sl); 
  sl.sort; 
  Richedit1.lines := sl; 
  sl.free; 
  Button2.enabled := true; 
  screen.cursor := crDefault; 
end; 
 
// Alle Unterordner von H: auffinden, 
// die an zweiter Stelle ein "e" haben. 
// Die Anzeige erfolgt in einem Memo. 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  Button6.enabled := false; 
  findDir('H:\', '?E*.*', UnterOrdner, true, Memo1.lines); 
  Button6.enabled := true; 
end; 
 
// Alle *.DLL in C:\ mit komplettem Pfad anzeigen 
procedure TForm1.Button7Click(Sender: TObject); 
var sl: TStringlist; 
begin 
  screen.cursor := crHourGlass; 
  Button7.enabled := false; 
  sl := TStringlist.create; 
  findDir('c:\', '*.dll', beides, true, sl); 
  sl.sort; 
  Richedit1.lines := sl; 
  sl.free; 
  Button7.enabled := true; 
  screen.cursor := crDefault; 
end; 
 
//--------------------------------------------------------- 
 
// 2. Eine einzelne Datei suchen 
 
// Es wird eine Datei (auf Wunsch auf mehreren Laufwerken) gesucht. 
// Dabei kann der gerade durchsuchte Pfad in einem Label 
// mit bestimmbarer Breite (in Pixeln) angezeigt werden. 
// Die Suche kann bei zu langer Dauer abgebrochen werden. 
 
var abbruch: boolean; 
 
function suchdatei(pfad, datei: string): string; 
var sr: TSearchRec; 
begin 
  result := ''; 
  if findfirst(pfad + '*.*', $27, sr) = 0 then begin 
    repeat 
      if ansilowercase(sr.name) = ansilowercase(datei) then begin 
        result := pfad + datei; 
        break; 
      end; 
    until findnext(sr) <> 0; 
    FindClose(Sr); 
  end; 
end; 
 
function finden(start, datei: string; lbl: TLabel; breite: integer): string; 
var sr: TSearchRec; 
begin 
  if ansilastchar(start) <> '\' 
    then start := start + '\'; 
  if (lbl <> nil) and (not abbruch) then 
    lbl.caption := minimizename(start, lbl.canvas, breite); 
  application.processmessages; // wichtig 
  result := suchdatei(start, datei); 
  if (result <> '') or abbruch then exit; 
  if findfirst(start + '*.*', faAnyfile, sr) = 0 then begin 
    repeat 
      if (sr.Attr and faDirectory > 0) and (sr.name[1] <> '.') then begin 
        result := finden(start + sr.name, datei, lbl, breite); 
        if (result <> '') or abbruch then break; 
      end; 
    until findnext(sr) <> 0; 
    FindClose(Sr); 
  end; 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  abbruch := true; 
end; 
 
// Aufruf mit mehreren Ordnern und Anzeige 
// des aktuellen Suchpfades in einem Label 
procedure TForm1.Button1Click(Sender: TObject); 
var Ergebnis, Datei, Verzeichnisse: string; 
  LabelBreite, x: integer; 
  sl: TStringlist; 
begin 
  Button1.enabled := false; 
  screen.cursor := crhourglass; 
  abbruch := false; 
  sl := TStringlist.create; 
  Verzeichnisse := 'F:, "C:\Eigene Dateien", D:, E:\Temp'; // keine Semikolons! 
  Datei := 'Project1.dsm'; 
  LabelBreite := 200; 
  sl.commatext := Verzeichnisse; 
  for x := 0 to sl.count - 1 do begin 
    Ergebnis := finden(sl.strings[x], Datei, Label1, LabelBreite); 
    if ergebnis <> '' then break; 
  end; 
  sl.free; 
  screen.cursor := crdefault; 
  Button1.enabled := true; 
  if abbruch then showmessage('Abgebrochen') else begin 
    if Ergebnis <> '' then showmessage(Ergebnis) 
    else showmessage('Nicht gefunden'); 
  end; 
end; 
 
// Aufruf mit einem Ordner und ohne Label 
procedure TForm1.Button2Click(Sender: TObject); 
var Ergebnis: string; 
begin 
  Button2.enabled := false; 
  screen.cursor := crhourglass; 
  abbruch := false; 
  Ergebnis := finden('C:\', 'Error.wav', nil, 0); 
  screen.cursor := crdefault; 
  Button2.enabled := true; 
  if Ergebnis <> '' then showmessage(Ergebnis) 
  else showmessage('Nicht gefunden'); 
end;