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
clsFolderBrowser
By MstrControl, published on 11 Mar 2003
| Filed in
Source Code
You might also like...
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...
.NET forum discussion
-
edmonton female escort services near me
by canadapleasure (0 replies)
-
Bagaimana memenangkan $ 1,54 miliar dalam Mega Jutaan
by gametogelan (0 replies)
-
input integer from text file and output text file
by shmilon (0 replies)
-
cSharp stuck at exercise
by xander_Michiels (0 replies)
-
Need help in selected the Tax Audit Year from drop down menu and displaying results for the selected year
by citymumbai (0 replies)
.NET podcasts
-
.NET Rocks: Eric Lippert Talks About Project Roslyn
Published 9 years ago, running time 0h56m
Recorded on PI day, Carl and Richard talk to the one-and-only Eric Lippert from the C# Compiler team. But we don't only talk about C#! The conversation wanders around all the languages, a little F#, a little IronPython, heck, even VB.NET! Eric talks about Project Roslyn, Microsoft's efforts to ma.
Comments