unit ShellBrowse;
interface

uses
	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
	TShellBrowseFlag = (
		sbFileSysDirs,
		sbDisableNetwork,
		sbStatusText,
		sbFileSysAncestors,
		sbComputers,
		sbPrinters);
	TShellBrowseFlags = set of TShellBrowseFlag;

	TShellBrowseDialog = class(TComponent)
	private
		FTitle: string;
		FFlags: TShellBrowseFlags;       // Flags that control the return stuff
		FDisplayName: string;
		FPath: string;
	public
		property DisplayName: string read FDisplayName;
		property Path: string read FPath write FPath;
		function Execute: Boolean;
	published
		property Title: string read FTitle write FTitle;
		property Flags: TShellBrowseFlags read FFlags write FFlags;
	end;


implementation

uses
	ShlObj, ShellUtils, ActiveX;

const
	ShellFlags: array [TShellBrowseFlag] of ULONG = (
		BIF_RETURNONLYFSDIRS,
		BIF_DONTGOBELOWDOMAIN,
		BIF_STATUSTEXT,
		BIF_RETURNFSANCESTORS,
		BIF_BROWSEFORCOMPUTER,
		BIF_BROWSEFORPRINTER);


function StrRetToString(aMalloc: IMalloc; aPIDL: PItemIDList; aStrRet: TStrRet): string;
begin
	case aStrRet.uType of
		STRRET_CSTR:
			Result := aStrRet.CStr;
		STRRET_OFFSET:
			Result := PChar(aPIDL) + aStrRet.uOffset;
		STRRET_WSTR:
			begin
				Result := WideCharToString(aStrRet.pOleStr);
				aMalloc.Free(aStrRet.pOleStr);
			end;
		else
			Result := '';
	end;
end;

function GetDisplayNameOf(aMalloc: IMalloc; aFolder: IShellFolder; aPIDL: PItemIDList; aFormat: Integer): string;
var
	aStrRet: TStrRet;
begin
	aFolder.GetDisplayNameOf(aPIDL, aFormat, aStrRet);
	Result := StrRetToString(aMalloc, aPIDL, aStrRet);
end;

function BrowseCallbackProc(aWindow: HWND; aMsg: UINT; aLParam, aData: LPARAM): Integer; stdcall;
begin
	if (aMSg = BFFM_INITIALIZED) and (aData <> 0) then 
		SendMessage(aWindow, BFFM_SETSELECTION, 1, aData);
	Result := 0;
end;

function TShellBrowseDialog.Execute: Boolean;
var
	i: TShellBrowseFlag;
	aBrowseInfo: TBrowseInfo;
	aPIDL: PItemIDList;
	aDisplayName: array [0..MAX_PATH] of char;
	aMalloc: IMalloc;
	aDesktop: IShellFolder;
	aForm: TComponent;
begin
	Result := False;
	SHGetMalloc(aMalloc);
	FillChar(aBrowseInfo, sizeof(aBrowseInfo), #0);
	with aBrowseInfo do begin
		hwndOwner := 0;
		aForm := Owner;
		while Assigned(aForm) and (hwndOwner = 0) do begin
			if aForm is TForm then
				hwndOwner := (aForm as TForm).Handle
			else
				aForm	:= aForm.Owner;
		end;
		pszDisplayName := aDisplayName;
		lpszTitle := PChar(FTitle);
		for i := Low(TShellBrowseFlag) to High(TShellBrowseFlag) do
			if i in FFlags then
				ulFlags := ulFlags or ShellFlags[i];
		lpfn := BrowseCallbackProc;
		Pointer(lParam) := PChar(Path);
	end;
	aPIDL := SHBrowseForFolder(aBrowseInfo);
	if Assigned(aPIDL) then begin
		Result := True;
		FDisplayName := aDisplayName;
    SHGetDesktopFolder(aDesktop);
		FPath := GetDisplayNameOf(aMalloc, aDesktop, aPIDL, SHGDN_FORPARSING);
		aMalloc.Free(aPIDL);
	end;
end;

end.
