1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:

function Getfolder(root: integer; Caption: string): string;
var
  bi: TBROWSEINFO;  //wichtig  ShlObj in uses aufnehmen
  lpBuffer: PChar;
  pidlPrograms,
  pidlBrowse: PItemIDList;

begin
  if (not SUCCEEDED(SHGetSpecialFolderLocation(getactivewindow, root,
    pidlPrograms))) then
  begin
    exit;
    result := '';
  end; //if

  lpBuffer := StrAlloc(max_path);

  bi.hwndOwner := getactivewindow;
  bi.pidlRoot := pidlPrograms;
  bi.pszDisplayName := lpBuffer;
  bi.lpszTitle := pChar(caption);
  bi.ulFlags := BIF_RETURNONLYFSDIRS;
  bi.lpfn := nil;
  bi.lParam := 0;

  pidlBrowse := SHBrowseForFolder(bi);
  if (pidlBrowse <> nil) then
  begin
    if (SHGetPathFromIDList(pidlBrowse, lpBuffer)) then
      result := lpBuffer;
  end; //if
  StrDispose(lpBuffer);
end; //func

procedure TForm1.Button1Click(Sender: TObject);
var
  VerzResult: string;
begin
  VerzResult := getfolder($0000,
    'Wählen Sie das Quell-Verzeichnis aus:');
  if length(VerzResult) > 0 then
  begin
    showmessage(VerzResult);
  end; //if
end; //proc					

1:

pidlBrowse := SHBrowseForFolder(bi);