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:
46:

function SelectFolder(Caption, DefPath: string; ShowNewFolderBt: boolean = false): string;
var
  bi: TBrowseInfo;
  lpBuffer: PChar;
  pidlPrograms, pidlBrowse: PItemIDList;

  function BrowseCallbackProc(hwnd: HWND; uMsg: UINT; lParam: Cardinal;
    lpData: Cardinal): Integer; stdcall;
  var
    PathName: array[0..MAX_PATH] of Char;
  begin
    case uMsg of
      BFFM_INITIALIZED:
        SendMessage(Hwnd, BFFM_SETSELECTION, Ord(True), Integer(lpData));
      BFFM_SELCHANGED:
        begin
          SHGetPathFromIDList(PItemIDList(lParam), @PathName);
          SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, Longint(PChar(@PathName)));
        end;
    end;
    Result := 0;
  end;

begin
  Result := '';
  if (not SUCCEEDED(SHGetSpecialFolderLocation(GetActiveWindow, CSIDL_DESKTOP{CSIDL_DRIVES},
    pidlPrograms))) then exit;

  GetMem(lpBuffer, MAX_PATH);

  FillChar(BI, SizeOf(BrowseInfo), 0);
  bi.hwndOwner := GetActiveWindow;
  bi.pidlRoot := pidlPrograms;
  bi.pszDisplayName := lpBuffer;
  bi.lpszTitle := PChar(Caption);
  bi.ulFlags := BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT or BIF_NEWDIALOGSTYLE;
  bi.lpfn := @BrowseCallbackProc;
  bi.lParam := Integer(PChar(DefPath));

  pidlBrowse := SHBrowseForFolder(bi);
  if (pidlBrowse <> nil) then
    if SHGetPathFromIDList(pidlBrowse, lpBuffer) then
      Result := slashPath(String(lpBuffer));

  if (lpBuffer <> nil) then FreeMem(lpBuffer);
end;					

1:
2:
3:
4:
5:
6:
7:
8:

  if (pidlBrowse <> nil) then begin
    if SHGetPathFromIDList(pidlBrowse, lpBuffer) then begin
      Result := slashPath(String(lpBuffer));
    end else begin
      SHGetDataFromIDList(nil, pidlBrowse, SHGDFIL_NETRESOURCE, lpBuffer, 10);
      Result := slashPath(String(lpBuffer));
    end;
  end;