Показать значок сетевой папки в списке просмотра VB.NET

Question

Как показать значок сетевой папки в виде списка? тот, с зеленой трубкой под папкой, у меня есть код, который отлично работает с файлами и папками, но при посещении другого компьютера по сети я не вижу сетевых папок, которые выглядят так, как эта.

что я должен добавить?

вот мой код: так я отображаю значок в ListView

Dim fPath As String = Form2.TextBox1.Text
Dim di = New DirectoryInfo(fPath)

  ' store imagelist index for known/found file types
  Dim exts As New Dictionary(Of String, Int32)

  If di.Exists = True Then
      Dim img As Image
      Dim lvi As ListViewItem
      For Each d In di.EnumerateDirectories("*.*", SearchOption.TopDirectoryOnly)
          lvi = New ListViewItem(d.Name)
          lvi.SubItems.Add("")
          lvi.SubItems.Add(d.CreationTime.Date)

          ListView1.Items.Add(lvi)

          img = NativeMethods.GetShellIcon(d.FullName)
          ImageList1.Images.Add(img)
          lvi.ImageIndex = ImageList1.Images.Count - 1
      Next

вот как я получаю иконки из shell32.

Partial Public Class NativeMethods
Private Const MAX_PATH As Integer = 256
Private Const NAMESIZE As Integer = 80
Private Const SHGFI_ICON As Int32 = &H100
<StructLayout(LayoutKind.Sequential)>
    Private Structure SHFILEINFO
        Public hIcon As IntPtr
        Public iIcon As Integer
        Public dwAttributes As Integer
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_PATH)>
        Public szDisplayName As String
        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=NAMESIZE)>
        Public szTypeName As String
    End Structure
    <DllImport("Shell32.dll")>
    Private Shared Function SHGetFileInfo(ByVal pszPath As String,
                                      ByVal dwFileAttributes As Integer,
                                      ByRef psfi As SHFILEINFO,
                                      ByVal cbFileInfo As Integer,
                                      ByVal uFlags As Integer) As IntPtr
    End Function
    <DllImport("user32.dll", SetLastError:=True)>
    Private Shared Function DestroyIcon(ByVal hIcon As IntPtr) As Boolean
    End Function
    Public Shared Function GetShellIcon(ByVal path As String) As Bitmap
        Dim shfi As SHFILEINFO = New SHFILEINFO()
        Dim ret As IntPtr = SHGetFileInfo(path, 0, shfi, Marshal.SizeOf(shfi), SHGFI_ICON)
        If ret <> IntPtr.Zero Then
            Dim bmp As Bitmap = System.Drawing.Icon.FromHandle(shfi.hIcon).ToBitmap
            DestroyIcon(shfi.hIcon)
            Return bmp
        Else
            Return Nothing
        End If
    End Function
End Class

Answer 1

Вы можете получить эту иконку от Shell32 как маленькое или большое изображение. Как указывает Коди Грей в комментарии, в "imageres.dll" больше значков (200+). Чтобы получить их по индексу, добавьте этот метод к NativeMethods учебный класс:

<DllImport("shell32.dll", CharSet:=CharSet.Auto)>
Private Shared Function ExtractIconEx(szFileName As String,
                            nIconIndex As Integer,
                            ByRef phiconLarge As IntPtr,
                            ByRef phiconSmall As IntPtr,
                            nIcons As UInteger) As UInteger
End Function

Private Shared ImgResFile As String = "imageres.dll"
Private Shared ShellFile As String = "shell32.dll"

Friend Shared Function GetShellIconByIndex(ndx As Int32,
                         largeIcon As Boolean = False,
                         Optional FromShell As Boolean = True) As Bitmap
    Dim largeIco As IntPtr
    Dim smallIco As IntPtr
    Dim thisIco As IntPtr
    Dim ico As Icon
    Dim bmp As Bitmap = Nothing

    Dim targtFile = If(FromShell, ShellFile, ImgResFile)
    ExtractIconEx(targtFile, ndx, largeIco, smallIco, 1)

    Try
        If largeIcon Then
            ico = Icon.FromHandle(largeIco)
            thisIco = largeIco
        Else
            ico = Icon.FromHandle(smallIco)
            thisIco = smallIco
        End If
        bmp = ico.ToBitmap()
    Catch ex As Exception           ' swallow exception to return nothing
        ' really stupid index values can throw ArgumentException
        ' when the result is IntPtr.Zero
        ' Rather than test it, catch it an any other(s)
    Finally
        DestroyIcon(thisIco)
    End Try

    Return bmp
End Function

Первый аргумент - это индекс значка, который вы хотите получить, второй указывает, хотите ли вы большую или маленькую версию, последний - необязательный флаг, из которого нужно выбрать imageres.dll против shell32.dll, Обратите внимание, что метод может привести Nothing если что-то пойдет не так.

Затем измените ваш цикл папок, чтобы получить изображение папки (#275) shell32.dll при обнаружении сетевого диска:

For Each d In di.EnumerateDirectories("*.*", SearchOption.TopDirectoryOnly)
    ...
    If IsNetworkFolder(d) Then
        ' get #275 as small image from Shell 
        img = NativeMethods.GetShellIconByIndex(275, False)
        If img Is Nothing Then
            ' ToDo: perhaps load a default image from Resources?
        End If
    Else
        img = NativeMethods.GetShellIcon(d.FullName)
        If img Is Nothing Then
            img = IconFromFile(d.FullName)
        End If
    End If
    '... add code 
Next

Private Function IsNetworkFolder(di As DirectoryInfo) As Boolean
    Dim drv As New DriveInfo(di.Root.Name)
    Return (drv.DriveType = DriveType.Network)
End Function

При этом используется вспомогательная функция, чтобы определить, подключена ли папка к сети или нет. Если это так, он выбирает этот конкретный значок папки, который является #275, из DLL. Результат:

Это же изображение папки также находится в imageres.dll как #137 (и #68 и #69 подобны с наложениями мира). Чтобы получить от этого вместо этого:

'  137 is the index, false for large icon, false to use imageres instead: 
img = NativeMethods.GetShellIconByIndex(137, False, False)

Если вы хотите избежать использования магических чисел в своем коде, используйте константы или перечисление используемых значков. Вы можете определить их все в NativeMethods класс, но это 500 предметов, и вы можете не вспомнить, что они означают 6 месяцев спустя:

Private Enum ShellIcons
    NetworkFolder1 = 275
    NetworkFolder2 = 103
    SharedFolder = 158
    AddNetworkFolder = 278
End Enum
...
img = NativeMethods.GetShellIconByIndex(ShellIcons.NetworkFolder1, False)

---

Это отобразит значки, хранящиеся в shell32.dll и их индекс в Listview установлен в LargeIcon Посмотреть, чтобы вы могли просматривать их:

Dim ndx As Int32 = 0
Dim img As Image = Nothing
Dim lvi As ListViewItem

Do
    ' change second Bool to False to get the ones in imageres.dll
    img = NativeMethods.GetShellIconByIndex(ndx, True, True)

    If img IsNot Nothing Then
        lvi = New ListViewItem(ndx.ToString)

        ImageList1.Images.Add(img)
        lvi.ImageIndex = ImageList1.Images.Count - 1
        myLV.Items.Add(lvi)
        ndx += 1
    Else
        Exit Do
    End If
Loop Until img Is Nothing