[API]
BrowseInfo
SHBrowseForFolderA
SHBrowseForFolderW
SHGetPathFromIDListA
SHGetPathFromIDListW
CoTaskMemFree

[INCLUDE]
GenericInit
LocalAllocFromString

[DEFINE]
Private xCurDir As Long

[CODE]
Public Function CommonDLG_OpenPath(ByVal hWnd As Long, ByVal Caption As String, Optional ByVal InitDir As String) As String
  Dim xLong1 As Long
  Dim xType1 As BrowseInfo
    
  xType1.hWndOwner = hWnd
  xType1.lpszTitle = LocalAllocFromString(Caption)
  xType1.ulFlags = &H1&    '&H3&
  If Not Len(InitDir) = 0& Then
    xCurDir = LocalAllocFromString(InitDir & vbNullChar)
    xType1.lpfnCallback = CommonDLG_OpenPath_CallbackProc(-2&, 0&, AddressOf CommonDLG_OpenPath_CallbackProc, 0&)
    End If
  If IsUnicode Then
    xLong1 = SHBrowseForFolderW(xType1)
    Else
    xLong1 = SHBrowseForFolderA(xType1)
    End If
  If Not xLong1 = 0& Then
    If IsUnicode Then
      hWnd = SHGetPathFromIDListW(xLong1, ptrTemp)
      Else
      hWnd = SHGetPathFromIDListA(xLong1, ptrTemp)
      End If
    If Not hWnd = 0& Then
      CommonDLG_OpenPath = PeekS(ptrTemp)
      End If
    Call CoTaskMemFree(xLong1)
    End If
  If Not xCurDir = 0& Then
    Call LocalFree(xCurDir)
    xCurDir = 0&
    End If
  If Not xType1.lpszTitle = 0& Then Call LocalFree(xType1.lpszTitle)
  End Function

Private Function CommonDLG_OpenPath_CallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lData As Long) As Long
  On Error Resume Next
  If hWnd = -2& Then
    CommonDLG_OpenPath_CallbackProc = lParam
    Else
    Select Case uMsg
      Case 1&
        #If (CommonDLG_FlagA And &H30&) = &H30& Then
          xCurDir = CommonDLG_CallbackProc_Init(hWnd)
          #End If
        Call SendMessage(hWnd, &H466&, 1&, xCurDir)
      Case 2&
        If IsUnicode Then
          If SHGetPathFromIDListW(lParam, ByVal ptrTemp) = 1& Then
            Call SendMessage(hWnd, &H464&, 0&, ByVal ptrTemp)
            End If
          ElseIf SHGetPathFromIDListA(lParam, ByVal ptrTemp) = 1& Then
          Call SendMessage(hWnd, &H464&, 0&, ByVal ptrTemp)
          End If
        #If (CommonDLG_FlagA And &H30&) = &H30& Then
          CommonDLG_CallbackProc_Change PeekS(ptrTemp)
          #End If
      End Select
    CommonDLG_OpenPath_CallbackProc = 0&
    End If
  End Function