Include "MapBasic.def"
'Include "BrowseFolder.def"
Declare Function GetFolder(ByVal strCaption As String) As String

Define MAX_PATH 260

'Some of the following BIF_* flags are Shell32.dll version dependent. To
'check your version, locate Shell32.dll, right click on it, and choose
'Properties > Version. For example, the "new dialog" features are available
'only in versions 5.0 and higher. If your version is too old, only the 
'earlier features will work and the newer ones are ignored.

'The comments associated with the BIF defines are from Microsoft's 
'MSDN website.

Define BIF_RETURNONLYFSDIRS   &H0001
'Only return file system directories. If the user selects folders that are not part of the file system, the OK button is grayed.
Define BIF_DONTGOBELOWDOMAIN  &H0002
'Do not include network folders below the domain level in the dialog box's tree view control.
Define BIF_STATUSTEXT         &H0004
'Include a status area in the dialog box. The callback function can set the status text by sending messages to the dialog box. This flag is not supported when BIF_NEWDIALOGSTYLE is specified.
Define BIF_RETURNFSANCESTORS  &H0008
'Only return file system ancestors. An ancestor is a subfolder that is beneath the root folder in the namespace hierarchy. If the user selects an ancestor of the root folder that is not part of the file system, the OK button is grayed.
Define BIF_EDITBOX            &H0010
'Version 4.71. Include an edit control in the browse dialog box that allows the user to type the name of an item.
Define BIF_VALIDATE           &H0020
'Version 4.71. If the user types an invalid name into the edit box, the browse dialog box will call the application's BrowseCallbackProc with the BFFM_VALIDATEFAILED message. This flag is ignored if BIF_EDITBOX is not specified.
Define BIF_NEWDIALOGSTYLE     &H0040
'Version 5.0. Use the new user interface. Setting this flag provides the user with a larger dialog box that can be resized. The dialog box has several new capabilities including: drag and drop capability within the dialog box, reordering, shortcut menus, new folders, delete, and other shortcut menu commands. To use this flag, you must call OleInitialize or CoInitialize before calling SHBrowseForFolder.
Define BIF_BROWSEINCLUDEURLS  &H0080
'Version 5.0. The browse dialog box can display URLs. The BIF_USENEWUI and BIF_BROWSEINCLUDEFILES flags must also be set. If these three flags are not set, the browser dialog box will reject URLs. Even when these flags are set, the browse dialog box will only display URLs if the folder that contains the selected item supports them. When the folder's IShellFolder::GetAttributesOf method is called to request the selected item's attributes, the folder must set the SFGAO_FOLDER attribute flag. Otherwise, the browse dialog box will not display the URL.
Define BIF_UAHINT             &H0100
'Version 6.0. When combined with BIF_NEWDIALOGSTYLE, adds a usage hint to the dialog box in place of the edit box. BIF_EDITBOX overrides this flag.
Define BIF_NONEWFOLDERBUTTON  &H0200
'Version 6.0. Do not include the New Folder button in the browse dialog box.
Define BIF_NOTRANSLATETARGETS &H0400
'Version 6.0. When the selected item is a shortcut, return the PIDL of the shortcut itself rather than its target.
Define BIF_BROWSEFORCOMPUTER  &H1000
'Only return computers. If the user selects anything other than a computer, the OK button is grayed.
Define BIF_BROWSEFORPRINTER   &H2000
'Only allow the selection of printers. If the user selects anything other than a printer, the OK button is grayed. 
'In Microsoft® Windows® XP, the best practice is to use an XP-style dialog, setting the root of the dialog to the Printers and Faxes folder (CSIDL_PRINTERS).
Define BIF_BROWSEINCLUDEFILES &H4000
'Version 4.71. The browse dialog box will display files as well as folders.
Define BIF_SHAREABLE          &H8000
'Version 5.0. The browse dialog box can display shareable resources on remote systems. It is intended for applications that want to expose remote shares on a local system. The BIF_NEWDIALOGSTYLE flag must also be set.
Define BIF_USENEWUI (BIF_EDITBOX + BIF_NEWDIALOGSTYLE)
'Version 5.0. Use the new user interface, including an edit box. This flag is equivalent to BIF_EDITBOX | BIF_NEWDIALOGSTYLE. To use BIF_USENEWUI, you must call OleInitialize or CoInitialize before calling SHBrowseForFolder.

Type BROWSEINFO
	hOwner As Integer
	pidlRoot As Integer
	pszDisplayName As String
	lpszTitle As String
	ulFlags As Integer
	lpfn As Integer
	lParam As Integer
	iImage As Integer
End Type

'CoInitializeEx() constants
Define COINIT_APARTMENTTHREADED &H2
Define S_OK                 &H00000000
Define S_FALSE              &H00000001
Define E_INVALIDARG         &H80070057
Define E_OUTOFMEMORY        &H8007000E
Define E_UNEXPECTED         &H8000FFFF
Define RPC_E_CHANGED_MODE   &H80010106

Declare Function CoInitializeEx Lib "ole32.dll" (ByVal pvReserved As Integer, ByVal dwCoInit As Integer) As Integer
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Integer
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Integer, pszPath As String) As Integer
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Integer)


Function GetFolder (
	ByVal strCaption As String) 'Dialog caption
	As String                   'Selected folder or NULL

Dim tBI As BROWSEINFO
Dim sPath As String
Dim nResult As Integer
Dim nPIDL As Integer

	'Initialize COM library
	nResult = CoInitializeEx (0, COINIT_APARTMENTTHREADED)
	Do Case nResult 
	Case S_OK
		'All's cool; continue
	Case S_FALSE
		'COM library already initialized; continue
	Case E_INVALIDARG
		Note "Error: Invalid argument passed to CoInitializeEx() "
		Exit Function
	Case E_OUTOFMEMORY
		Note "Error: Out of memory calling CoInitializeEx() "
		Exit Function
	Case E_UNEXPECTED
		Note "Error: Unexpected problem calling CoInitializeEx() "
		Exit Function
	Case RPC_E_CHANGED_MODE 
		Note "Error: RPC mode changed calling CoInitializeEx() "
		Exit Function
	Case Else
		Note "Error: CoInitializeEx() returned " & nResult
		Exit Function
	End Case
	
	'Set Desktop as start of namespace
	nPIDL = 0
	
	'Assign input member values
	tBI.hOwner = SystemInfo(SYS_INFO_MAPINFOWND)
	tBI.pidlRoot = nPIDL
	tBI.pszDisplayName = Space$(MAX_PATH)
	tBI.lpszTitle = strCaption
	tBI.ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE

	'show the browse dialog
	nPIDL = SHBrowseForFolder(tBI)
	
	If nPIDL <> 0 Then
	  'got a pidl .. but is it valid?
	  sPath = Space$(MAX_PATH)
	  If SHGetPathFromIDList(nPIDL, sPath) Then
	    'valid, so get the share path
	    GetFolder = sPath
	  End If
	  Call CoTaskMemFree (nPIDL)
	Else
	  If Rtrim$ (tBI.pszDisplayName) = "" OR InStr (1, tBI.pszDisplayName, "?") Then
	  	GetFolder = ""
	  Else
	  	'server selected; Add \\ because it's a UNC path
	  	GetFolder = "\\" & Rtrim$ (tBI.pszDisplayName)
		End If
	End If
End Function


Declare Sub Main
Sub Main
Dim sFolder As String

	sFolder = GetFolder ("Select a folder:")
	If sFolder <> "" Then
		Note sFolder
	End If
End Sub