Public Class IconManager ' Constants that we need in the function call Private Const SHGFI_ICON As Integer = &H100 Private Const SHGFI_LARGEICON As Integer = &H0 Private Const SHGFI_SMALLICON As Integer = &H1 Private Const SHIL_EXTRALARGE As Integer = &H2 Private Const SHIL_JUMBO As Integer = &H4 Private Const WM_CLOSE As Integer = &H10 ' This structure will contain information about the file Public Structure SHFILEINFO ' Handle to the icon representing the file Public hIcon As IntPtr ' Index of the icon within the image list Public iIcon As Integer ' Various attributes of the file Public dwAttributes As UInteger ' Path to the file <MarshalAs(UnmanagedType.ByValTStr, SizeConst := 260)> _ Public szDisplayName As String ' File type <MarshalAs(UnmanagedType.ByValTStr, SizeConst := 80)> _ Public szTypeName As String End Structure <DllImport("Kernel32.dll")> _ Public Shared Function CloseHandle(handle As IntPtr) As [Boolean] End Function Private Structure IMAGELISTDRAWPARAMS Public cbSize As Integer Public himl As IntPtr Public i As Integer Public hdcDst As IntPtr Public x As Integer Public y As Integer Public cx As Integer Public cy As Integer Public xBitmap As Integer ' x offest from the upperleft of bitmap Public yBitmap As Integer ' y offset from the upperleft of bitmap Public rgbBk As Integer Public rgbFg As Integer Public fStyle As Integer Public dwRop As Integer Public fState As Integer Public Frame As Integer Public crEffect As Integer End Structure <DllImport("user32")> _ Private Shared Function SendMessage(handle As IntPtr, Msg As Integer, wParam As IntPtr, lParam As IntPtr) As IntPtr End Function <StructLayout(LayoutKind.Sequential)> _ Private Structure IMAGEINFO Private ReadOnly hbmImage As IntPtr Private ReadOnly hbmMask As IntPtr Private ReadOnly Unused1 As Integer Private ReadOnly Unused2 As Integer Private ReadOnly rcImage As RECT End Structure #Region "Private ImageList COM Interop (XP)" 'helpstring("Image List"), <ComImport> _ <Guid("46EB5926-582E-4017-9FDF-E8998DAA0950")> _ <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _ Private Interface IImageList <PreserveSig> _ Function Add(hbmImage As IntPtr, hbmMask As IntPtr, ByRef pi As Integer) As Integer <PreserveSig> _ Function ReplaceIcon(i As Integer, hicon As IntPtr, ByRef pi As Integer) As Integer <PreserveSig> _ Function SetOverlayImage(iImage As Integer, iOverlay As Integer) As Integer <PreserveSig> _ Function Replace(i As Integer, hbmImage As IntPtr, hbmMask As IntPtr) As Integer <PreserveSig> _ Function AddMasked(hbmImage As IntPtr, crMask As Integer, ByRef pi As Integer) As Integer <PreserveSig> _ Function Draw(ByRef pimldp As IMAGELISTDRAWPARAMS) As Integer <PreserveSig> _ Function Remove(i As Integer) As Integer <PreserveSig> _ Function GetIcon(i As Integer, flags As Integer, ByRef picon As IntPtr) As Integer <PreserveSig> _ Function GetImageInfo(i As Integer, ByRef pImageInfo As IMAGEINFO) As Integer <PreserveSig> _ Function Copy(iDst As Integer, punkSrc As IImageList, iSrc As Integer, uFlags As Integer) As Integer <PreserveSig> _ Function Merge(i1 As Integer, punk2 As IImageList, i2 As Integer, dx As Integer, dy As Integer, ByRef riid As Guid, _ ByRef ppv As IntPtr) As Integer <PreserveSig> _ Function Clone(ByRef riid As Guid, ByRef ppv As IntPtr) As Integer <PreserveSig> _ Function GetImageRect(i As Integer, ByRef prc As RECT) As Integer <PreserveSig> _ Function GetIconSize(ByRef cx As Integer, ByRef cy As Integer) As Integer <PreserveSig> _ Function SetIconSize(cx As Integer, cy As Integer) As Integer <PreserveSig> _ Function GetImageCount(ByRef pi As Integer) As Integer <PreserveSig> _ Function SetImageCount(uNewCount As Integer) As Integer <PreserveSig> _ Function SetBkColor(clrBk As Integer, ByRef pclr As Integer) As Integer <PreserveSig> _ Function GetBkColor(ByRef pclr As Integer) As Integer <PreserveSig> _ Function BeginDrag(iTrack As Integer, dxHotspot As Integer, dyHotspot As Integer) As Integer <PreserveSig> _ Function EndDrag() As Integer <PreserveSig> _ Function DragEnter(hwndLock As IntPtr, x As Integer, y As Integer) As Integer <PreserveSig> _ Function DragLeave(hwndLock As IntPtr) As Integer <PreserveSig> _ Function DragMove(x As Integer, y As Integer) As Integer <PreserveSig> _ Function SetDragCursorImage(ByRef punk As IImageList, iDrag As Integer, dxHotspot As Integer, dyHotspot As Integer) As Integer <PreserveSig> _ Function DragShowNolock(fShow As Integer) As Integer <PreserveSig> _ Function GetDragImage(ByRef ppt As POINT, ByRef pptHotspot As POINT, ByRef riid As Guid, ByRef ppv As IntPtr) As Integer <PreserveSig> _ Function GetItemFlags(i As Integer, ByRef dwFlags As Integer) As Integer <PreserveSig> _ Function GetOverlayImage(iOverlay As Integer, ByRef piIndex As Integer) As Integer End Interface #End Region ''' ''' SHGetImageList is not exported correctly in XP. See KB316931 ''' http://support.microsoft.com/default.aspx?scid=kb;EN-US;Q316931 ''' Apparently (and hopefully) ordinal 727 isn't going to change. ''' <DllImport("shell32.dll", EntryPoint := "#727")> _ Private Shared Function SHGetImageList(iImageList As Integer, ByRef riid As Guid, ByRef ppv As IImageList) As Integer End Function ' The signature of SHGetFileInfo (located in Shell32.dll) <DllImport("Shell32.dll")> _ Public Shared Function SHGetFileInfo(pszPath As String, dwFileAttributes As Integer, ByRef psfi As SHFILEINFO, cbFileInfo As Integer, uFlags As UInteger) As Integer End Function <DllImport("Shell32.dll")> _ Public Shared Function SHGetFileInfo(pszPath As IntPtr, dwFileAttributes As UInteger, ByRef psfi As SHFILEINFO, cbFileInfo As Integer, uFlags As UInteger) As Integer End Function <DllImport("shell32.dll", SetLastError := True)> _ Private Shared Function SHGetSpecialFolderLocation(hwndOwner As IntPtr, nFolder As Int32, ByRef ppidl As IntPtr) As Integer End Function <DllImport("user32")> _ Public Shared Function DestroyIcon(hIcon As IntPtr) As Integer End Function Public Structure pair Public Property icon() As Icon Get Return m_icon End Get Set m_icon = Value End Set End Property Private m_icon As Icon Public Property iconHandleToDestroy() As IntPtr Get Return m_iconHandleToDestroy End Get Set m_iconHandleToDestroy = Value End Set End Property Private m_iconHandleToDestroy As IntPtr End Structure Public Shared Function DestroyIcon2(hIcon As IntPtr) As Integer Return DestroyIcon(hIcon) End Function Private Shared Function IconSource(ic As Icon) As BitmapSource Dim ic2 = Imaging.CreateBitmapSourceFromHIcon(ic.Handle, Int32Rect.Empty, BitmapSizeOptions.FromEmptyOptions()) ic2.Freeze() Return ic2 End Function Public Shared Function IconPath(FileName As String, small As Boolean, checkDisk As Boolean, addOverlay As Boolean) As BitmapSource Dim shinfo = New SHFILEINFO() Const SHGFI_USEFILEATTRIBUTES As UInteger = &H10 Const SHGFI_LINKOVERLAY As UInteger = &H8000 Dim flags As UInteger If small Then flags = SHGFI_ICON Or SHGFI_SMALLICON Else flags = SHGFI_ICON Or SHGFI_LARGEICON End If If Not checkDisk Then flags = flags Or SHGFI_USEFILEATTRIBUTES End If If addOverlay Then flags = flags Or SHGFI_LINKOVERLAY End If Dim res = SHGetFileInfo(FileName, 0, shinfo, Marshal.SizeOf(shinfo), flags) If res = 0 Then Throw (New FileNotFoundException()) End If Dim myIcon = Icon.FromHandle(shinfo.hIcon) Dim bs = IconSource(myIcon) myIcon.Dispose() bs.Freeze() ' importantissimo se no fa memory leak DestroyIcon(shinfo.hIcon) CloseHandle(shinfo.hIcon) Return bs End Function Public Shared Function GetLargeIcon(FileName As String, jumbo As Boolean, checkDisk As Boolean) As BitmapSource Dim shinfo = New SHFILEINFO() Const SHGFI_USEFILEATTRIBUTES As UInteger = &H10 Const SHGFI_SYSICONINDEX As UInteger = &H4000 Const FILE_ATTRIBUTE_NORMAL As Integer = &H80 Dim flags = SHGFI_SYSICONINDEX If Not checkDisk Then ' This does not seem to work. If I try it, a folder icon is always returned. flags = flags Or SHGFI_USEFILEATTRIBUTES End If Dim res = SHGetFileInfo(FileName, FILE_ATTRIBUTE_NORMAL, shinfo, Marshal.SizeOf(shinfo), flags) If res = 0 Then Throw (New FileNotFoundException()) End If Dim iconIndex = shinfo.iIcon ' Get the System IImageList object from the Shell: Dim iidImageList = New Guid("46EB5926-582E-4017-9FDF-E8998DAA0950") Dim iml As IImageList Dim size = If(jumbo, SHIL_JUMBO, SHIL_EXTRALARGE) SHGetImageList(size, iidImageList, iml) Dim hIcon = IntPtr.Zero Const ILD_TRANSPARENT As Integer = 1 iml.GetIcon(iconIndex, ILD_TRANSPARENT, hIcon) Dim myIcon = Icon.FromHandle(hIcon) Dim bs = IconSource(myIcon) myIcon.Dispose() bs.Freeze() ' very important to avoid memory leak DestroyIcon(hIcon) SendMessage(hIcon, WM_CLOSE, IntPtr.Zero, IntPtr.Zero) Return bs End Function <StructLayout(LayoutKind.Sequential)> _ Public Structure RECT Private ReadOnly _Left As Integer Private ReadOnly _Top As Integer Private ReadOnly _Right As Integer Private ReadOnly _Bottom As Integer End Structure <StructLayout(LayoutKind.Sequential)> _ Public Structure POINT Public X As Integer Public Y As Integer Public Sub New(x__1 As Integer, y__2 As Integer) X = x__1 Y = y__2 End Sub Public Shared Widening Operator CType(p As POINT) As Point Return New Point(p.X, p.Y) End Operator Public Shared Widening Operator CType(p As Point) As POINT Return New POINT(p.X, p.Y) End Operator End Structure End Class