我已经设法使用 shell32 提取在列表视图中显示文件的图标，但是当对文件夹执行此操作时，图标似乎不显示。怎么会这样？
这是我的 Shell 提取代码：
' declare the Win32 API function SHGetFileInfo'
Public Declare Auto Function SHGetFileInfo Lib "shell32.dll" (ByVal pszPath As String, ByVal dwFileAttributes As Integer, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, ByVal uFlags As Integer) As IntPtr
' declare some constants that SHGetFileInfo requires'
Public Const SHGFI_ICON As Integer = &H100
Public Const SHGFI_SMALLICON As Integer = &H1
' define the SHFILEINFO structure'
Structure SHFILEINFO
Public hIcon As IntPtr
Public iIcon As Integer
Public dwAttributes As Integer
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=260)> _
Public szDisplayName As String
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=80)> _
Public szTypeName As String
End Structure
Function RetrieveShellIcon(ByVal argPath As String) As Image
Dim mShellFileInfo As SHFILEINFO
Dim mSmallImage As IntPtr
Dim mIcon As System.Drawing.Icon
Dim mCompositeImage As Image
mShellFileInfo = New SHFILEINFO
mShellFileInfo.szDisplayName = New String(Chr(0), 260)
mShellFileInfo.szTypeName = New String(Chr(0), 80)
mSmallImage = SHGetFileInfo(argPath, 0, mShellFileInfo, System.Runtime.InteropServices.Marshal.SizeOf(mShellFileInfo), SHGFI_ICON Or SHGFI_SMALLICON)
' create the icon from the icon handle'
Try
mIcon = System.Drawing.Icon.FromHandle(mShellFileInfo.hIcon)
mCompositeImage = mIcon.ToBitmap
Catch ex As Exception
' create a blank black bitmap to return'
mCompositeImage = New Bitmap(16, 16)
End Try
' return the composited image'
Return mCompositeImage
End Function
Function GetIcon(ByVal argFilePath As String) As Image
Dim mFileExtension As String = System.IO.Path.GetExtension(argFilePath)
' add the image if it doesn't exist''
If cIcons.ContainsKey(mFileExtension) = False Then
cIcons.Add(mFileExtension, RetrieveShellIcon(argFilePath))
End If
' return the image'
Return cIcons(mFileExtension)
End Function
这就是我显示文件图标的方式。
Dim lvi As ListViewItem
Dim di As New DirectoryInfo(Form2.TextBox1.Text)
Dim exts As New List(Of String)
ImageList1.Images.Clear()
If di.Exists = False Then
MessageBox.Show("Source path is not found", "Directory Not Found", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
For Each fi As FileInfo In di.EnumerateFiles("*.*")
lvi = New ListViewItem
lvi.Text = fi.Name
lvi.SubItems.Add(((fi.Length / 1024)).ToString("0.00"))
lvi.SubItems.Add(fi.CreationTime)
If exts.Contains(fi.Extension) = False Then
Dim mShellIconManager As New Form1
For Each mFilePath As String In My.Computer.FileSystem.GetFiles(Form2.TextBox1.Text)
ImageList1.Images.Add(fi.Extension, GetIcon(mFilePath))
exts.Add(fi.Extension)
Next
End If
lvi.ImageKey = fi.Extension
ListView1.Items.Add(lvi)
Next
这就是我显示文件夹图标的方式，但似乎不起作用
For Each fldr As String In Directory.GetDirectories(Form2.TextBox1.Text)
Dim mShellIconManager As New Form1
lvi = New ListViewItem
lvi.Text = Path.GetFileName(fldr)
lvi.SubItems.Add(((fldr.Length / 1024)).ToString("0.00"))
lvi.SubItems.Add(Directory.GetCreationTime(fldr))
ImageList1.Images.Add(GetIcon(fldr))
ListView1.Items.Add(lvi)
Next
您的代码中有几件事。其中一些看起来像是之前尝试的残留物。无论如何，这是有效的：
Public Partial 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(pszPath As String,
dwFileAttributes As Integer,
ByRef psfi As SHFILEINFO,
cbFileInfo As Integer,
uFlags As Integer) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function DestroyIcon(hIcon As IntPtr) As Boolean
End Function
Public Shared Function GetShellIcon(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
将 PInvoke 代码放入其自己的类中有几个好处。首先，它有助于将代码与所有这些幻数、结构和常量隔离开来。 PInvoke 可以是私有的并通过方法公开（GetShellIcon) 它完成所有 scut 工作并调用 API 方法。此外，当从 VS CodeAnalysis 工具中使用它时，它不会抱怨它。NativeMethods班级。
您的代码没有做的事情之一是销毁检索到的图标并释放该资源；还有你的SHGetFileInfo看起来不对，这可能会导致不好的事情。当它无法获取图标时，我不会在 PInvoke 代码中创建空白/空位图，而是返回Nothing供代码处理。
最后封装了PInvoke代码，使用起来更方便，也更短：
Dim fPath As String = "C:\Temp"
Dim di = New DirectoryInfo(fPath)
' store imagelist index for known/found file types
Dim exts As New Dictionary(Of String, Int32)
Dim img As Image
Dim lvi As ListViewItem
For Each d In di.EnumerateDirectories("*.*", SearchOption.TopDirectoryOnly)
lvi = New ListViewItem(d.Name)
lvi.SubItems.Add("") ' no file name
lvi.SubItems.Add(Directory.GetFiles(d.FullName).Count().ToString)
myLV.Items.Add(lvi)
img = NativeMethods.GetShellIcon(d.FullName)
imgLst.Images.Add(img)
lvi.ImageIndex = imgLst.Images.Count - 1
Next
For Each f In di.EnumerateFiles("*.*")
lvi = New ListViewItem(f.DirectoryName)
lvi.SubItems.Add(f.Name) ' no file name
lvi.SubItems.Add("n/a")
myLV.Items.Add(lvi)
If exts.ContainsKey(f.Extension) = False Then
' try simplest method
img = Drawing.Icon.ExtractAssociatedIcon(f.FullName).ToBitmap
If img Is Nothing Then
img = NativeMethods.GetShellIcon(f.FullName)
End If
If img IsNot Nothing Then
imgLst.Images.Add(img)
exts.Add(f.Extension, imgLst.Images.Count - 1)
Else
' ?? use some default or custom '?' one?
End If
End If
lvi.ImageIndex = exts(f.Extension)
Next
对于文件，它首先尝试使用 NET 获取图标Icon.ExtractAssociatedIcon方法并求助于因某种原因失败的 PInvoke。
我改变了exts List(Of String to a Dictionary(Of String, Int32)。一旦代码获取扩展程序的图标，它就会将该图像的索引保存在ImageList这样就不需要再次查找扩展名/图标。这在大型文件夹上加快了相当多的速度。
如果您声明Dictionary在方法之外，然后不清除ImageList每次，您都可以让它们在运行时积累图像。这text file文件夹中的图标Foo不会与其他地方的文本文件的图像不同。
Result:
