{ 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;