Быстро получить количество файлов для SearchRec

procedure ScanDir(Dir: string; var CountF : integer);
var
  SearchRec: TSearchRec;
begin
  if Dir <> '' then
    if Dir[length(Dir)] <> '\' then
      Dir := Dir + '\';
 
  if FindFirst(Dir + '*.*', faAnyFile, SearchRec) = 0 then
    repeat
      // Application.ProcessMessages;
 
      if (SearchRec.name = '.') or (SearchRec.name = '..') then
        continue;
      
      if (SearchRec.Attr and faDirectory) <> 0 then
        ScanDir(Dir + SearchRec.name)
          //we found Directory: "Dir+SearchRec.name"
      else
        Inc(CountF); // Showmessage(Dir + SearchRec.name);
      //we found File: "Dir+SearchRec.name"
 
    until FindNext(SearchRec) <> 0;
 FindClose(SearchRec);
end;

procedure ScanDir(StartDir: string; Mask: string; var CountF : integer);
var
  SearchRec: TSearchRec;
begin
  if Mask = '' then
    Mask := '*.*';
  if StartDir[Length(StartDir)] <> '\' then
    StartDir := StartDir + '\';
  if FindFirst(StartDir + Mask, faAnyFile, SearchRec) = 0 then
  begin
    repeat
      // Application.ProcessMessages;
      if (SearchRec.Attr and faDirectory) <> faDirectory then
        Inc(CountF)
      else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.')then
      begin
        Inc(CountF);
        ScanDir(StartDir + SearchRec.Name + '\', Mask, CountF);
      end;
    until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
 end;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var Count: integer;
begin
  Count := 0;
  Label1.Caption := 'Start search: ' + TimeToStr(Now);
  ScanDir('D:\PRG', '*.*', Count);
  Label2.Caption := Format('files found: %d', [Count]);
  Label3.Caption := 'Stop search: ' + TimeToStr(Now);
end;