Open Folder Dialog in Delphi

function GetFolderDialog(const ACaption: string;
                      out ADirectory: string): boolean;
const
  BIF_NEWDIALOGSTYLE = $0040;
  BIF_NONEWFOLDERBUTTON = $0200;
  BIF_USENEWUI = BIF_NEWDIALOGSTYLE or BIF_EDITBOX;
var
  pWindowList: Pointer;
  tbsBrowseInfo: TBrowseInfo;
  pBuffer: PChar;
  iOldErrorMode: cardinal;
  pIemIDList: PItemIDList;
  pShellMalloc: IMalloc;
begin
  CoInitialize(nil);
  try
    Result := false;
    ADirectory := '';
    FillChar(tbsBrowseInfo, sizeof(tbsBrowseInfo), 0);
    if (ShGetMalloc(pShellMalloc) = S_OK)
                   and Assigned(pShellMalloc) then begin
      pBuffer := pShellMalloc.Alloc(MAX_PATH);
      try
        with tbsBrowseInfo do begin
          hwndOwner := Application.Handle;
          pidlRoot := nil;
          pszDisplayName := pBuffer;
          lpszTitle := PChar(ACaption);
          ulFlags := BIF_USENEWUI or
                         BIF_RETURNONLYFSDIRS or
                         BIF_NONEWFOLDERBUTTON;
          lParam := 0;
        end;
        pWindowList := DisableTaskWindows(0);
        iOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
        try
          pIemIDList := ShBrowseForFolder(tbsBrowseInfo);
        finally
          SetErrorMode(iOldErrorMode);
          EnableTaskWindows(pWindowList);
        end;
        Result := Assigned(pIemIDList);
        if Result then begin
          ShGetPathFromIDList(pIemIDList, pBuffer);
          pShellMalloc.Free(pIemIDList);
          ADirectory := pBuffer;
        end;
      finally
        pShellMalloc.Free(pBuffer);
      end;
    end;
  finally
    CoUninitialize;
  end;
end;