[lmikle]

Госпадя!!!

Код:

procedure GetDirsList(root : String; var list : TStringList);
var
  i : Integer;
  F : TSearchRec;
begin
  list.add(root);
  i := FindFirst(IncludeTrailingPathDelimeiter(root) + '*.*',faAnyFile,F);
  While i = 0 Do
    Begin
      If ((F.Attr And fadirectory) <> 0) And (F.Name <> '.') And (F.Name <> '..') 
       Then GetDirsList(IncludeTrailingPathDelimeiter(root) + F.Name,list);
      i := FindNext(F);
    End;
  FindClose(F);
end;

Все. При вызове вернет тебе в списке все папки.