1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:

procedure GetDirs(RootDir: string; dirlist: TStrings); 
var 
  search: TSearchRec; 
  ts: TStringList; 
begin 
  ts := TStringList.Create; 
  try 
    if FindFirst(RootDir + '*.*', faDirectory, search) = 0 then 
    begin 
      repeat 
        if ((search.Attr and faDirectory) = faDirectory) and 
            (search.Name <> '.') and (search.Name <> '..') then 
          ts.Add(search.Name); 
      until FindNext(search) <> 0; 
      FindClose(search); 
    end; 
    ts.sort; 
    dirlist.Text := ts.Text; 
  finally 
    ts.Free; 
  end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  GetDirs('C:\', listbox1.Items); 
end;