Imports System.Runtime.InteropServices
Imports System.Runtime.CompilerServices

'https://stackoverflow.com/questions/16036853/folderbrowser-with-textbox-in-vb-net


Module m_IFileDialog

#Region "Constants"

  'Shell Reference > Shell Constants, Enumerations, and Flags
  ' FILEOPENDIALOGOPTIONS enumeration
  Public Const FOS_NOCHANGEDIR As UInteger = &H8
  Public Const FOS_PICKFOLDERS As UInteger = &H20
  Public Const FOS_FORCEFILESYSTEM As UInteger = &H40
  Public Const FOS_NOVALIDATE As UInteger = &H100
  Public Const FOS_PATHMUSTEXIST As UInteger = &H800 'The item returned must be in an existing folder. This is a default value.
  Public Const FOS_NOTESTFILECREATE As UInteger = &H10000
  Public Const FOS_DONTADDTORECENT As UInteger = &H2000000

  ' SIGDN enumeration
  Public Const SIGDN_FILESYSPATH As UInteger = &H80058000UI

#End Region

#Region "COM"

  <ComImport(), ClassInterface(ClassInterfaceType.None), TypeLibType(TypeLibTypeFlags.FCanCreate), Guid("DC1C5A9C-E88A-4DDE-A5A1-60F82A20AEF7")> _
  Friend Class FileOpenDialogRCW
  End Class

  'Shell Interfaces -> IFileDialog
  <ComImport(), Guid("42F85136-DB7E-439C-85F1-E4075D135FC8"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
  Friend Interface IFileDialog
    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    <PreserveSig()> _
    Function Show(<[In](), [Optional]()> ByVal hwndOwner As IntPtr) As UInteger
    'IModalWindow 

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function SetFileTypes(<[In]()> ByVal cFileTypes As UInteger, <[In](), MarshalAs(UnmanagedType.LPArray)> ByVal rgFilterSpec As IntPtr) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function SetFileTypeIndex(<[In]()> ByVal iFileType As UInteger) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function GetFileTypeIndex(ByRef piFileType As UInteger) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function Advise(<[In](), MarshalAs(UnmanagedType.[Interface])> ByVal pfde As IntPtr, ByRef pdwCookie As UInteger) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function Unadvise(<[In]()> ByVal dwCookie As UInteger) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function SetOptions(<[In]()> ByVal fos As UInteger) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function GetOptions(ByRef fos As UInteger) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Sub SetDefaultFolder(<[In](), MarshalAs(UnmanagedType.[Interface])> ByVal psi As IShellItem)

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function SetFolder(<[In](), MarshalAs(UnmanagedType.[Interface])> ByVal psi As IShellItem) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function GetFolder(<MarshalAs(UnmanagedType.[Interface])> ByRef ppsi As IShellItem) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function GetCurrentSelection(<MarshalAs(UnmanagedType.[Interface])> ByRef ppsi As IShellItem) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function SetFileName(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszName As String) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function GetFileName(<MarshalAs(UnmanagedType.LPWStr)> ByRef pszName As String) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function SetTitle(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszTitle As String) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function SetOkButtonLabel(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszText As String) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function SetFileNameLabel(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszLabel As String) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function GetResult(<MarshalAs(UnmanagedType.[Interface])> ByRef ppsi As IShellItem) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function AddPlace(<[In](), MarshalAs(UnmanagedType.[Interface])> ByVal psi As IShellItem, ByVal fdap As UInteger) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function SetDefaultExtension(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszDefaultExtension As String) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function Close(<MarshalAs(UnmanagedType.[Error])> ByVal hr As UInteger) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function SetClientGuid(<[In]()> ByRef guid As Guid) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function ClearClientData() As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function SetFilter(<MarshalAs(UnmanagedType.[Interface])> ByVal pFilter As IntPtr) As UInteger
  End Interface


  'Shell Interfaces -> IShellItem
  <ComImport(), Guid("43826D1E-E718-42EE-BC55-A1E261C37BFE"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
  Friend Interface IShellItem
    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function BindToHandler(<[In]()> ByVal pbc As IntPtr, <[In]()> ByRef rbhid As Guid, <[In]()> ByRef riid As Guid, <Out(), MarshalAs(UnmanagedType.[Interface])> ByRef ppvOut As IntPtr) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function GetParent(<MarshalAs(UnmanagedType.[Interface])> ByRef ppsi As IShellItem) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function GetDisplayName(<[In]()> ByVal sigdnName As UInteger, ByRef ppszName As IntPtr) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function GetAttributes(<[In]()> ByVal sfgaoMask As UInteger, ByRef psfgaoAttribs As UInteger) As UInteger

    <MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
    Function Compare(<[In](), MarshalAs(UnmanagedType.[Interface])> ByVal psi As IShellItem, <[In]()> ByVal hint As UInteger, ByRef piOrder As Integer) As UInteger
  End Interface

#End Region

End Module

Public Class ISelectFolderDialog
  Implements IDisposable

  Private Const S_OK As UInteger = &H0

  'Shell Reference > Shell Functions
  Private Declare Unicode Function SHCreateItemFromParsingName Lib "shell32.dll" _
   (ByVal pszPath As String, ByVal pbc As IntPtr, ByRef riid As Guid, ByRef ppv As IShellItem) As Integer

  'local variable(s) to hold property value(s)
  Private m_InitialFolder As String
  Private m_DefaultFolder As String
  Private m_Folder As String
  Private m_Title As String

  ''' <summary>
  ''' Gets/sets folder in which dialog will be open.
  ''' </summary>
  Public Property InitialFolder() As String
    Get
      Return m_InitialFolder
    End Get
    Set(ByVal value As String)
      m_InitialFolder = value
    End Set
  End Property

  ''' <summary>
  ''' Gets/sets directory in which dialog will be open if there is no recent directory available.
  ''' </summary>
  Public Property DefaultFolder() As String
    Get
      Return m_DefaultFolder
    End Get
    Set(ByVal value As String)
      m_DefaultFolder = value
    End Set
  End Property

  ''' <summary>
  ''' Gets selected folder.
  ''' </summary>
  Public Property Folder() As String
    Get
      Return m_Folder
    End Get
    Private Set(ByVal value As String)
      m_Folder = value
    End Set
  End Property

  ''' <summary>
  ''' Gets/sets the title of the dialog.
  ''' </summary>
  Public Property Title() As String
    Get
      Return m_Title
    End Get
    Set(ByVal value As String)
      m_Title = value
    End Set
  End Property


  Public Function ShowDialog(ByVal owner As IWin32Window) As DialogResult
    If Environment.OSVersion.Version.Major >= 6 Then
      Dim frm = DirectCast(New FileOpenDialogRCW(), IFileDialog)

      Dim options As UInteger
      frm.GetOptions(options)
      'options = options Or NativeMethods.FOS_PICKFOLDERS Or NativeMethods.FOS_FORCEFILESYSTEM Or NativeMethods.FOS_NOVALIDATE Or NativeMethods.FOS_NOTESTFILECREATE Or NativeMethods.FOS_DONTADDTORECENT
      options = options Or FOS_PICKFOLDERS Or FOS_FORCEFILESYSTEM Or _
       FOS_NOVALIDATE Or FOS_NOTESTFILECREATE Or FOS_DONTADDTORECENT Or FOS_NOCHANGEDIR Or FOS_PATHMUSTEXIST
      frm.SetOptions(options)

      If Me.InitialFolder IsNot Nothing Then
        Dim directoryShellItem As IShellItem = Nothing
        Dim riid = New Guid("43826D1E-E718-42EE-BC55-A1E261C37BFE")
        'IShellItem
        If SHCreateItemFromParsingName(Me.InitialFolder, IntPtr.Zero, riid, directoryShellItem) = S_OK Then
          frm.SetFolder(directoryShellItem)
        End If
      End If

      If Me.DefaultFolder IsNot Nothing Then
        Dim directoryShellItem As IShellItem = Nothing
        Dim riid = New Guid("43826D1E-E718-42EE-BC55-A1E261C37BFE")
        'IShellItem
        If SHCreateItemFromParsingName(Me.DefaultFolder, IntPtr.Zero, riid, directoryShellItem) = S_OK Then
          frm.SetDefaultFolder(directoryShellItem)
        End If
      End If

      If Me.Title IsNot Nothing Then
        frm.SetTitle(Me.Title)
      End If

      If frm.Show(owner.Handle) = S_OK Then
        Dim shellItem As IShellItem = Nothing
        If frm.GetResult(shellItem) = S_OK Then
          Dim pszString As IntPtr
          If shellItem.GetDisplayName(SIGDN_FILESYSPATH, pszString) = S_OK Then
            If pszString <> IntPtr.Zero Then
              Try
                Me.Folder = Marshal.PtrToStringAuto(pszString)
                Return DialogResult.OK
              Finally
                Marshal.FreeCoTaskMem(pszString)
              End Try
            End If
          End If
        End If
      End If
      Return DialogResult.Cancel
    Else
      '!!!не надо это использовать на XP/2003 -ясно что работать не будет
      Return DialogResult.Cancel
    End If
  End Function

  Public Sub Dispose() Implements IDisposable.Dispose
    'just to have possibility of Using statement.
  End Sub

End Class