Procedure TForm1.FindRecursive(Const path: String; Const mask: String);
Var
 fullpath: String;

  Function Recurse( Var path: String; Const mask: String ): Boolean;
    Var
      SRec: TSearchRec;
      retval: Integer;
      oldlen: Integer;
    Begin
      Recurse := True;
      oldlen := Length(path);
      retval := FindFirst(path+mask, faAnyFile, SRec);
      While retval = 0 Do Begin
        Application.ProcessMessages;
        If (SRec.Attr and (faDirectory or faVolumeID)) = 0 Then
         Form1.ListBox1.items.Add(path+srec.name);
         Form1.Caption:='Found '+IntToStr(Form1.ListBox1.items.Count)+' files...';
        retval := FindNext(SRec);
      End;
      FindClose(SRec);

      If not Result Then Exit;

      retval := FindFirst( path+'*.*', faDirectory, SRec);
      While retval = 0 Do Begin
        If (SRec.Attr and faDirectory) <> 0 Then
          If (SRec.Name <> '.') and (SRec.Name <> '..') Then Begin
            path := path + SRec.Name + '\';
            If not Recurse( path, mask ) Then Begin
              Result := False;
              Break;
            End;
            Delete( path, oldlen+1, 255 );
          End;
        retval := FindNext( SRec );
      End;
      FindClose( SRec );
    End;
Begin
 If path = '' Then GetDir(0, fullpath)
              Else fullpath := path;

 If fullpath[Length(fullpath)] <> '\' Then fullpath := fullpath + '\';

 If mask = '' Then  Recurse(fullpath, '*.*')
              Else  Recurse(fullpath, mask);
 end;