Programming Field - プログラミング Tips

実行可能ファイルからのアイコンの抽出 for VB.NET

「実行可能ファイルからのアイコンの抽出」を VB.NET で行った例です。基本的にやっていることは変わりません。

ついでに HICON → System.Drawing.Icon も行っています。

外部 DLL を呼び出すサンプルにひょっとしたらなるかもしれません

[VB.NET]

Imports System.Runtime.InteropServices

Module IconTestModule

    Public Const LR_DEFAULTCOLOR As Integer = &H0I
    Public Const LR_MONOCHROME As Integer = &H1I

    ' MyExtractIconData 用のデータ (Structure より Class の方が楽)
    Public Class MyExtractIconData
        Public Index As Integer
        Public NowPos As Integer
        Public Found As Boolean
        Public IsID As Boolean
        Public ID As UInteger
        Public Name As String
    End Class

    Public Const DONT_RESOLVE_DLL_REFERENCES As Integer = &H1I
    Public Const LOAD_LIBRARY_AS_DATAFILE As Integer = &H2I
    Public Const LOAD_WITH_ALTERED_SEARCH_PATH As Integer = &H8I
    Public Const LOAD_IGNORE_CODE_AUTHZ_LEVEL As Integer = &H10I
    Public Declare Ansi Function LoadLibraryEx Lib "kernel32.dll" Alias "LoadLibraryExA" _
     (ByVal lpLibFileName As String, ByVal hFile As System.IntPtr, _
     ByVal dwFlags As Integer) As System.IntPtr
    Public Declare Ansi Function FreeLibrary Lib "kernel32.dll" _
     (ByVal hModule As System.IntPtr) As Boolean
    Public Const RT_CURSOR As Integer = 1
    Public Const RT_BITMAP As Integer = 2
    Public Const RT_ICON As Integer = 3
    Public Const RT_MENU As Integer = 4
    Public Const RT_DIALOG As Integer = 5
    Public Const RT_STRING As Integer = 6
    Public Const RT_FONTDIR As Integer = 7
    Public Const RT_FONT As Integer = 8
    Public Const RT_ACCELERATOR As Integer = 9
    Public Const RT_RCDATA As Integer = 10
    Public Const RT_MESSAGETABLE As Integer = 11
    Public Const RT_GROUP_CURSOR As Integer = 12
    Public Const RT_GROUP_ICON As Integer = 14
    Public Const RT_VERSION As Integer = 16
    Public Const RT_DLGINCLUDE As Integer = 17
    Public Const RT_PLUGPLAY As Integer = 19
    Public Const RT_VXD As Integer = 20
    Public Const RT_ANICURSOR As Integer = 21
    Public Const RT_ANIICON As Integer = 22
    Public Const RT_HTML As Integer = 23
    Public Const RT_MANIFEST As Integer = 24

    ' コールバック関数をデリゲートで宣言します。
    Public Delegate Function EnumResNameProc(ByVal hInst As System.IntPtr, _
     ByVal lpszType As System.IntPtr, ByVal lpszName As System.IntPtr, _
     ByVal lParam As System.IntPtr) As Boolean

    Public Declare Ansi Function EnumResourceNames Lib "kernel32.dll" _
     Alias "EnumResourceNamesA" (ByVal hModule As System.IntPtr, _
     ByVal lpszType As System.IntPtr, ByVal lpEnumFunc As EnumResNameProc, _
     ByVal lParam As System.IntPtr) As Boolean

    ' 以下の 2 つは数値でも文字列でも呼び出せるようにしています。
    Public Declare Ansi Function FindResource Lib "kernel32.dll" Alias "FindResourceA" _
     (ByVal hModule As System.IntPtr, ByVal lpName As System.IntPtr, _
     ByVal lpType As System.IntPtr) As System.IntPtr
    Public Declare Ansi Function FindResource Lib "kernel32.dll" Alias "FindResourceA" _
     (ByVal hModule As System.IntPtr, ByVal lpName As String, _
     ByVal lpType As System.IntPtr) As System.IntPtr

    Public Declare Ansi Function LoadResource Lib "kernel32.dll" _
     (ByVal hModule As System.IntPtr, ByVal hResInfo As System.IntPtr) As System.IntPtr
    Public Declare Ansi Function LockResource Lib "kernel32.dll" _
     (ByVal hResData As System.IntPtr) As System.IntPtr
    Public Declare Ansi Function SizeofResource Lib "kernel32.dll" _
     (ByVal hModule As System.IntPtr, ByVal hResInfo As System.IntPtr) As Integer
    Public Declare Ansi Function LookupIconIdFromDirectoryEx Lib "user32.dll" _
     (ByVal pResBits As System.IntPtr, ByVal fIcon As Integer, ByVal cxDesired As Integer, _
     ByVal cyDesired As Integer, ByVal Flags As Integer) As Integer
    Public Declare Ansi Function CreateIconFromResource Lib "user32.dll" _
     (ByVal pResBits As System.IntPtr, ByVal dwResSize As Integer, ByVal fIcon As Integer, _
     ByVal dwVer As Integer) As System.IntPtr

    Public Declare Auto Function DestroyIcon Lib "user32.dll" _
     (ByVal hIcon As System.IntPtr) As Boolean

    Public Function MyEnumResNameProc(ByVal hInst As System.IntPtr, _
     ByVal lpszType As System.IntPtr, ByVal lpszName As System.IntPtr, _
     ByVal lParam As System.IntPtr) As Boolean
        Dim strName As String
        Dim ptr As GCHandle = GCHandle.FromIntPtr(lParam)
        Dim Data As MyExtractIconData
        Data = ptr.Target
        If Data.NowPos = Data.Index Then
            Data.Found = True
            Data.IsID = ((lpszName.ToInt32() And &HFFFF0000I) = 0)
            If Not Data.IsID Then
                strName = Marshal.PtrToStringAnsi(lpszName)
                Data.Name = strName
            Else
                Data.ID = (lpszName.ToInt32() And &HFFFFI)
            End If
            Return False
        End If
        Data.NowPos = Data.NowPos + 1
        Return True
    End Function

    Public Function MyExtractIcon(ByVal PathName As String, ByVal IndexOrID As Integer, _
     ByVal SmallIcon As Boolean) As System.IntPtr
        Dim hInstance As System.IntPtr
        Dim hRes As System.IntPtr, hRes2 As System.IntPtr
        Dim hMem As System.IntPtr, hMem2 As System.IntPtr
        Dim lpv As System.IntPtr, lpv2 As System.IntPtr
        Dim Data As MyExtractIconData, ptr As GCHandle

        hInstance = LoadLibraryEx(PathName, 0, LOAD_LIBRARY_AS_DATAFILE Or _
         LOAD_WITH_ALTERED_SEARCH_PATH)
        If hInstance = 0 Then Return 0

        Data = New MyExtractIconData
        If IndexOrID < 0 Then
            Data.IsID = True
            Data.ID = -(IndexOrID + 1)
            Data.Found = True
        Else
            Data.Index = IndexOrID
            Data.NowPos = 0
            Data.Found = False
            ptr = GCHandle.Alloc(Data)
            Call EnumResourceNames(hInstance, RT_GROUP_ICON, AddressOf MyEnumResNameProc, ptr)
            Call ptr.Free()
            If Not Data.Found Then
                Call FreeLibrary(hInstance)
                Return 0
            End If
        End If

        If Data.IsID Then
            hRes = FindResource(hInstance, CType(Data.ID, System.IntPtr), _
             CType(RT_GROUP_ICON, System.IntPtr))
        Else
            hRes = FindResource(hInstance, Data.Name, CType(RT_GROUP_ICON, System.IntPtr))
        End If
        If hRes <> 0 Then
            hMem = LoadResource(hInstance, hRes)
            lpv = LockResource(hMem)
            Data.ID = LookupIconIdFromDirectoryEx(lpv, True, _
             IIf(SmallIcon, 16, 32), IIf(SmallIcon, 16, 32), _
             LR_DEFAULTCOLOR)
            If Data.ID <> 0 Then
                hRes2 = FindResource(hInstance, CType(Data.ID, System.IntPtr), _
                 CType(RT_ICON, System.IntPtr))
                hMem2 = LoadResource(hInstance, hRes2)
                lpv2 = LockResource(hMem2)
                MyExtractIcon = CreateIconFromResource(lpv2, _
                 SizeofResource(hInstance, hRes2), 1, &H30000I)
            End If
        End If
        Call FreeLibrary(hInstance)
    End Function

    ' GetIconImageFromDLL は、DLL 名とインデックス (または絶対値が ID になる負の値)
    ' を指定するだけでアイコンオブジェクトを取得できます。
    ' PathName を省略すると "shell32.dll" になります
    Public Function GetIconImageFromDLL(ByVal PathName As String, ByVal IndexOrID As Integer, _
     Optional ByVal SmallIcon As Boolean = False) As System.Drawing.Icon
        Dim hIcon As System.IntPtr
        If PathName = Nothing OrElse PathName = "" Then PathName = "shell32.dll"
        hIcon = MyExtractIcon(PathName, IndexOrID, SmallIcon)
        If hIcon = 0 Then
            Return Nothing
        Else
            i = System.Drawing.Icon.FromHandle(hIcon)
            ' FromHandle では Dispose でアイコンを自動的に削除してくれないので作成しなおす
            i = i.Clone()
            Call DestroyIcon(hIcon)
            Return i
        End If
    End Function
End Module

最終更新日: 2006/09/13