VAR SL:TStringList ;

procedure Recurse(Dir: string);
var
 F: TSearchRec;
 R: Integer;
begin
 if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\';

 if FindFirst(Dir+'*.*', faAnyFile, F)=0 then
 repeat

 begin
   if (F.name='.') or (F.name='..') then continue;
   if (F.Attr and faDirectory <> 0)  then SL.Add(F.Name);
   if (F.Attr and faDirectory)<>0 then  Recurse(Dir+F.name);
 end;

 until FindNext(F)<>0;
 FindClose(F);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SL:=TStringList.create;
  SL.Clear;
  Recurse('e:\BOOKS') ;
  ListBox1.Items:=SL;
end;