{ Liste les dossiers avec ou sans sous-dossiers  
  dans un TStrings avec ou sans le chemin complet. 
  Retourne également  les dossiers cachés et systèmes 
  ansi que ce qui ont une  extension} 
Procedure  FindDirs(Directory: String; aList :  TStrings; 
                   Const  SubFolders : Boolean = True; //cherche les  sous-dossiers 
                   Const  FullPathName : Boolean = True);//retourne le  chemin complet 
Var SearchRec :  TSearchRec; 
Begin 
  If Not  Assigned(aList) Then 
    Exit;  
  If Directory[Length(Directory)] <>  '\' Then Directory  := Directory + '\'; 
  If  FindFirst(Directory + '*.*', faDirectory  Or faSysFile Or  faHidden, SearchRec) = 0 Then 
    Begin 
      aList.BeginUpdate;  
      Repeat 
        If  (SearchRec.Attr And faDirectory =  faDirectory) And (SearchRec.Name[1] 
          <> '.')  Then 
          Begin 
            If  FullPathName Then  
              aList.Add(Directory + SearchRec.Name)  
            Else  
              aList.Add(SearchRec.Name); 
            If SubFolders Then  
              FindDirs(Directory + SearchRec.Name, aList,  SubFolders, FullPathName); // recherche  récusive 
          End 
      Until  FindNext(SearchRec) <> 0;  
      FindClose(SearchRec); 
      aList.EndUpdate; 
    End; 
End;  
{ Exemple d'utilisation } 
Procedure TForm1.Button1Click(Sender: TObject);  
Begin 
  {comme  la méthode peut mettre du temps en fonction du répertoire 
   et des  paramètres on affiche le sablier} 
  Screen.Cursor := crHourGlass;  
  ListBox1.Clear; 
  {Liste tous les dossiers  & sous-dossier et retourne le chemin complet trouvé}  
  FindDirs('c:\Windows', ListBox1.Items);  
  {autres exemples} 
  {Liste tous les dossiers sans sous-dossier et retourne le  chemin complet trouvé} 
  //FindDirs('c:\',  ListBox1.Items, False, True); 
  {Liste  tous les dossiers sans sous-dossier et retourne le nom du dossier  trouvé} 
  //FindDirs('c:\program files',  ListBox1.Items, False, false); 
  Screen.Cursor := crDefault;  
End;