Imports Microsoft.Win32

Public Module IconModule
    'Win API
    Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As IntPtr, ByVal lpszExeFileName As String, ByVal nIconIndex As Integer) As Integer
    Private Declare Function DestroyIcon Lib "User32.dll" (hIcon As IntPtr) As Integer

    ''' <summary>확장자으로 부터 아이콘을 가져옵니다.</summary>
    ''' <param name="Ext">확장자 값 입니다.</param>
    ''' <returns>가져온 아이콘입니다. 실패시 Nothing(NULL)을 반환힙니다.</returns>
    Public Function GetIconFromExt(Ext As String) As Icon
        Dim Reg = Registry.ClassesRoot, Icon As Icon
        Reg = Reg.OpenSubKey(Ext, False)
        If Reg Is Nothing Then Return Nothing
        Icon = GetDefaultIcon(Reg)
        If Icon IsNot Nothing Then Return Icon
        Icon = GetOpenIcon(Reg)
        Dim Value As String = Reg.GetValue(Nothing)
        If Value Is Nothing Then Return Nothing
        Return GetIconFromAppClass(Value)
    End Function

    ''' <summary>AppClass로 부터 아이콘을 가져옵니다.</summary>
    ''' <param name="AppClass">AppClass 스트링입니다.</param>
    ''' <returns>가져온 아이콘입니다. 실패시 Nothing(NULL)을 반환힙니다.</returns>
    Public Function GetIconFromAppClass(AppClass As String) As Icon
        Dim Reg = Registry.ClassesRoot
        Reg = Reg.OpenSubKey(AppClass, False)
        If Reg Is Nothing Then Return Nothing
        Return If(GetDefaultIcon(Reg), GetOpenIcon(Reg))
    End Function

    Private Function GetDefaultIcon(Reg As RegistryKey) As Icon
        Reg = Reg.OpenSubKey("DefaultIcon")
        If Reg Is Nothing Then Return Nothing
        Dim Value As String = Reg.GetValue(Nothing)
        If Value Is Nothing Then Return Nothing
        Dim FilePath As String = ""
        Dim Index As Integer
        Try
            ParsePath(Value, FilePath, Index)
        Catch 'Parse Error
            Return Nothing
        End Try
        Return GetIcon(FilePath, Index)
    End Function

    Private Function GetOpenIcon(Reg As RegistryKey) As Icon
        Reg = Reg.OpenSubKey("shell/open/command")
        If Reg Is Nothing Then Return Nothing
        Dim Value As String = Reg.GetValue(Nothing)
        If Value Is Nothing Then Return Nothing
        If Value.Length = 0 Then Return Nothing
        Dim FilePath As String = ""
        Dim Spt As Integer
        If Value(0) = """"c Then
            Spt = Value.IndexOf(""""c)
            FilePath = If(Spt = -1, Value.Substring(1), Value.Substring(1, Spt - 1))
        Else
            Spt = Value.IndexOf(" ")
            If Spt = -1 Then Spt = Value.Length
            FilePath = Value.Substring(0, Spt)
        End If
        Try
            FilePath = IO.Path.GetFullPath(FilePath)
        Catch 'Parse Error
            Return Nothing
        End Try
        Return GetIcon(FilePath, 0)
    End Function

    ''' <summary>아이콘의 경로를 파싱하는 함수입니다.</summary>
    ''' <param name="Path">아이콘의 경로입니다.</param>
    ''' <param name="FilePath">반환되는 아이콘 파일의 경로입니다.</param>
    ''' <param name="Index">반환되는 아이콘의 인덱스입니다.</param>
    Private Sub ParsePath(Path As String, ByRef FilePath As String, ByRef Index As Integer)
        Dim Spt As Integer
        Path = Path.Trim(" "c)
        FilePath = ""
        Index = 0
        If Path.Length = 0 Then Return
        If Path(0) = """"c Then
            Spt = Path.IndexOf(""""c)
            If Spt = -1 Then
                Spt = Path.Length
                FilePath = Path.Substring(1)
            Else
                FilePath = Path.Substring(1, Spt - 1)
                Spt += 1
            End If
        Else
            Spt = Path.IndexOf(",")
            If Spt = -1 Then Spt = Path.Length
            FilePath = Path.Substring(0, Spt)
        End If
        If Spt = Path.Length Then Return
        Index = CInt(Path.Substring(Spt + 1))
        FilePath = IO.Path.GetFullPath(FilePath)
    End Sub

    ''' <summary>아이콘을 가져오는 함수입니다.</summary>
    ''' <param name="FilePath">아이콘 파일의 경로입니다.</param>
    ''' <param name="Index">아이콘의 인덱스입니다.</param>
    ''' <returns>가져온 아이콘입니다. 실패시 Nothing(NULL)을 반환힙니다.</returns>
    Private Function GetIcon(FilePath As String, Index As Integer) As Icon
        Dim hIcon As IntPtr
        hIcon = ExtractIcon(0, FilePath, Index)
        If hIcon = 0 Then Return Nothing
        Dim eIcon = Icon.FromHandle(hIcon).Clone()
        Call DestroyIcon(hIcon)
        Return eIcon
    End Function
End Module