I made this test in a Button click, it enumerates network devices on my OS (Windows 10 22H2) but it must be improved, because I must launch n times the EnumDevices function, otherwise my printer is not listed if I launch it only once (I did not find why...)
Imports System.Runtime.InteropServices
Imports System.Runtime.InteropServices.ComTypes
Imports System.Text
Public Class Form1
Public Enum HRESULT As Integer
S_OK = 0
S_FALSE = 1
E_NOINTERFACE = &H80004002
E_NOTIMPL = &H80004001
E_FAIL = &H80004005
E_UNEXPECTED = &H8000FFFF
End Enum
<ComImport, InterfaceType(ComInterfaceType.InterfaceIsIUnknown), Guid("000214E6-0000-0000-C000-000000000046")>
Interface IShellFolder
Function ParseDisplayName(hwnd As IntPtr, pbc As IntPtr, <MarshalAs(UnmanagedType.LPWStr)> pszDisplayName As String, <[In], Out> ByRef pchEaten As UInteger, <Out> ByRef ppidl As IntPtr, <[In], Out> ByRef pdwAttributes As SFGAO) As HRESULT
Function EnumObjects(hwnd As IntPtr, grfFlags As SHCONTF, <Out> ByRef ppenumIDList As IEnumIDList) As HRESULT
Function BindToObject(pidl As IntPtr, pbc As IntPtr, <[In]> ByRef riid As Guid, <Out> <MarshalAs(UnmanagedType.[Interface])> ByRef ppv As Object) As HRESULT
Function BindToStorage(pidl As IntPtr, pbc As IntPtr, <[In]> ByRef riid As Guid, <Out> <MarshalAs(UnmanagedType.[Interface])> ByRef ppv As Object) As HRESULT
Function CompareIDs(lParam As IntPtr, pidl1 As IntPtr, pidl2 As IntPtr) As HRESULT
Function CreateViewObject(hwndOwner As IntPtr, <[In]> ByRef riid As Guid, <Out> <MarshalAs(UnmanagedType.[Interface])> ByRef ppv As Object) As HRESULT
Function GetAttributesOf(cidl As UInteger, apidl As IntPtr, <[In], Out> ByRef rgfInOut As SFGAO) As HRESULT
Function GetUIObjectOf(hwndOwner As IntPtr, cidl As UInteger, ByRef apidl As IntPtr, <[In]> ByRef riid As Guid, <[In], Out> ByRef rgfReserved As UInteger, <Out> ByRef ppv As IntPtr) As HRESULT
Function GetDisplayNameOf(pidl As IntPtr, uFlags As SHGDNF, <Out> ByRef pName As STRRET) As HRESULT
Function SetNameOf(hwnd As IntPtr, pidl As IntPtr, <MarshalAs(UnmanagedType.LPWStr)> pszName As String, uFlags As SHGDNF, <Out> ByRef ppidlOut As IntPtr) As HRESULT
End Interface
Public Enum SHCONTF
SHCONTF_CHECKING_FOR_CHILDREN = &H10
SHCONTF_FOLDERS = &H20
SHCONTF_NONFOLDERS = &H40
SHCONTF_INCLUDEHIDDEN = &H80
SHCONTF_INIT_ON_FIRST_NEXT = &H100
SHCONTF_NETPRINTERSRCH = &H200
SHCONTF_SHAREABLE = &H400
SHCONTF_STORAGE = &H800
SHCONTF_NAVIGATION_ENUM = &H1000
SHCONTF_FASTITEMS = &H2000
SHCONTF_FLATLIST = &H4000
SHCONTF_ENABLE_ASYNC = &H8000
SHCONTF_INCLUDESUPERHIDDEN = &H10000
End Enum
Public Enum SFGAO
CANCOPY = &H1
CANMOVE = &H2
CANLINK = &H4
STORAGE = &H8
CANRENAME = &H10
CANDELETE = &H20
HASPROPSHEET = &H40
DROPTARGET = &H100
CAPABILITYMASK = &H177
ENCRYPTED = &H2000
ISSLOW = &H4000
GHOSTED = &H8000
LINK = &H10000
SHARE = &H20000
[READONLY] = &H40000
HIDDEN = &H80000
DISPLAYATTRMASK = &HFC000
STREAM = &H400000
STORAGEANCESTOR = &H800000
VALIDATE = &H1000000
REMOVABLE = &H2000000
COMPRESSED = &H4000000
BROWSABLE = &H8000000
FILESYSANCESTOR = &H10000000
FOLDER = &H20000000
FILESYSTEM = &H40000000
HASSUBFOLDER = &H80000000
CONTENTSMASK = &H80000000
STORAGECAPMASK = &H70C50008
PKEYSFGAOMASK = &H81044000
End Enum
Public Enum SHGDNF
SHGDN_NORMAL = 0
SHGDN_INFOLDER = &H1
SHGDN_FOREDITING = &H1000
SHGDN_FORADDRESSBAR = &H4000
SHGDN_FORPARSING = &H8000
End Enum
<StructLayout(LayoutKind.Explicit, Size:=264)>
Public Structure STRRET
<FieldOffset(0)>
Public uType As UInteger
<FieldOffset(4)>
Public pOleStr As IntPtr
<FieldOffset(4)>
Public uOffset As UInteger
<FieldOffset(4)>
Public cString As IntPtr
End Structure
<ComImport, Guid("93F2F68C-1D1B-11d3-A30E-00C04F79ABD1"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown), ComConversionLoss>
Friend Interface IShellFolder2
Inherits IShellFolder
Overloads Function ParseDisplayName(hwnd As IntPtr, pbc As IntPtr, <MarshalAs(UnmanagedType.LPWStr)> pszDisplayName As String, <[In], Out> ByRef pchEaten As UInteger, <Out> ByRef ppidl As IntPtr, <[In], Out> ByRef pdwAttributes As SFGAO) As HRESULT
Overloads Function EnumObjects(hwnd As IntPtr, grfFlags As SHCONTF, <Out> ByRef ppenumIDList As IEnumIDList) As HRESULT
Overloads Function BindToObject(pidl As IntPtr, pbc As IntPtr, <[In]> ByRef riid As Guid, <Out> <MarshalAs(UnmanagedType.[Interface])> ByRef ppv As Object) As HRESULT
Overloads Function BindToStorage(pidl As IntPtr, pbc As IntPtr, <[In]> ByRef riid As Guid, <Out> <MarshalAs(UnmanagedType.[Interface])> ByRef ppv As Object) As HRESULT
Overloads Function CompareIDs(lParam As IntPtr, pidl1 As IntPtr, pidl2 As IntPtr) As HRESULT
Overloads Function CreateViewObject(hwndOwner As IntPtr, <[In]> ByRef riid As Guid, <Out> <MarshalAs(UnmanagedType.[Interface])> ByRef ppv As Object) As HRESULT
Overloads Function GetAttributesOf(cidl As UInteger, apidl As IntPtr, <[In], Out> ByRef rgfInOut As SFGAO) As HRESULT
Overloads Function GetUIObjectOf(hwndOwner As IntPtr, cidl As UInteger, ByRef apidl As IntPtr, <[In]> ByRef riid As Guid, <[In], Out> ByRef rgfReserved As UInteger, <Out> ByRef ppv As IntPtr) As HRESULT
Overloads Function GetDisplayNameOf(pidl As IntPtr, uFlags As SHGDNF, <Out> ByRef pName As STRRET) As HRESULT
Overloads Function SetNameOf(hwnd As IntPtr, pidl As IntPtr, <MarshalAs(UnmanagedType.LPWStr)> pszName As String, uFlags As SHGDNF, <Out> ByRef ppidlOut As IntPtr) As HRESULT
Function GetDefaultSearchGUID(<Out()> ByRef pguid As Guid) As HRESULT
Function EnumSearches(<Out()> ppenum As IntPtr) As HRESULT
Function GetDefaultColumn(<[In]()> dwRes As UInteger, <Out()> ByRef pSort As UInteger, <Out()> ByRef pDisplay As UInteger) As HRESULT
Function GetDefaultColumnState(<[In]()> iColumn As UInteger, <Out()> ByRef pcsFlags As UInteger) As HRESULT
<PreserveSig>
Function GetDetailsEx(<[In]()> pidl As IntPtr, <[In]()> ByRef pscid As PROPERTYKEY, <Out(), MarshalAs(UnmanagedType.Struct)> ByRef pv As Object) As HRESULT
Function GetDetailsOf(<[In]()> pidl As IntPtr, <[In]()> iColumn As UInteger, <Out()> ByRef psd As IntPtr) As HRESULT
Function MapColumnToSCID(<[In]()> iColumn As UInteger, <Out()> ByRef pscid As PROPERTYKEY) As HRESULT
End Interface
<ComImport, InterfaceType(ComInterfaceType.InterfaceIsIUnknown), Guid("000214F2-0000-0000-C000-000000000046")>
Interface IEnumIDList
<PreserveSig()>
Function [Next](celt As UInteger, <Out> ByRef rgelt As IntPtr, <Out> ByRef pceltFetched As Integer) As HRESULT
<PreserveSig()>
Function Skip(celt As UInteger) As HRESULT
Sub Reset()
Function Clone() As IEnumIDList
End Interface
<DllImport("shell32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
Public Shared Function SHParseDisplayName(<MarshalAs(UnmanagedType.LPWStr)> name As String, bindingContext As IntPtr,
<Out()> ByRef pidl As IntPtr, sfgaoIn As UInteger, <Out()> ByRef psfgaoOut As UInteger) As HRESULT
End Function
<DllImport("shell32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
Public Shared Function SHGetDesktopFolder(<MarshalAs(UnmanagedType.Interface)> ByRef ppshf As IShellFolder) As HRESULT
End Function
<DllImport("shlwapi.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
Public Shared Function StrRetToBuf(ByRef pstr As STRRET, pidl As IntPtr, pszBuf As StringBuilder, <MarshalAs(UnmanagedType.U4)> cchBuf As UInteger) As HRESULT
End Function
<DllImport("shell32.dll", SetLastError:=True, CharSet:=CharSet.Unicode)>
Public Shared Function SHGetKnownFolderIDList(ByRef rfid As Guid, dwFlags As Integer, hToken As IntPtr, ByRef pidl As IntPtr) As HRESULT
End Function
Private Shared FOLDERID_NetworkFolder As New Guid("D20BEEC4-5CA8-4905-AE3B-BF251EA09B53")
<StructLayout(LayoutKind.Sequential, Pack:=4)>
Public Structure PROPERTYKEY
Private ReadOnly _fmtid As Guid
Private ReadOnly _pid As UInteger
Public Sub New(fmtid As Guid, pid As UInteger)
_fmtid = fmtid
_pid = pid
End Sub
Public Shared ReadOnly PKEY_ItemNameDisplay As New PROPERTYKEY(New Guid("B725F130-47EF-101A-A5F1-02608C9EEBAC"), 10)
Public Shared ReadOnly PKEY_Devices_Category As New PROPERTYKEY(New Guid("78C34FC8-104A-4ACA-9EA4-524D52996E57"), 91)
Public Shared ReadOnly PKEY_Devices_CategoryGroup As New PROPERTYKEY(New Guid("78C34FC8-104A-4ACA-9EA4-524D52996E57"), 94)
Public Shared ReadOnly PKEY_Devices_PrimaryCategory As New PROPERTYKEY(New Guid("D08DD4C0-3A9E-462E-8290-7B636B2576B9"), 10)
Public Shared ReadOnly PKEY_Devices_CategoryIds As New PROPERTYKEY(New Guid("78C34FC8-104A-4ACA-9EA4-524D52996E57"), 90)
Public Shared ReadOnly PKEY_Category As New PROPERTYKEY(New Guid("D5CDD502-2E9C-101B-9397-08002B2CF9AE"), 2)
End Structure
Public Class DeviceInfo
Public Property Name As String
Public Property Category As String
End Class
Dim devices As New List(Of DeviceInfo)()
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
' shell:NetworkPlacesFolder
Dim pDesktopFolder As IShellFolder = Nothing
Dim hr As HRESULT = SHGetDesktopFolder(pDesktopFolder)
Dim pidlNetwork As IntPtr = IntPtr.Zero
hr = SHGetKnownFolderIDList(FOLDERID_NetworkFolder, 0, IntPtr.Zero, pidlNetwork)
If (hr = HRESULT.S_OK) Then
Dim ObjNetwork As Object = Nothing
hr = pDesktopFolder.BindToObject(pidlNetwork, IntPtr.Zero, GetType(IShellFolder).GUID, ObjNetwork)
If (hr = HRESULT.S_OK) Then
Dim pNetworkFolder As IShellFolder = DirectCast(ObjNetwork, IShellFolder)
' Printer not displayed the first time ?
Dim task As Task = Task.Run(Sub()
For i As Integer = 1 To 5
EnumDevices(pNetworkFolder)
Next
End Sub)
task.Wait()
Marshal.ReleaseComObject(pNetworkFolder)
For Each device In devices
Debug.WriteLine($"Name: {device.Name}, Category: {device.Category}")
Next
End If
End If
Marshal.ReleaseComObject(pDesktopFolder)
End Sub
Private Sub EnumDevices(pNetworkFolder As IShellFolder)
Dim pEnum As IEnumIDList = Nothing
'Dim hr As HRESULT = pNetworkFolder.EnumObjects(IntPtr.Zero, SHCONTF.SHCONTF_ENABLE_ASYNC Or SHCONTF.SHCONTF_FLATLIST Or SHCONTF.SHCONTF_FOLDERS Or SHCONTF.SHCONTF_INCLUDEHIDDEN Or SHCONTF.SHCONTF_NONFOLDERS, pEnum)
Dim hr As HRESULT = pNetworkFolder.EnumObjects(IntPtr.Zero, SHCONTF.SHCONTF_FLATLIST Or SHCONTF.SHCONTF_FOLDERS Or SHCONTF.SHCONTF_INCLUDEHIDDEN Or SHCONTF.SHCONTF_NONFOLDERS, pEnum)
If (hr = HRESULT.S_OK) Then
Dim pidlChild As IntPtr = IntPtr.Zero
Dim celtFetched As Integer = 0
While (pEnum.Next(1, pidlChild, celtFetched) = HRESULT.S_OK AndAlso celtFetched = 1)
Dim strretFolderName As STRRET
hr = pNetworkFolder.GetDisplayNameOf(pidlChild, SHGDNF.SHGDN_INFOLDER, strretFolderName)
Dim sDisplayName As String = Nothing
Dim sbDisplayName As New StringBuilder(256)
StrRetToBuf(strretFolderName, pidlChild, sbDisplayName, sbDisplayName.Capacity)
sDisplayName = sbDisplayName.ToString()
Dim pNetworkFolder2 As IShellFolder2 = DirectCast(pNetworkFolder, IShellFolder)
Dim vVariantCategory As Object = Nothing
Dim pkCategory As PROPERTYKEY = PROPERTYKEY.PKEY_Category
Dim sCategoryFull As String = Nothing
'0x80070648 ERROR_UNKNOWN_PROPERTY
hr = pNetworkFolder2.GetDetailsEx(pidlChild, pkCategory, vVariantCategory)
If (hr = HRESULT.S_OK) Then
If TypeOf vVariantCategory Is Array Then
Dim stringArray As String() = TryCast(vVariantCategory, String())
If stringArray IsNot Nothing Then
For Each str As String In stringArray
If (sCategoryFull = Nothing) Then sCategoryFull = str Else sCategoryFull += "; " + str
Next
End If
End If
End If
Dim device As New DeviceInfo() With {
.Name = sDisplayName,
.Category = sCategoryFull
}
If Not devices.Any(Function(d) d.Name = device.Name AndAlso d.Category = device.Category) Then
devices.Add(device)
End If
End While
Marshal.ReleaseComObject(pEnum)
End If
End Sub
End Class