unit SHBrowseFolder;
interface
Uses Windows, SysUtils;


  Function BrowseFolder(aWndOwner: THandle; aTitle: String; FromPath: String = ''): String;

implementation
Uses ActiveX, ShlObj;
Var fSHMalloc: IMalloc = Nil;

    Function BrowseCallbackProc(ahwnd: HWND; uMsg: UINT; alParam, lpData: LPARAM): integer; StdCall;
    Begin
      If uMsg = BFFM_INITIALIZED Then
        PostMessage(ahwnd, BFFM_SETSELECTION, DWORD(True), DWORD(lpData));
      Result := 0;
    End;
  Function BrowseFolder(aWndOwner: THandle; aTitle: String; FromPath: String = ''): String;
  Var
    anInfo: TBrowseInfo;
    aResult: PItemIDList;
  Begin
    ZeroMemory(@anInfo, SizeOf(anInfo));
    anInfo.hwndOwner := aWndOwner;
    anInfo.lpszTitle := PChar(aTitle);
    anInfo.ulFlags := BIF_RETURNONLYFSDIRS;
    If FromPath <> '' Then
    Begin
      anInfo.lpfn := @BrowseCallbackProc;
      anInfo.lParam := DWORD(PChar(FromPath));
    End;
    aResult := SHBrowseForFolder(anInfo);
    If aResult = Nil Then Abort;
    Try
      SetLength(Result, MAX_PATH);
      Win32Check(SHGetPathFromIDList(aResult, PChar(Result)));
      SetLength(Result, StrLen(PChar(Result)));
    Finally
      fSHMalloc.Free(aResult);
    End;
  End;



Initialization
  Win32Check(SHGetMalloc(fSHMalloc) = NOERROR);

Finalization
  If fSHMalloc <> Nil Then
    fSHMalloc._Release;
end.

procedure TForm1.Button1Click(Sender: TObject);
Var
  aDial: TOpenDialog;
  anOptions: TOpenOptions;
begin
  aDial := TOpenDialog.Create(Self);
  Try
    anOptions := aDial.Options;
    Include(anOptions, ofAllowMultiSelect);
    aDial.Options := anOptions;
    If Not aDial.Execute Then Exit;
    ListBox1.Items.AddStrings(aDial.Files);
  Finally
    aDial.Free;
  End;
end;