#include once "window9.bi"

Function BrowseCallbackProc(byval hWnd   as HWND, _
							byval uMsg   as UINT, _ 
							byval lParam as LPARAM, _
							byval lpData as LPARAM) as long 
	select case uMsg 
		case BFFM_INITIALIZED 
			SendMessage( hWnd, BFFM_SETSELECTION, -1, lpData ) 
		case BFFM_SELCHANGED 
			#ifdef UNICODE
				dim as Wstring * MAX_PATH sPath
			#else	
				dim as zstring * MAX_PATH sPath
			#EndIf			
			if SHGetPathFromIDList( cast( LPCITEMIDLIST, lParam ), sPath) = 0 then 
				sPath = "Unknown"
			else 
				sPath = "PATH: " + sPath
			end if
			#ifdef UNICODE
				SendMessage( hWnd, BFFM_SETSTATUSTEXT, 0, cuint(@sPath) )
			#else	
				SendMessage( hWnd, BFFM_SETSTATUSTEXT, 0, cuint( StrPtr(sPath) ) )
			#EndIf			
	end select 
	function = 0 
end function 

function ShellFolder(byref NameDialog as USTRING, ByRef DefaultFolder as USTRING,_
                    ByVal FlagOption As Integer , ByVal hParentWin as HWND = 0) as USTRING Export
	static sFolder as USTRING
	dim bi         as BROWSEINFO
	dim pidlReturn as LPITEMIDLIST
	dim pidlStart  as LPITEMIDLIST
	
	dim as HWND hwFocus = GetFocus()
	CoInitialize( NULL ) 
	SHGetSpecialFolderLocation( NULL, CSIDL_DRIVES, @pidlStart ) 
	sFolder = DefaultFolder
	with bi
		.pidlRoot   = pidlStart 
		.hwndOwner  = hParentWin
		.ulFlags    =  FlagOption
		.lpfn       = @BrowseCallbackProc
		#ifdef UNICODE
			.lpszTitle  = Cast(LPCTSTR,*NameDialog)		 
			.lParam     = cast(LPARAM,*sFolder)			
		#else	
			.lpszTitle  = Cast(LPCSTR,StrPtr(NameDialog))		 
			.lParam     = cast(LPARAM,strptr(sFolder))			
		#EndIf
	end with
	pidlReturn = SHBrowseForFolder( @bi ) 
	CoTaskMemFree(pidlStart)
	
	dim as USTRING sRet
	if( pidlReturn <> NULL ) Then 
		#ifdef UNICODE
			dim as Wstring * MAX_PATH sPath
		#else	
			dim as zstring * MAX_PATH sPath
		#EndIf	
		SHGetPathFromIDList( pidlReturn, sPath ) 
		CoTaskMemFree( pidlReturn ) 
		sRet = sPath
		function = sRet
	else
		function = sRet
	end if 
	CoUninitialize( )
	SetFocus(hwFocus) 
end Function

