如何显示浏览文件夹对话框

function GetFolder(aRoot: integer; aCaption :string): string;
var
pPrograms,pBrowse: PItemIDList;
hBrowseInfo: TBROWSEINFO;
hPChar: PChar;

begin
if (not SUCCEEDED(SHGetSpecialFolderLocation(Getactivewindow, aRoot, pPrograms))) then
EXIT;
hPChar := StrAlloc(max_path);
with hBrowseInfo do
begin
hwndOwner := Getactivewindow;
pidlRoot := pPrograms;
pszDisplayName := hPChar;
lpszTitle := pChar(aCaption);
ulFlags := BIF_RETURNONLYFSDIRS;
lpfn := nil;
lParam := 0;
end;

pBrowse := SHBrowseForFolder(hBrowseInfo);
if (pBrowse <> nil) then
if (SHGetPathFromIDList(pBrowse, hPChar)) then
Result:= hPChar;

StrDispose(hPChar);

end;

//调用该函数
var
strFolder: String;
begin
strFolder := GetFolder(CSIDL_DRIVES,'select folder');
ShowMessage(strFolder);
end;