209 lines
8.6 KiB
VB.net
209 lines
8.6 KiB
VB.net
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
|
|
|
|
|
|
''' <summary>
|
|
''' Get the number of icons in the specified file.
|
|
''' </summary>
|
|
''' <param name="fileName">Full path of the file to look for.</param>
|
|
''' <returns></returns>
|
|
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, <Out> ByRef largeIcon As Icon, <Out> 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
|
|
|
|
''' <summary>
|
|
''' Parse strings in registry who contains the name of the icon and
|
|
''' the index of the icon an return both parts.
|
|
''' </summary>
|
|
''' <param name="regString">The full string in the form "path,index" as found in registry.</param>
|
|
''' <param name="fileName">The "path" part of the string.</param>
|
|
''' <param name="index">The "index" part of the string.</param>
|
|
Public Shared Sub ExtractInformationsFromRegistryString(ByVal regString As String, <Out> ByRef fileName As String, <Out> 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
|