Visual Basic Browse/ PIDL / CSIDL Routines
SHBrowseForFolder: Browse to Obtain Network Machines or Shares
     
Posted:   Tuesday November 30, 1999
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   VBnet - Randy Birch
     
Related:  

Browse:
SHBrowseForFolder: Browse Folders Dialog Overview
SHBrowseForFolder: Browse for Folders Dialog
SHBrowseForFolder: Browse for Folders Callback Overview
SHBrowseForFolder: Browse for Folders New UI Features
SHBrowseForFolder: Pre-selecting Folders using a Browse Callback

CSIDL / Folders:
SHGetFolderPath: Overview of Shell and ComCtrl Versions, CSIDL Values
SHGetFolderPath: Retrieve Windows Shell Folders (Best Practice)
SHGetSpecialFolderLocation: Retrieve Windows Shell Folder
SHGetKnownFolderPath: Retrieve Windows Known (Shell) Folders under Vista
Pure VB: Using the Shell Application Object to Retrieve Windows Shell Folders

Windows / Shell Versions:
GetFileVersionInfo: Handy Routines for Identifying Shell32 Versions
GetVersionEx: Windows Version Info (Wrapper Routines)

   
 Prerequisites
To test, a network connection or shared folders on the local system. Note that the NEW UI enhancements require Shell version 5 or 6.

Amongst the Browse dialog's uFlags options is the ability to specify BIF_BROWSEFORCOMPUTER to only return computers. If the user selects anything other than a computer, the OK button is greyed. But this method has its problems - the user can only select servers or workstations, not the shares they contain. In addition, although a valid pidl (pointer to an item ID list) is returned, the server can not be retrieved using this pidl in a call to SHGetPathFromIDList because a server is not a valid file system object.

This page presents two workarounds to these limitations by providing two wrapper functions that return either the share name in the familiar \\serverX format, or the full path to the share (i.e. \\serverX\projects\files). Both use the SHBrowseForFolder API call to display the available shares and folders, but because of the parameters set in the BROWSEINFO structure, provides the ability to retrieve this information from the dialog.

See the Overview discussion above for more information on the options available with the Browse for Files dialog.

 BAS Module Code
None.

 Form Code
To a project form add two command buttons (Command1, Command2), two text boxes (Text1, Text2), and two check boxes (Check1, Check2). Add the following code to the form:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private Const NOERROR As Long = 0
Private Const MAX_PATH As Long = 260
Private Const CSIDL_NETWORK As Long = &H12
Private Const CSIDL_PRINTERS As Long = &H4

'For finding a folder to start document searching
Private Const BIF_RETURNONLYFSDIRS As Long = &H1

'For starting the Find Computer
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2

'Top of the dialog has 2 lines of text for
'BROWSEINFO.lpszTitle and one line if this flag is set.
'Passing the message BFFM_SETSTATUSTEXTA to the hwnd
'can set the rest of the text.  This is not used with
'BIF_USENEWUI and BROWSEINFO.lpszTitle gets all three
'lines of text.
Private Const BIF_STATUSTEXT As Long = &H4

Private Const BIF_RETURNFSANCESTORS As Long = &H8

'Add an editbox to the dialog: SHELL 5.0 or later only!
Private Const BIF_EDITBOX As Long = &H10

'insist on valid result (or CANCEL)
Private Const BIF_VALIDATE As Long = &H20

'Use the new dialog layout with the ability 
'to resize: SHELL 5.0 or later only!
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_USENEWUI As Long = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)

'Allow URLs to be displayed or entered 
'(Requires BIF_USENEWUI): SHELL 5.0 or later only!
Private Const BIF_BROWSEINCLUDEURLS As Long = &H80

'Add a UA hint to the dialog, in place of the
'edit box. May not be combined with BIF_EDITBOX: SHELL 6.0 or later only!
Private Const BIF_UAHINT As Long = &H100

'Do not add the "New Folder" button to the dialog.
'Only applicable with BIF_NEWDIALOGSTYLE: SHELL 5.0 or later only!
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200

'Browsing for Computers
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000

'Browsing for Printers
Private Const BIF_BROWSEFORPRINTER As Long = &H2000

'Browsing for Everything
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000

'sharable resources displayed (remote shares, 
'requires BIF_USENEWUI): SHELL 5.0 or later only!
Private Const BIF_SHAREABLE As Long = &H8000&

Private Type BROWSEINFO    'bi
   hOwner As Long
   pidlRoot As Long
   pszDisplayName As String   'return display name of item selected
   lpszTitle As String        'text to go in the banner over the tree
   ulFlags As Long            'flags that control the return stuff
   lpfn As Long
   lParam As Long             'extra info passed back in callbacks
   iImage As Long             'output var: where to return the Image index
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
   Alias "SHGetPathFromIDListA" _
  (ByVal pidl As Long, _
   ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
   Alias "SHBrowseForFolderA" _
  (lpBrowseInfo As BROWSEINFO) As Long

Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
  (ByVal hwndOwner As Long, _
   ByVal nFolder As Long, _
   pidl As Long) As Long
   
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long



Private Sub Form_Load()

   Command1.Caption = "Get Network Workstation"
   Command2.Caption = "Get Network Share"
   Check1.Caption = "Use New UI"
   Check2.Caption = "No 'New Folder' Button"
   Text1.Text = ""
   Text2.Text = ""
   
End Sub


Private Sub Command1_Click()
   
   Dim bNewDialog As Boolean
   Dim bNoNewFolder As Boolean
   
   bNewDialog = Check1.Value = vbChecked  '=True or False
   bNoNewFolder = Check2.Value = vbChecked  '=True or False
   
   Text1.Text = GetBrowseNetworkWorkstation(Me.hwnd, bNewDialog, bNoNewFolder)

End Sub


Private Sub Command2_Click()

   Dim bNewDialog As Boolean
   Dim bNoNewFolder As Boolean
   
   bNewDialog = Check1.Value = vbChecked
   bNoNewFolder = Check2.Value = vbChecked
   
   Text2.Text = GetBrowseNetworkShare(Me.hwnd, bNewDialog, bNoNewFolder)

End Sub


Private Function GetBrowseNetworkShare(hwndOwner As Long, _
                                       bNewDialog As Boolean, _
                                       bNoNewFolder As Boolean) As String

  'returns only a valid share on a
  'network server or workstation
   Dim bi As BROWSEINFO
   Dim pidl As Long
   Dim spath As String
   
  'obtain the pidl to the special folder 'network'
   If SHGetSpecialFolderLocation(hwndOwner, _
                                 CSIDL_NETWORK, _
                                 pidl) = NOERROR Then
        
     'fill in the required members, limiting the
     'Browse to the network by specifying the
     'returned pidl as pidlRoot
      With bi
         .hOwner = hwndOwner
         .pidlRoot = pidl
         .pszDisplayName = Space$(MAX_PATH)
         .lpszTitle = "Select a network computer or share."
         .ulFlags = BIF_RETURNONLYFSDIRS
         If bNewDialog Then .ulFlags = .ulFlags Or BIF_NEWDIALOGSTYLE
         If bNoNewFolder Then .ulFlags = .ulFlags Or BIF_NONEWFOLDERBUTTON

      End With
       
     'show the browse dialog and return
     'the PIDL for the selected folder
      pidl = SHBrowseForFolder(bi)
         
      If pidl <> 0 Then
         
        'got a PIDL .. is it valid?
         spath = Space$(MAX_PATH)
         If SHGetPathFromIDList(ByVal pidl, ByVal spath) Then
               
           'valid, so get the share path
            GetBrowseNetworkShare = TrimNull(spath)
               
         Else
               
           'a server selected...follow same principle
           'as in GetBrowseNetworkWorkstation
            GetBrowseNetworkShare = "\\" & bi.pszDisplayName

         End If 'If SHGetPathFromIDList
      End If 'If pidl
      
      Call CoTaskMemFree(pidl)
      
   End If 'If SHGetSpecialFolderLocation

End Function


Private Function GetBrowseNetworkWorkstation(hwndOwner As Long, _
                                             bNewDialog As Boolean, _
                                             bNoNewFolder As Boolean) As String

  'returns only a valid network server or
  'workstation (does not display the shares)
   Dim bi As BROWSEINFO
   Dim pidl As Long
   Dim spath As String
   
   If SHGetSpecialFolderLocation(hwndOwner, _
                                 CSIDL_NETWORK, _
                                 pidl) = NOERROR Then
   
     'fill in the required members
      With bi
         .hOwner = hwndOwner
         .pidlRoot = pidl
         .pszDisplayName = Space$(MAX_PATH)
         .lpszTitle = "Select a network computer."
         .ulFlags = BIF_BROWSEFORCOMPUTER
         If bNewDialog Then .ulFlags = .ulFlags Or BIF_NEWDIALOGSTYLE
         If bNoNewFolder Then .ulFlags = .ulFlags Or BIF_NONEWFOLDERBUTTON
      End With
         
      pidl = SHBrowseForFolder(bi)
      
      If pidl <> 0 Then
               
        'a machine is selected. Although a valid pidl
        'is returned, SHGetPathFromIDList only return
        'paths to valid file system objects, of which
        'a networked machine is not. However, the
        'BROWSEINFO displayname member does contain
        'the selected item, which we return
         GetBrowseNetworkWorkstation = "\\" & bi.pszDisplayName
            
         Call CoTaskMemFree(pidl)
            
      End If  'If pidl
   End If  'If SHGetSpecialFolderLocation
   
End Function

         
Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
   
End Function
 Comments

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter