Le portail francophone de la géomatique

Include "MapBasic.def"
Include "Menu.def"

Declare sub main
Declare sub dir_handler
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Integer)

define MAX_PATH 260

Type BrowseInfo
    hWndOwner As Integer
    pIDLRoot As Integer
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Integer
    lpfnCallback As Integer
    lParam As Integer
    iImage As Integer
End Type

Declare Function  choixrepert(byval sPrompt As String) As String
Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA"(lpbi As BrowseInfo) As Integer
Declare Function SHGetPathFromIDList Lib "shell32" 
    Alias "SHGetPathFromIDListA" (ByVal pidList As Integer, lpBuffer As String) As Integer

Dim repertoire As String

'-------------------------------
Sub main()
    Dialog title "Chemin"
        Control Button 
            Calling dir_handler
            Title  "dossier ?"
End Sub
'-------------------------------
Sub dir_handler
Dim test as String
test=choixrepert("cliquer sur le disque ou dossier choisi")
    If test="" then
        repertoire=ApplicationDirectory$()
    Else
     If right$(test,1)="\" Then
        repertoire=test
     Else
        repertoire=test+"\"
     End If
    End if
print "Le chemin du dossier choisi est :    "+repertoire
End Program
End Sub
'-------------------------------
Function choixrepert(byval sPrompt As String) As String
 Dim nNull,lpIDList,nResult,retval As Integer
 Dim sPath As String 
 Dim bi As BrowseInfo
    bi.hWndOwner = 0
    bi.pszDisplayName = Space$(MAX_PATH)
    bi.lpszTitle = sprompt
    bi.ulFlags = 0
    lpIDList = SHBrowseForFolder(bi)
     If lpIDList <> 0 Then
      sPath = Space$(260)
      nResult = SHGetPathFromIDList(lpIDList, sPath)
        If nResult <> 0 Then
          sPath = Rtrim$(sPath)
        End If
      Call CoTaskMemFree(lpIDList)
     End If
    choixrepert= sPath
    Call CoTaskMemFree(bi.pIDLRoot)
End Function
'-------------------------------