Ищем файл рекурсивно

procedure GetAllFiles(mask: string); 
var 
  search: TSearchRec; 
  directory: string; 
begin 
  directory := ExtractFilePath(mask); 

  // find all files 
  if FindFirst(mask, $23, search) = 0 then 
  begin 
    repeat 
      // add the files to the listbox 
      Form1.ListBox1.Items.Add(directory + search.Name); 
      Inc(Count); 
    until FindNext(search) <> 0; 
  end; 

  // Subdirectories/ Unterverzeichnisse 
  if FindFirst(directory + '*.*', faDirectory, search) = 0 then 
  begin 
    repeat 
      if ((search.Attr and faDirectory) = faDirectory) and (search.Name[1] <> '.') then 
        GetAllFiles(directory + search.Name + '\' + ExtractFileName(mask)); 
    until FindNext(search) <> 0; 
    FindClose(search); 
  end; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
var 
  directory: string; 
  mask: string; 
begin 
  Count := 0; 
  Listbox1.Items.Clear; 

  directory := 'C:\temp\'; 
  mask := '*.*'; 

  Screen.Cursor := crHourGlass; 
  try 
    GetAllFiles(directory + mask); 
  finally 
    Screen.Cursor := crDefault; 
  end; 
  ShowMessage(IntToStr(Count) + ' Files found'); 
end; 


{**************************************} 
{ Code from P. Below: } 

// recursively scanning all drives 

  { excerpt from form declaration, form has a listbox1 for the 
    results, a label1 for progress, a button2 to start the scan, 
    an edit1 to get the search mask from, a button3 to stop 
    the scan. } 
  private 
    { Private declarations } 
    FScanAborted: Boolean; 

  public 
    { Public declarations } 
     
function ScanDrive(root, filemask: string; hitlist: TStrings): Boolean; 

implementation 

function TForm1.ScanDrive(root, filemask: string; hitlist: TStrings): Boolean; 
  function ScanDirectory(var path: string): Boolean; 
  var 
    SRec: TSearchRec; 
    pathlen: Integer; 
    res: Integer; 
  begin 
    label1.Caption := path; 
    pathlen := Length(path); 
    { first pass, files } 
    res := FindFirst(path + filemask, faAnyfile, SRec); 
    if res = 0 then 
      try 
        while res = 0 do  
        begin 
          hitlist.Add(path + SRec.Name); 
          res := FindNext(SRec); 
        end; 
      finally 
        FindClose(SRec) 
      end; 
    Application.ProcessMessages; 
    Result := not (FScanAborted or Application.Terminated); 
    if not Result then Exit; 

    {second pass, directories} 
    res := FindFirst(path + '*.*', faDirectory, SRec); 
    if res = 0 then 
      try 
        while (res = 0) and Result do  
        begin 
          if ((Srec.Attr and faDirectory) = faDirectory) and 
            (Srec.Name <> '.') and 
            (Srec.Name <> '..') then  
          begin 
            path := path + SRec.Name + '\'; 
            Result := ScanDirectory(path); 
            SetLength(path, pathlen); 
          end; 
          res := FindNext(SRec); 
        end; 
      finally 
        FindClose(SRec) 
      end; 
  end; 
begin 
  FScanAborted := False; 
  Screen.Cursor := crHourglass; 
  try 
    Result := ScanDirectory(root); 
  finally 
    Screen.Cursor := crDefault 
  end; 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
var 
  ch: Char; 
  root: string; 
begin 
  root := 'C:\'; 
  for ch := 'A' to 'Z' do  
  begin 
    root[1] := ch; 
    case GetDriveType(PChar(root)) of 
      DRIVE_FIXED, DRIVE_REMOTE: 
        if not ScanDrive(root, edit1.Text, listbox1.Items) then 
          Break; 
    end; 
  end; 
end; 

procedure TForm1.Button3Click(Sender: TObject); 
begin // aborts scan 
  FScanAborted := True; 
end;