Вот нашел фнкцию:
procedure FindIt(path, ext: string; aListBox: TListBox;
  spaces: boolean = false; level: integer = 0);
var
  SR: TSearchRec;
  s: string;
  i: integer;
begin
if FindFirst(Path+Ext, faAnyFile, SR) = 0 then
  begin
    repeat
    if (SR.Attr = faDirectory) then
      if (SR.Name <> '.') and (SR.Name <> '..') then
        begin
        s:='';
        for i:=0 to level-1 do
          s:=s+'    ';
        aListBox.Items.Add(s+SR.Name);
        Inc(level);
        if spaces then
          FindIt(Path+sr.Name+'\',ext,aListBox,true,level)
        else
          FindIt(Path+sr.Name+'\',ext,aListBox);
        Dec(level);
        end;
    until FindNext(SR) <> 0;
    FindClose(SR);
  end;
end;
Вот ее запуск:
FindIt(ExtractFilePath(form1.SXSkinLabel4.Caption+'\'),'*.*', ListBox1);
FindIt(ExtractFilePath(form1.SXSkinLabel4.Caption)+'\','*.*', ListBox1,true);
У меня в form1.SXSkinLabel4.Caption путь в каталог. пример D:\Pic\ Но у меня в listbox выводиться не только выбранная папка с подпапками, но и все подпапки на D, помогите, а то нервы уже здают.