SHBrowseForFolder: Handling a choice of Libraries (or Library), Computer, or Network

[fafalone]

ChooseFolderEx

Project Summary
So if you've ever used a folder choose based on SHBrowseForFolder, you'll notice that most functions that turn its result (a pidl) into a file system path will return nothing, or at best a cryptic string starting with :: (followed by a GUID). But things like Libraries, My Computer, and Network contain folders- and if you're going to be doing something like searching for files, the user may well expect that selecting one of those would search its locations. Thanks to oleexp, the code to find out what those folders are is at least somewhat manageable.

Project Requirements
-At least Windows Vista; Libraries are a Win7+ thing.
-oleexp.tlb - my fork of olelib with modern interfaces (get it here). This must be added as a reference under Project->References, but doesn't need to be included with a compiled program. This project has been updated to reference oleexp.tlb v4.0 or higher.

---

So we begin with calling the Browse API; the wrapper called here is just a standard routine.

Public Function SelectFolderEx(hWnd As Long, sPrompt As String, dwFlags As BF_Flags, out_Folders() As String, Optional sStartDir As String, Optional sRoot As String) As Long
'Enhanced folder chooser
Dim pidlStart As Long
Dim pidlRoot As Long
Dim lpRes As Long, szRes As String
ReDim out_Folders(0)
If sStartDir <> "" Then
    pidlStart = ILCreateFromPathW(StrPtr(sStartDir))
End If
If sRoot <> "" Then
    pidlRoot = ILCreateFromPathW(StrPtr(sRoot))
End If

lpRes = BrowseDialogEx(hWnd, sPrompt, dwFlags, pidlRoot, pidlStart)
If lpRes = 0 Then
    SelectFolderEx = -1
    Exit Function
End If


szRes = GetPathFromPIDLW(lpRes)
If (szRes = "") Or (szRes = vbNullChar) Then
    'here's where we do some magic. if GetPathFromPIDLW returned nothing, but we did receive
    'a valid pidl, we may have a location that still might be valid. at this time, i've made
    'functions that will return the paths for the Library object, any individual library,
    'My Computer, and the main Network object and network paths
    Dim sAPP As String 'absolute parsing path
    sAPP = GetAbsoluteParsingPath(lpRes)
    If (Left$(sAPP, 2) = "\\") Or (Left$(sAPP, 2) = "//") Then
        'network locations can't be resolved as normal, but are valid locations
        'for most things you'll be passing a folder location to, including FindFirstFile
        'the only caveat here, is the network pc itself resolves here but can't be passed
        'so we want it enumed too, but not past that
        
        Dim sTMP As String
        sTMP = Mid$(sAPP, 3)
        If (InStr(sTMP, "/") = 0) And (InStr(sTMP, "\") = 0) Then
            'so this should be a top-level computer needing to be enum'd
            SelectFolderEx = EnumSpecialObjectPaths(sAPP, out_Folders)
            GoTo cfdone
        End If
        out_Folders(0) = sAPP
        SelectFolderEx = 1
        GoTo cfdone

    End If
    SelectFolderEx = EnumSpecialObjectPaths(sAPP, out_Folders)
Else
    out_Folders(0) = szRes
    SelectFolderEx = 1
End If

cfdone:
Call CoTaskMemFree(lpRes)
End Function

The difference here is that instead of giving up and returning a blank or error if we don't get a path, we're going to check to see if it's an object that does contain file system folders.

The next step is to see which, if any, object we can enumerate:

Public Function EnumSpecialObjectPaths(szID As String, sPaths() As String) As Long
'objects like Libraries and My Computer can't be passed to a file search algorithm
'but they contain objects which can. this function enumerates the searchable paths
'return value is the count of sPaths, or -1 if the GUID was not an enumerable loc
Debug.Print "esop enter " & szID
    If szID = FolderGUID_Computer Then
        'here we can just use the GetLogicalDriveStrings API
        Dim sBuff As String * 255
        Dim i As Long
        i = GetLogicalDriveStrings(255, sBuff)
        sPaths = Split(Left$(sBuff, i - 1), Chr$(0))

    ElseIf (szID = FolderGUID_Libraries) Then 'library master
        ListAllLibraryPaths sPaths
        
    ElseIf (Left$(szID, 41) = FolderGUID_Libraries & "\") Then 'specific library
        ListLibraryPaths szID, sPaths
    
    ElseIf (szID = FolderGUID_Network) Then 'Network master
        ListNetworkLocs sPaths
        
    ElseIf (Left$(szID, 2) = "\\") Then
        ListNetComputerLocs szID, sPaths
        
    Else 'not supported or not file system
        EnumSpecialObjectPaths = -1
        Exit Function
    End If

EnumSpecialObjectPaths = UBound(sPaths) + 1

End Function

For My Computer, the job was easy, just had to call the GetLogicalDriveStrings API.
For the rest, we need a more complex enumerator. This is made possible by the fact IShellItem can represent anything, and can enumerate anything, not just normal folders.
There's 2 Library options; if an individual library is selected, that's still not a normal path so has to be handled here- the IShellLibrary interface can tell us which folders are included in the library, so we can go from there. The other is for the main 'Libraries' object being selected- there we get a list of all the libraries on the system (note that we can't just check the standard ones, because custom libraries can be created).
If the Network object is chosen, we filter it down to browseable network paths, since the enum also returns the various non-computer objects that appear there.

Public Sub ListAllLibraryPaths(sOut() As String)
'Lists all paths in all libraries
Dim psi As IShellItem
Dim piesi As IEnumShellItems
Dim psiLib As IShellItem
Dim isia As IShellItemArray
Dim pLibEnum As IEnumShellItems
Dim pLibChild As IShellItem
Dim lpPath As Long
Dim szPath As String
Dim pLib As ShellLibrary
Set pLib = New ShellLibrary
Dim nPaths As Long
Dim pclt As Long

ReDim sOut(0)

Call SHCreateItemFromParsingName(StrPtr(FolderGUID_Libraries), ByVal 0&, IID_IShellItem, psi)
If (psi Is Nothing) Then
    Debug.Print "could't parse lib master"
    Exit Sub
End If
psi.BindToHandler 0, BHID_EnumItems, IID_IEnumShellItems, piesi

Do While (piesi.Next(1, psiLib, pclt) = S_OK)
    psiLib.GetDisplayName SIGDN_NORMALDISPLAY, lpPath
    szPath = LPWSTRtoStr(lpPath)
    Debug.Print "Enumerating Library " & szPath
    pLib.LoadLibraryFromItem psiLib, STGM_READ
    pLib.GetFolders LFF_ALLITEMS, IID_IShellItemArray, isia
        
    isia.EnumItems pLibEnum

    Do While (pLibEnum.Next(1, pLibChild, 0) = 0)

        pLibChild.GetDisplayName SIGDN_FILESYSPATH, lpPath
        szPath = LPWSTRtoStr(lpPath, True)
        Debug.Print "lib folder->" & szPath
        If Len(szPath) > 2 Then
            ReDim Preserve sOut(nPaths)
            sOut(nPaths) = szPath
            nPaths = nPaths + 1
        End If
        Set pLibChild = Nothing

    Loop
    Set psiLib = Nothing
Loop
End Sub


Public Sub ListLibraryPaths(sPN As String, sOut() As String)
'list the paths of a single library
'sPN is the full parsing name- what is returned from ishellfolder.getdisplayname(SHGDN_FORPARSING)
Dim psiLib As IShellItem
Dim pLib As ShellLibrary
Set pLib = New ShellLibrary
Dim psia As IShellItemArray
Dim pEnum As IEnumShellItems
Dim psiChild As IShellItem
Dim lpPath As Long, szPath As String, nPaths As Long
Dim pclt As Long

Call SHCreateItemFromParsingName(StrPtr(sPN), ByVal 0&, IID_IShellItem, psiLib)
If (psiLib Is Nothing) Then
    Debug.Print "Failed to load library item"
    Exit Sub
End If
pLib.LoadLibraryFromItem psiLib, STGM_READ
pLib.GetFolders LFF_ALLITEMS, IID_IShellItemArray, psia
If (psia Is Nothing) Then
    Debug.Print "Failed to enumerate library"
    Exit Sub
End If

ReDim sOut(0)
psia.EnumItems pEnum

Do While (pEnum.Next(1, psiChild, pclt) = S_OK)
    If (psiChild Is Nothing) = False Then
        psiChild.GetDisplayName SIGDN_FILESYSPATH, lpPath
        szPath = LPWSTRtoStr(lpPath)
        If Len(szPath) > 2 Then
            ReDim Preserve sOut(nPaths)
            sOut(nPaths) = szPath
            nPaths = nPaths + 1
        End If
    End If
    Set psiChild = Nothing
Loop
Set pEnum = Nothing
Set psia = Nothing
Set pLib = Nothing
Set psiLib = Nothing
End Sub


Public Sub ListNetworkLocs(sOut() As String) '
Dim psi As IShellItem
Dim piesi As IEnumShellItems
Dim psiNet As IShellItem
Dim isia As IShellItemArray
Dim pNetEnum As IEnumShellItems
Dim pNetChild As IShellItem
Dim lpPath As Long
Dim szPath As String
Dim nPaths As Long
Dim pclt As Long

Call SHCreateItemFromParsingName(StrPtr(FolderGUID_Network), ByVal 0&, IID_IShellItem, psi)
If psi Is Nothing Then Exit Sub
ReDim sOut(0)
psi.BindToHandler 0, BHID_EnumItems, IID_IEnumShellItems, piesi
Do While (piesi.Next(1, pNetChild, pclt) = S_OK)
    pNetChild.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpPath
    szPath = LPWSTRtoStr(lpPath)
    If (Left$(szPath, 2) = "//") Or (Left$(szPath, 2) = "\\") Then 'objects besides valid paths come up, like routers, devices, etc
                                    'but they don't start with //, only searchable network locations should
        Debug.Print "netpath " & szPath
        ReDim Preserve sOut(nPaths)
        sOut(nPaths) = szPath
        nPaths = nPaths + 1
    End If
    Set pNetChild = Nothing
Loop
Set piesi = Nothing
Set psi = Nothing
End Sub


Public Sub ListNetComputerLocs(szID As String, sOut() As String)
'lists an individual network computer
Dim psiComp As IShellItem
Dim pEnum As IEnumShellItems
Dim psiChild As IShellItem
Dim lpPath As Long
Dim szPath As String
Dim nPaths As Long
Dim pclt As Long
Debug.Print "ListNetComputerLocs " & szID
Call SHCreateItemFromParsingName(StrPtr(szID), ByVal 0&, IID_IShellItem, psiComp)
If psiComp Is Nothing Then Exit Sub
ReDim sOut(0)
psiComp.BindToHandler 0, BHID_EnumItems, IID_IEnumShellItems, pEnum
Do While (pEnum.Next(1, psiChild, pclt) = S_OK)
    psiChild.GetDisplayName SIGDN_DESKTOPABSOLUTEPARSING, lpPath
    szPath = LPWSTRtoStr(lpPath)
    If Len(szPath) > 2 Then
        Debug.Print "netpath " & szPath
        ReDim Preserve sOut(nPaths)
        sOut(nPaths) = szPath
        nPaths = nPaths + 1
    End If
Loop

End Sub

The results of this are normal file system paths you can treat like normal results that never returned a blank.

Everything there is designed to support Unicode; but the VB textbox in the sample can't display it. But if you pass the results to something Unicode enabled, like a TextBoxW for example, you'll see the correct names.