[API]
BrowseInfo
SHBrowseForFolderA
SHBrowseForFolderW
SHGetPathFromIDListA
SHGetPathFromIDListW
CoTaskMemFree
GetWindow
ShowWindow
SendMessageA
SendMessageW

[INCLUDE]
TemporaryMemory
LocalAllocFromString
SetWindowLong
GetWindowLong
GetClassName

[DEFINE]
Private SHBrowseForFolder_CurDir As Long

[CODE]
Public Function SHBrowseForFolder(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
    SHBrowseForFolder_CurDir = LocalAllocFromString(InitDir & vbNullChar)
    End If
  xType1.lpfnCallback = SHBrowseForFolder_CallbackProc(-2&, 0&, AddressOf SHBrowseForFolder_CallbackProc, 0&)
  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
      SHBrowseForFolder = PeekS(ptrTemp)
      End If
    Call CoTaskMemFree(xLong1)
    End If
  If Not SHBrowseForFolder_CurDir = 0& Then
    Call LocalFree(SHBrowseForFolder_CurDir)
    SHBrowseForFolder_CurDir = 0&
    End If
  If Not xType1.lpszTitle = 0& Then Call LocalFree(xType1.lpszTitle)
  End Function

Private Function SHBrowseForFolder_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
    SHBrowseForFolder_CallbackProc = lParam
    Else
    Select Case uMsg
      Case 1&
        #If SHBrowseForFolder_CallbackHack Then
          uMsg = CommonDLG_CallbackProc_Init(hWnd)
          If Not uMsg = 0& Then
            If Not SHBrowseForFolder_CurDir = 0& Then
              Call LocalFree(SHBrowseForFolder_CurDir)
              End If
            SHBrowseForFolder_CurDir = uMsg
            End If
          #Else
          uMsg = SHBrowseForFolder_GetTreeView(HWnd)
          If Not uMsg = 0& Then
            Call ShowWindow(uMsg, 0&)
            Call SetWindowLong(uMsg, -16&, (GetWindowLong(uMsg, -16&) And &HFFFFFBF7) Or &H1020&)
            Call ShowWindow(uMsg, 5&)
            End If
          #End If
        If Not SHBrowseForFolder_CurDir = 0& Then
          If IsUnicode Then
            Call SendMessageW(hWnd, &H467&, 1&, ByVal SHBrowseForFolder_CurDir)
            Else
            Call SendMessageA(hWnd, &H466&, 1&, ByVal SHBrowseForFolder_CurDir)
            End If
          End If
      Case 2&
        If IsUnicode Then
          If SHGetPathFromIDListW(lParam, ByVal ptrTemp) = 1& Then
            Call SendMessageW(hWnd, &H468&, 0&, ByVal ptrTemp)
            End If
          ElseIf SHGetPathFromIDListA(lParam, ByVal ptrTemp) = 1& Then
          Call SendMessageA(hWnd, &H464&, 0&, ByVal ptrTemp)
          End If
        '#If (CommonDLG_FlagA And &H30&) = &H30& Then
        #If SHBrowseForFolder_CallbackHack Then
          CommonDLG_CallbackProc_Change hwnd, PeekS(ptrTemp)
          #End If
      End Select
    SHBrowseForFolder_CallbackProc = 0&
    End If
  End Function

#If SHBrowseForFolder_CallbackHack Then
Public Function SHBrowseForFolder_GetTreeView(HWnd) As Long
#Else
Private Function SHBrowseForFolder_GetTreeView(HWnd) As Long
#End If
  SHBrowseForFolder_GetTreeView = GetWindow(hwnd, 5&)
  Do While (Not (SHBrowseForFolder_GetTreeView = 0&))
    If LCase(GetClassName(SHBrowseForFolder_GetTreeView)) = "systreeview32" Then
      Exit Do
      End If
    SHBrowseForFolder_GetTreeView = GetWindow(SHBrowseForFolder_GetTreeView, 2&)
    Loop
  End Function
