＜前置き＞（投稿のキッカケ）
プログラムを作成する上で分からないことがあってWeb検索すると、ほとんどのケースで某スクール系サイトのページが検索上位に表示され、覗いてみても必要な情報が見当たらない上に広告まで見せられる始末。似たようなページが増えて欲しい情報が探しにくい時代になりましたよね。
そこで最近では検索キーワードに「Qiita」を含めて検索する次第です。ですのでQiitaの皆様にはいつもお世話になっております。ありがとうございます。
恐らくほとんど需要が無いためだと思いますが、先日、VB.NETでEXE/DLLから最大サイズ（256x256）のアイコンを取得する必要があったのですが、ネットにサンプルのようなものは見当たらず、中々苦労したので、日ごろの恩返しも兼ねて初めて投稿してみることにしました。
＜プログラムについて＞
VB.NETのWindows Formsのサンプルです。
画面指定されたEXEやDLLからアイコンを取得し、ビットマップ（System.Drawing.Bitmap）に変換し、画面に表示するサンプルプログラムとなっています。
APIと、フォルダオブジェクトの操作用インタフェースであるIShellFolderと、アイコン取得用インタフェースであるIExtractIconを使用しています。
自分的にはインタフェースを変数宣言しているのが、未だにちょっと腑に落ちていないので、そこは勉強不足な部分なのかも…
＜サンプルプログラムの画面デザイン＞
こちらの画像のようにテキストボックス４つと、ボタン１つ、ピクチャーボックス２つを貼り付けるだけでサンプルが作成できるようになっています。
APIの定義
<DllImport("shell32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
Public Shared Function SHGetDesktopFolder(<MarshalAs(UnmanagedType.[Interface])> ByRef ppshf As IShellFolder) As Integer
End Function
<DllImport("shell32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
Public Shared Function ILCreateFromPath(<[In](), MarshalAs(UnmanagedType.LPWStr)> pszPath As String) As IntPtr
End Function
<DllImport("Ole32.dll")>
Public Shared Sub CoTaskMemFree(<[In](), [Optional]()> pv As IntPtr)
End Sub
<DllImport("user32.dll")>
Public Shared Function DestroyIcon(ByVal handle As IntPtr) As Boolean
End Function
IShellFolder、IExtractIconの宣言
''' <summary>
''' IShellFolderで使用する構造体の定義（※IShellFolderの宣言に必要なので定義したが、当処理では使用していない）
''' </summary>
<StructLayout(LayoutKind.Sequential)>
Public Structure STRRET_CSTR
Public uType As UInteger
<FieldOffset(4), MarshalAs(UnmanagedType.LPWStr)>
Public pOleStr As String
<FieldOffset(4)>
Public uOffset As Integer
<FieldOffset(4), MarshalAs(UnmanagedType.ByValArray, SizeConst:=520)>
Public [cStr] As Byte()
End Structure
''' <summary>
''' フォルダー／ファイルオブジェクト操作用に公開されている IShellFolder インタフェースの定義
''' ※GetUIObjectOf以外は未使用なので定義が合っているかどうかは不明、、、
''' </summary>
<ComImport(), Guid("000214E6-0000-0000-C000-000000000046"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IShellFolder
Sub BindToObject(ByVal pidl As IntPtr, ByVal pbc As IntPtr, ByRef riid As Guid, ByRef ppv As IShellFolder)
Sub BindToStorage(ByVal pidl As IntPtr, ByVal pbc As IntPtr, ByRef riid As Guid, <Out()> ByVal ppv As IntPtr)
<PreserveSig()>
Function CompareIDs(ByVal lParam As IntPtr, ByVal pidl1 As IntPtr, ByVal pidl2 As IntPtr) As Integer
Sub CreateViewObject(ByVal hwndOwner As IntPtr, ByRef riid As Guid, ByVal ppv As Object)
Sub EnumObjects(ByVal hwndOwner As IntPtr, <MarshalAs(UnmanagedType.U4)> ByVal grfFlags As Integer, <Out()> ByRef ppenumIDList As IntPtr)
Sub GetAttributesOf(ByVal cidl As Integer, ByVal apidl As IntPtr, <MarshalAs(UnmanagedType.U4)> ByRef rgfInOut As Integer)
Sub GetDisplayNameOf(ByVal pidl As IntPtr, <MarshalAs(UnmanagedType.U4)> ByVal uFlags As Integer, ByRef pName As STRRET_CSTR)
Sub GetUIObjectOf(ByVal hwndOwner As IntPtr, ByVal cidl As Integer, ByRef apidl As IntPtr, ByRef riid As Guid, <Out()> ByVal rgfReserved As UInteger, <Out(), MarshalAs(UnmanagedType.IUnknown)> ByRef ppvOut As Object)
Sub ParseDisplayName(ByVal hWnd As IntPtr, ByVal pbc As IntPtr, ByVal pszDisplayName As String, ByRef pchEaten As Integer, ByRef ppidl As System.IntPtr, ByRef pdwAttributes As Integer)
Sub SetNameOf(ByVal hwndOwner As IntPtr, ByVal pidl As IntPtr, <MarshalAs(UnmanagedType.LPWStr)> ByVal lpszName As String, <MarshalAs(UnmanagedType.U4)> ByVal uFlags As Integer, ByRef ppidlOut As IntPtr)
End Interface
''' <summary>
''' フォルダー／ファイルオブジェクトのアイコンを取得するための IExtractIcon インタフェースを定義
''' </summary>
<ComImport(), Guid("000214FA-0000-0000-C000-000000000046"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IExtractIcon
<PreserveSig()>
Function GetIconLocation(ByVal uFlags As Integer, ByVal szIconFile As IntPtr, ByVal cchMax As Integer, ByRef piIndex As Integer, ByRef pwFlags As Integer) As Integer
<PreserveSig()>
Function Extract(ByVal pszFile As IntPtr, ByVal nIconIndex As UInteger, ByRef phiconLarge As IntPtr, ByRef phiconSmall As IntPtr, ByVal nIconSize As UInteger) As Integer
End Interface
ボタン処理
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
PictureBox1.Image = Nothing
PictureBox2.Image = Nothing
Dim wTargetFolder = TextBox1.Text '対象ファイルが格納されているフォルダパス
Dim wTargetFIle = TextBox2.Text '対象ファイル名
Dim wIconIndex As UInteger = TextBox3.Text 'Exe内に含まれるアイコンの要素番号
Dim wIconSize As UInteger = TextBox4.Text '0～256を指定。指定サイズに該当するアイコンが無い場合は先頭に格納されているアイコンが返却されるっぽい。
'Iconが格納されているフォルダのアイテム識別子を取得
Dim pITEMIDLIST = ILCreateFromPath(wTargetFolder)
'デスクトップフォルダの IShellFolder インタフェースを取得
Dim wDesktop As IShellFolder = Nothing
SHGetDesktopFolder(wDesktop)
Dim wReserved As UInteger = 0 '予約（現時点では使用されないパラメータなのでゼロをセット）
Dim wExtIcon As IExtractIcon = Nothing 'アイコン取得用インタフェース（返却値）
'指定ファイルのアイコン取得用インタフェースのオブジェクトを取得
wDesktop.GetUIObjectOf(Handle, 1, pITEMIDLIST, GetType(IExtractIcon).GUID, wReserved, wExtIcon)
'アイコン用のポインタ変数
Dim pBigIcon As IntPtr 'こちらには指定要素＆指定サイズのアイコン（が有ればそれ）がセットされる
Dim pSmallIcon As IntPtr 'こちらにはサイズ指定に関わらず16x16？のアイコンが設定されるっぽい
'ファイル名をBSTRに変換して、そのポインタを取得
Dim pS = Marshal.StringToBSTR(wTargetFIle)
'ファイルからアイコンを取得
wExtIcon.Extract(pS, wIconIndex, pBigIcon, pSmallIcon, wIconSize)
'アイコンをビットマップに変換して取得
Dim wBigIconBitmap As Bitmap = handelToIconBitmap(pBigIcon)
Dim wSmallIconBitmap As Bitmap = handelToIconBitmap(pSmallIcon)
'不要変数の解放
Marshal.FreeBSTR(pS)
DestroyIcon(pBigIcon)
DestroyIcon(pSmallIcon)
'アイテム識別子の解放
CoTaskMemFree(pITEMIDLIST)
Dim cnt = 0
'取得したビットマップを画面に表示
If wBigIconBitmap IsNot Nothing Then
PictureBox1.Image = wBigIconBitmap
cnt += 1
End If
If wSmallIconBitmap IsNot Nothing Then
PictureBox2.Image = wSmallIconBitmap
cnt += 1
End If
If cnt <= 0 Then
MsgBox("アイコンを取得できませんでした")
End If
End Sub
''' <summary>
''' アイコンのハンドル（ポインタ）を元にビットマップを生成し返却
''' </summary>
Private Function handelToIconBitmap(ByRef inHandle As IntPtr) As Bitmap
'有効なハンドルでなければ Nothing を返却
If inHandle = 0 OrElse inHandle = 1 Then
Return Nothing
End If
Try
'有効なハンドルと思われる場合は、Iconに変換（変換後にハンドルを解放してからIconにアクセスするとエラーになるので、変換と言ってもアドレス参照なのかも？）
Dim wIcon As Icon = Icon.FromHandle(inHandle)
'ハンドルを解放可能なよう、クローンした値を返却
Dim ret As Bitmap = wIcon.ToBitmap
'生成したアイコンは破棄
wIcon.Dispose()
Return ret
Catch ex As Exception
'ハンドルがアイコンとして有効でない場合は例外が発生するので、例外発生時はNothingを返却
Return Nothing
End Try
'
End Function
サンプルはここまででございます！
自分の理解の範囲内でソースにコメントを入れていますので、それぞれの箇所で何をしているかはコメントを参照して頂ければと思います。
（コメントが間違っていたらごめんなさい😅）
なお、入力値チェックや、ファイル存在チェック、エラー処理等々は入っていませんのでご注意ください。
＜あとがき＞
C言語やC#だと、IShellFolderやIExtractIcon用のヘッダーファイルが用意されていて簡単に利用できる（ように見える）のですが、VBだと自前で宣言する必要があって、そこが苦労しますよね。
少しでもどなたかのお役に立てますように…😌✨