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;