clsFolderBrowser

Source Code

Option Explicit On

Imports System
Imports System.Runtime.InteropServices
Imports System.Diagnostics
Imports System.Text

'* Class clsFolderBrowser
'*
'*    Author : Paulo S. Silva Jr.
'*      Date : September 2002
'* Objective : To implement the ability of browse for folder on a .NET environment
'*
'* Class Properties
'*
'*   +------------+---------+-------------------------------------------------+
'*   | Name       | Type    | Description                                     |
'*   +------------+---------+-------------------------------------------------+
'*   | Title      | String  | Information to be displayed on the dialog       |
'*   | NewUI      | Boolean | Informs the class to use the new user interface |
'*   | ShowStatus | Boolean | If TRUE show a text with the full path info     |
'*   +------------+---------+-------------------------------------------------+
'*
'* Class Methods
'*
'*   +-------------------+----------------------------------------------------+
'*   | Name              | Description                                        |
'*   +-------------------+----------------------------------------------------+
'*   | BrowseForComputer | Parameters : None                                  |
'*   |                   |                                                    |
'*   |                   | Display a dialog that allows the user browse for a |
'*   |                   | computer over a network.                           |
'*   +-------------------+----------------------------------------------------+
'*   | BrowseForFolder   | Parameters : None                                  |
'*   |                   |                                                    |
'*   |                   | Display a dialog that allows the user browse for a |
'*   |                   | folder.                                            |
'*   +-------------------+----------------------------------------------------+
'*   | BrowseForFolder   | Parameters : StartPath as String                   |
'*   |                   |                                                    |
'*   |                   | Display a dialog that allows the user browse for a |
'*   |                   | folder, starting from a specified path.            |
'*   +-------------------+----------------------------------------------------+
'*   | BrowseForFolder   | Parameters : StartLocation as CSIDL                |
'*   |                   |                                                    |
'*   |                   | Display a dialog that allows the user browse for a |
'*   |                   | folder, starting from a specified location.        |
'*   +-------------------+----------------------------------------------------+
'*   | BrowseForFile     | Parameters : None                                  |
'*   |                   |                                                    |
'*   |                   | Display a dialog that allows the user browse for a |
'*   |                   | file.                                              |
'*   +-------------------+----------------------------------------------------+
'*   | BrowseForFile     | Parameters : StartPath as String                   |
'*   |                   |                                                    |
'*   |                   | Display a dialog that allows the user browse for a |
'*   |                   | file, starting from a specified path.              |
'*   +-------------------+----------------------------------------------------+
'*   | BrowseForFile     | Parameters : StartLocation as CSIDL                |
'*   |                   |                                                    |
'*   |                   | Display a dialog that allows the user browse for a |
'*   |                   | file, starting from a specified location.          |
'*   +-------------------+----------------------------------------------------+
'*

Public Class clsFolderBrowser

#Region " Local Constants "

   '*
   '* Constants used by the Callback Function
   '*
   Private Const BFFM_INITIALIZED As Integer = 1
   Private Const BFFM_SELCHANGED As Integer = 2
   Private Const BFFM_VALIDATEFAILED As Integer = 3
   Private Const BFFM_ENABLEOK As Integer = &H465
   Private Const BFFM_SETSELECTIONA As Integer = &H466
   Private Const BFFM_SETSTATUSTEXT As Integer = &H464

   '*
   '* Constants used to specify the type of browsing
   '*
   Private Const BIF_EDITBOX As Short = &H10
   Private Const BIF_VALIDATE As Short = &H20
   Private Const BIF_STATUSTEXT As Short = &H4
   Private Const BIF_NEWDIALOGSTYLE As Short = &H40
   Private Const BIF_DONTGOBELOWDOMAIN As Short = &H2

   Private Const BIF_RETURNONLYFSDIRS As Short = &H1
   Private Const BIF_RETURNFSANCESTORS As Short = &H8

   Private Const BIF_BROWSEFORPRINTER As Short = &H2000
   Private Const BIF_BROWSEFORCOMPUTER As Short = &H1000

   Private Const BIF_BROWSEINCLUDEFILES As Short = &H4000

   '*
   '* Maximum size of a string for a path
   '*
   Private Const MAX_PATH As Short = 260

#End Region

#Region " Local Enumeration and Structures "

   '*
   '* These are the values for special folders in a Windows environment
   '*
   Public Enum CSIDL
       ADMINTOOLS = &H30
       ALTSTARTUP = &H1D
       APPDATA = &H1A
       BITBUCKET = &HA
       CDBURN_AREA = &H3B
       COMMON_ADMINTOOLS = &H2F
       COMMON_ALTSTARTUP = &H1E
       COMMON_APPDATA = &H23
       COMMON_DESKTOPDIRECTORY = &H19
       COMMON_DOCUMENTS = &H2E
       COMMON_FAVORITES = &H1F
       COMMON_MUSIC = &H35
       COMMON_OEM_LINKS = &H3A
       COMMON_PICTURES = &H36
       COMMON_PROGRAMS = &H17
       COMMON_STARTMENU = &H16
       COMMON_STARTUP = &H18
       COMMON_TEMPLATES = &H2D
       COMMON_VIDEO = &H37
       COMPUTERSNEARME = &H3D
       CONNECTIONS = &H31
       CONTROLS = &H3
       COOKIES = &H21
       DESKTOP = &H0
       DESKTOPDIRECTORY = &H10
       DRIVES = &H11
       FAVORITES = &H6
       FLAG_CREATE = &H8000
       FLAG_DONT_VERIFY = &H4000
       FLAG_MASK = &HFF00
       FLAG_NO_ALIAS = &H1000
       FLAG_PER_USER_INIT = &H800
       FONTS = &H14
       HISTORY = &H22
       INTERNET = &H1
       INTERNET_CACHE = &H20
       LOCAL_APPDATA = &H1C
       MYDOCUMENTS = &HC
       MYMUSIC = &HD
       MYPICTURES = &H27
       MYVIDEO = &HE
       NETHOOD = &H13
       NETWORK = &H12
       PERSONAL = &H5
       PRINTERS = &H4
       PRINTHOOD = &H1B
       PROFILE = &H28
       PROGRAM_FILES = &H26
       PROGRAM_FILES_COMMON = &H2B
       PROGRAM_FILES_COMMONX86 = &H2C
       PROGRAM_FILESX86 = &H2A
       PROGRAMS = &H2
       RECENT = &H8
       RESOURCES = &H38
       RESOURCES_LOCALIZED = &H39
       SENDTO = &H9
       STARTMENU = &HB
       STARTUP = &H7
       SYSTEM = &H25
       SYSTEMX86 = &H29
       TEMPLATES = &H15
       WINDOWS = &H24
   End Enum

   '*
   '* Structure for Browsing
   '*
   Private Structure BROWSEINFO
       Dim hOwner As IntPtr
       Dim pidlRoot As Integer
       Dim pszDisplayName As String
       Dim lpszTitle As String
       Dim ulFlags As Integer
       Dim lpfn As fbCallBack
       Dim lParam As IntPtr
       Dim iImage As Integer
   End Structure

#End Region

#Region " Local DLL Declarations - .NET style "

   '*
   '* Delegate Function used as a pointer for the real callback function
   '*
   Private Delegate Function fbCallBack( _
           ByVal hWnd As IntPtr, _
           ByVal uMsg As Integer, _
           ByVal lParam As Integer, _
           ByVal lpData As Integer) As Integer

   <DllImport("ole32.dll")> _
   Private Shared Sub CoTaskMemFree(ByVal addr As IntPtr)
   End Sub

   <DllImport("user32.dll")> _
   Private Overloads Shared Function SendMessage( _
           ByVal hWnd As IntPtr, _
           ByVal uMsg As Integer, _
           ByVal lParam As Integer, _
           ByVal lpData As Integer) As Integer
   End Function

   <DllImport("user32.dll")> _
   Private Overloads Shared Function SendMessage( _
           ByVal hWnd As IntPtr, _
           ByVal uMsg As Integer, _
           ByVal lParam As Integer, _
           ByVal lpData As String) As Integer
   End Function

   <DllImport("shell32.dll", CharSet:=CharSet.Ansi)> _
   Private Shared Function SHBrowseForFolder(ByRef lpBrowseInfo As BROWSEINFO) As IntPtr
   End Function

   <DllImport("shell32.dll", CharSet:=CharSet.Ansi)> _
   Private Shared Function SHGetPathFromIDList( _
           ByVal pidl As IntPtr, _
           ByVal pszPath As StringBuilder) As Integer
   End Function

   <DllImport("shell32.dll", CharSet:=CharSet.Ansi)> _
   Private Shared Function SHGetSpecialFolderLocation( _
           ByVal hWnd As IntPtr, _
           ByVal nFolder As Integer, _
           ByRef pidl As Integer) As Integer
   End Function

#End Region

#Region " Local Variables "

   Private flgInit As Boolean
   Private flgNewUI As Boolean = False
   Private stcBrowseInfo As BROWSEINFO
   Private flgShowStatus As Boolean = False

#End Region

#Region " Local Functions "

   '*
   '* Displays the dialog, based on information stored on a BrowseInfo Structure
   '*
   Private Function DoBrowse(ByVal StartPath As String) As String

       Dim iprtSelectDir As IntPtr
       Dim strDirSelect As String

       '*
       '* Add the proper flags
       '*
       If flgNewUI Then stcBrowseInfo.ulFlags += BIF_NEWDIALOGSTYLE
       If flgShowStatus Then stcBrowseInfo.ulFlags += BIF_STATUSTEXT

       '*
       '* Identify for the Callback Function that it was inicialized
       '*
       flgInit = True

       '*
       '* Specify the StartPath for SHBrowseForFolder
       '*
       stcBrowseInfo.lParam = Marshal.StringToHGlobalAnsi(StartPath)

       '*
       '* Fill pszDisplayName with spaces so SHBrowseForFolder can return a computer name
       '*
       stcBrowseInfo.pszDisplayName = Space(MAX_PATH)

       iprtSelectDir = SHBrowseForFolder(stcBrowseInfo)

       '*
       '* If the selected item is a computer, the iprtSelectDir returns
       '* no dir but the pszDisplayName contains the computer name.
       '*
       If (GetFSPath(iprtSelectDir) = "") Then
           strDirSelect = "\\" & Trim(stcBrowseInfo.pszDisplayName)
       Else
           strDirSelect = GetFSPath(iprtSelectDir)
       End If

       '*
       '* Free the ressource alloced by SHBrowseForFolder
       '*
       Call CoTaskMemFree(iprtSelectDir)

       '*
       '* Return the selected Dir or Computer
       '*
       Return strDirSelect

   End Function

   '*
   '* SHBrowseForFolder Callback function
   '*
   Private Function BrowseCallbackProc( _
           ByVal hWnd As IntPtr, _
           ByVal uMsg As Integer, _
           ByVal lParam As Integer, _
           ByVal lpData As Integer) As Integer

       If uMsg = BFFM_INITIALIZED Then
           SendMessage(hWnd, BFFM_SETSELECTIONA, 1, lpData)
           flgInit = False
       ElseIf uMsg = BFFM_SELCHANGED And Not flgInit Then
           SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, GetFSPath(New IntPtr(lParam)))
       End If

   End Function

   '*
   '* Returns the actual path from a pointer
   '*
   Private Function GetFSPath(ByVal pidl As IntPtr) As String

       Dim strPath As New StringBuilder(MAX_PATH)

       '*
       '* Checks if the pointer is invalid
       '*
       If pidl.Equals(IntPtr.Zero) Then
           Return ""
       Else
           '*
           '* Get the actual path from the list
           '*
           If SHGetPathFromIDList(pidl, strPath) = 1 Then
               Return strPath.ToString()
           End If
       End If

   End Function

#End Region

#Region " Public Procedures and Properties "

   '*
   '* Class Constructor
   '*
   Public Sub New(ByVal Handle As IntPtr)

       stcBrowseInfo.hOwner = Handle
       stcBrowseInfo.lpfn = AddressOf BrowseCallbackProc

   End Sub

#Region " Browse for Computers "
   '*
   '* Displays a common dialog and selects only computers over a Network
   '*
   Public Function BrowseForComputers() As String

       SHGetSpecialFolderLocation(stcBrowseInfo.hOwner, CSIDL.NETWORK, stcBrowseInfo.pidlRoot)
       stcBrowseInfo.ulFlags = BIF_BROWSEFORCOMPUTER
       Return DoBrowse("")

   End Function
#End Region

#Region " Browse for Folder "
   '*
   '* Displays a dialog that allows the user select a folder
   '*
   Public Overloads Function BrowseForFolder() As String

       stcBrowseInfo.pidlRoot = 0
       stcBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS
       Return DoBrowse("")

   End Function

   '*
   '* Displays a dialog that allows the user select a folder, starting from a specified dir.
   '*
   Public Overloads Function BrowseForFolder(ByVal StartPath As String) As String

       stcBrowseInfo.pidlRoot = 0
       stcBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS
       Return DoBrowse(StartPath)

   End Function

   '*
   '* Displays a dialog that allows the user select a folder, starting from a specified CSIDL
   '*
   Public Overloads Function BrowseForFolder(ByVal StartLocation As CSIDL) As String

       SHGetSpecialFolderLocation(stcBrowseInfo.hOwner, StartLocation, stcBrowseInfo.pidlRoot)
       stcBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS
       Return DoBrowse("")

   End Function

#End Region

#Region " Browse for Files "

   '*
   '* Displays a dialog that allows the user select a file.
   '*
   Public Overloads Function BrowseForFiles() As String

       stcBrowseInfo.pidlRoot = 0
       stcBrowseInfo.ulFlags = BIF_BROWSEINCLUDEFILES
       Return DoBrowse("")

   End Function

   '*
   '* Displays a dialog that allows the user select a file, starting from a specified dir.
   '*
   Public Overloads Function BrowseForFiles(ByVal StartPath As String) As String

       stcBrowseInfo.pidlRoot = 0
       stcBrowseInfo.ulFlags = BIF_BROWSEINCLUDEFILES
       Return DoBrowse(StartPath)

   End Function

   '*
   '* Displays a dialog that allows the user select a file, starting from a specified CSIDL.
   '*
   Public Overloads Function BrowseForFiles(ByVal StartLocation As CSIDL) As String

       SHGetSpecialFolderLocation(stcBrowseInfo.hOwner, StartLocation, stcBrowseInfo.pidlRoot)
       stcBrowseInfo.ulFlags = BIF_BROWSEINCLUDEFILES
       Return DoBrowse("")

   End Function

#End Region

#Region " Public Properties "

   '*
   '* Specifies the Title to by shown on the Browse for Folder dialog
   '*
   Public Property Title() As String

       Get
           Return stcBrowseInfo.lpszTitle
       End Get

       Set(ByVal Value As String)
           stcBrowseInfo.lpszTitle = Value
       End Set

   End Property

   '*
   '* Flag indicating if SHBrowseForFolder will use the New User Interface.
   '*
   Public Property NewUI() As Boolean

       Get
           Return flgNewUI
       End Get

       Set(ByVal Value As Boolean)
           flgNewUI = Value
       End Set

   End Property

   '*
   '* Flag indicating if SHBrowseForFolder will show the Status.
   '*
   Public Property ShowStatus() As Boolean

       Get
           Return flgShowStatus
       End Get

       Set(ByVal Value As Boolean)
           flgShowStatus = Value
       End Set

   End Property

#End Region

#End Region

End Class

You might also like...

Comments

 MstrControl For the last twelve years I've been working for several companies, varying in sizes and actuation areas, but always trying to improve myself as well the company I was working for. I have deep exper...

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“Better train people and risk they leave – than do nothing and risk they stay.” - Anonymous