//ListDirs函数找出Path目录下所有子文件夹，保存于List中
function ListDirs(Path: string; List: TStringList): Integer;
var
FindData: TWin32FindData;
FindHandle: THandle;
FileName: string;
AddToList: Boolean;
begin
Result := 0;
AddToList := Assigned(List);
if Path[Length(Path)] <> '\' then
Path := Path + '\';
Path := Path + '*.*';
FindHandle := Windows.FindFirstFile(PChar(Path), FindData);
while FindHandle <> INVALID_HANDLE_VALUE do
begin
FileName := StrPas(FindData.cFileName);
if (FileName <> '.') and (FileName <> '..') and
((FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
begin
Inc(Result);
if AddToList then
begin
List.Add(extractFilepath(Path)+FileName);
ListDirs(extractFilepath(Path)+FileName,List);
end;
end;
if not Windows.FindNextFile(FindHandle, FindData) then
FindHandle := INVALID_HANDLE_VALUE;
end;
Windows.FindClose(FindHandle);
end;

procedure TForm1.Button1Click(Sender: TObject);
var sl:TStringList;
begin
sl:=TStringList.Create;
ListDirs('E:\',sl);
showmessage(sl.Text);
sl.free;
end;