Imports System.Drawing Imports System.Reflection Imports System.Runtime.InteropServices Imports Microsoft.Win32 Imports Pilz.Win32.Mapped Imports Pilz.Win32.Native Imports Pilz.Win32.Native.Shell32 Namespace Internals Public Class IconFactory #Region "Custom exceptions class" Public Class IconNotFoundException Inherits Exception Public Sub New(ByVal fileName As String, ByVal index As Integer) MyBase.New(String.Format("Icon with Id = {0} wasn't found in file {1}", index, fileName)) End Sub End Class Public Class UnableToExtractIconsException Inherits Exception Public Sub New(ByVal fileName As String, ByVal firstIconIndex As Integer, ByVal iconCount As Integer) MyBase.New(String.Format("Tryed to extract {2} icons starting from the one with id {1} from the ""{0}"" file but failed", fileName, firstIconIndex, iconCount)) End Sub End Class #End Region ''' ''' Get the number of icons in the specified file. ''' ''' Full path of the file to look for. ''' Private Shared Function GetIconsCountInFile(fileName As String) As Integer Return ExtractIconEx(fileName, -1, Nothing, Nothing, 0) End Function #Region "ExtractIcon-like functions" Public Shared Sub ExtractEx(ByVal fileName As String, ByVal largeIcons As List(Of Icon), ByVal smallIcons As List(Of Icon), ByVal firstIconIndex As Integer, ByVal iconCount As Integer) ' ' Memory allocations ' Dim smallIconsPtrs As IntPtr() = Nothing Dim largeIconsPtrs As IntPtr() = Nothing If smallIcons IsNot Nothing Then smallIconsPtrs = New IntPtr(iconCount - 1) {} End If If largeIcons IsNot Nothing Then largeIconsPtrs = New IntPtr(iconCount - 1) {} End If ' ' Call to native Win32 API ' Dim apiResult = ExtractIconEx(fileName, firstIconIndex, largeIconsPtrs, smallIconsPtrs, iconCount) If apiResult <> iconCount Then Throw New UnableToExtractIconsException(fileName, firstIconIndex, iconCount) End If ' ' Fill lists ' If smallIcons IsNot Nothing Then smallIcons.Clear() For Each actualIconPtr In smallIconsPtrs smallIcons.Add(Icon.FromHandle(actualIconPtr)) Next End If If largeIcons IsNot Nothing Then largeIcons.Clear() For Each actualIconPtr In largeIconsPtrs largeIcons.Add(Icon.FromHandle(actualIconPtr)) Next End If End Sub Public Shared Function ExtractEx(ByVal fileName As String, ByVal size As SystemIconSize, ByVal firstIconIndex As Integer, ByVal iconCount As Integer) As List(Of Icon) Dim iconList As New List(Of Icon)() Select Case size Case SystemIconSize.Large ExtractEx(fileName, iconList, Nothing, firstIconIndex, iconCount) Case SystemIconSize.Small ExtractEx(fileName, Nothing, iconList, firstIconIndex, iconCount) Case Else Throw New ArgumentOutOfRangeException("size") End Select Return iconList End Function Public Shared Sub Extract(ByVal fileName As String, ByVal largeIcons As List(Of Icon), ByVal smallIcons As List(Of Icon)) Dim iconCount = GetIconsCountInFile(fileName) ExtractEx(fileName, largeIcons, smallIcons, 0, iconCount) End Sub Public Shared Function Extract(ByVal fileName As String, ByVal size As SystemIconSize) As List(Of Icon) Dim iconCount = GetIconsCountInFile(fileName) Return ExtractEx(fileName, size, 0, iconCount) End Function Public Shared Function ExtractOne(ByVal fileName As String, ByVal index As Integer, ByVal size As SystemIconSize) As Icon Try Dim iconList = ExtractEx(fileName, size, index, 1) Return iconList(0) Catch __unusedUnableToExtractIconsException1__ As UnableToExtractIconsException Throw New IconNotFoundException(fileName, index) End Try End Function Public shared Sub ExtractOne(ByVal fileName As String, ByVal index As Integer, ByRef largeIcon As Icon, ByRef smallIcon As Icon) Dim smallIconList As List(Of Icon) = New List(Of Icon)() Dim largeIconList As List(Of Icon) = New List(Of Icon)() Try ExtractEx(fileName, largeIconList, smallIconList, index, 1) largeIcon = largeIconList(0) smallIcon = smallIconList(0) Catch __unusedUnableToExtractIconsException1__ As UnableToExtractIconsException Throw New IconNotFoundException(fileName, index) End Try End Sub #End Region 'this will look throw the registry 'to find if the Extension have an icon. Public Shared Function IconFromExtension(ByVal extension As String, ByVal size As SystemIconSize) As Icon ' Add the '.' to the extension if needed If extension(0) <> "."c Then extension = "."c & extension 'opens the registry for the wanted key. Dim Root = Registry.ClassesRoot Dim ExtensionKey = Root.OpenSubKey(extension) ExtensionKey.GetValueNames() Dim ApplicationKey As RegistryKey = Root.OpenSubKey(ExtensionKey.GetValue("").ToString()) 'gets the name of the file that have the icon. Dim IconLocation As String = ApplicationKey.OpenSubKey("DefaultIcon").GetValue("").ToString() Dim IconPath = IconLocation.Split(","c) If Equals(IconPath(1), Nothing) Then IconPath(1) = "0" Dim Large = New IntPtr(0) {}, Small = New IntPtr(0) {} 'extracts the icon from the file. ExtractIconEx(IconPath(0), Convert.ToInt16(IconPath(1)), Large, Small, 1) Return If(size = SystemIconSize.Large, Icon.FromHandle(Large(0)), Icon.FromHandle(Small(0))) End Function Public Shared Function IconFromExtensionShell(ByVal extension As String, ByVal size As SystemIconSize) As Icon 'add '.' if nessesry If extension(0) <> "."c Then extension = "."c & extension 'temp struct for getting file shell info Dim fileInfo As SHFILEINFO = New SHFILEINFO() SHGetFileInfo(extension, 0, fileInfo, Marshal.SizeOf(fileInfo), FileInfoFlags.SHGFI_ICON Or FileInfoFlags.SHGFI_USEFILEATTRIBUTES Or CType(size, FileInfoFlags)) Return Icon.FromHandle(fileInfo.hIcon) End Function Public Shared Function IconFromResource(ByVal resourceName As String) As Icon Dim assembly As Assembly = Assembly.GetCallingAssembly() Return New Icon(assembly.GetManifestResourceStream(resourceName)) End Function ''' ''' Parse strings in registry who contains the name of the icon and ''' the index of the icon an return both parts. ''' ''' The full string in the form "path,index" as found in registry. ''' The "path" part of the string. ''' The "index" part of the string. Public Shared Sub ExtractInformationsFromRegistryString(ByVal regString As String, ByRef fileName As String, ByRef index As Integer) If Equals(regString, Nothing) Then Throw New ArgumentNullException("regString") End If If regString.Length = 0 Then Throw New ArgumentException("The string should not be empty.", "regString") End If index = 0 Dim strArr = regString.Replace("""", "").Split(","c) fileName = strArr(0).Trim() If strArr.Length > 1 Then Call Integer.TryParse(strArr(1).Trim(), index) End If End Sub Public Shared Function ExtractFromRegistryString(ByVal regString As String, ByVal size As SystemIconSize) As Icon Dim fileName As String Dim index As Integer ExtractInformationsFromRegistryString(regString, fileName, index) Return ExtractOne(fileName, index, size) End Function End Class End Namespace