IExtractImageを利用してエクスプローラのサムネイルを取得する

友達にPDFファイルのサムネイルを取得するプログラムをVB.NETで作れないか？と言われたので、色々と調べまわって作ってみました。

日本語のサイトなんかだとC#だと記事があった↓りしたんですけど

Re[4]: IExtractImageによるサムネイルの取得

なんとも初心者な私ではこれだけでは理解ができない！

ちなみにこの記事を元会社の上司に見られたら確実に怒られる
何故ならコードをちゃんと理解してない！

あとモノとしても不完全で、取得対象ファイルのアドレスが不正と言われたり、ファイルの種類によって取得できなかったり・・・。

そういった問題はおいおい解決できたらいいな〜、って思ってます。
いや、なんかもういらないって言われたから・・・orz

ソースコード：VB.NET

まずは必要なインポートから

Imports System
Imports System.Text
Imports System.Drawing.Imaging.BitmapData
Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Drawing

以上です。

クラス定義

Public Class Thumbnail
    Inherits System.Web.UI.Page

    Private MAX_PATH As Integer = 1024

    Public Enum IEIFLAG As Integer
        ASYNC = &H1
        CACHE = &H2
        ASPECT = &H4
        OFFLINE = &H8
        GLEAM = &H10
        SCREEN = &H20
        ORIGSIZE = &H40
        NOSTAMP = &H80
        NOBORDER = &H100
        QUALITY = &H200
    End Enum

まずはクラス定義と「Inherits」継承というやつですね。
「System.Web.UI.Page」を継承しま〜す、って言ってます、そのまんま

はい、次
「MAX_PATH」確保するメモリ領域、かな？
この数値が不十分だと多分サムネイル取得に失敗します。

列挙体「IEIFLAG」
私の英語力では調べても詳細がわからない！
IExtractImage::GetLocationに関係するらしい

ここまで読んでもらったらわかるとおり、わからない事だらけなんですね〜。
言い訳がましいことはこれで最後にしましょう。

関数宣言及び変数宣言

    Public Function GetThumbnailImage(ByVal filePath As String, ByVal sizepic As Integer) As Image
        GetThumbnailImage = Nothing

        Dim desktopFolder As IShellFolder = Nothing
        Dim someFolder As IShellFolder = Nothing
        Dim extract As IExtractImage = Nothing
        Dim pidl As New IntPtr
        Dim filePidl As New IntPtr
        Dim thePath As New IntPtr

        Dim IID_IShellFolder = New Guid("000214E6-0000-0000-C000-000000000046")
        Dim IID_IExtractImage = New Guid("BB2E617C-0920-11d1-9A0B-00C04FC2D6C1")

        Dim folderName = Path.GetDirectoryName(filePath)
        Dim shortFileName = Path.GetFileName(filePath)

関数内で使用する変数の宣言です。
「IShellFolder」や「IExtractImage」は現状エラーが出ると思います。
これらを使用する方法は後々記述します。

引数の説明ですが、「fileName」がサムネイル画象を取得するファイルのパスになります。
次に「sizepic」が取得するサムネイル画象のサイズです、ピクセル単位で指定します。取得する画象の高さ、幅は正方形になります。

各変数については後ほど

「IID_〜」についてはこれまた理解不能、ごめんなさい。
各IIDを手動で定義する、とのことですがIIDがわからん！

「folderName」と「shortFileName」はそれぞれ、サムネイル取得対象が保存されているディレクトリとそのファイル自体の名前を取得します。
これらはいくつか方法があるかと思いますが、今回は参考元の方法を使わせていただいております。

以下、関数内

        ShellInterop.SHGetDesktopFolder(desktopFolder)

変数「desktopFolder」にデスクトップの位置を設定します。

ここで言うデスクトップとは、エクスプローラを開いたとき、画面左にデスクトップをルートとした階層型のフォルダ一覧が出ますよね？
つまりPC起動時に表示されるデスクトップとは別の、マイコンピュータ等を下位層に含む仮想のデスクトップです。多分

        desktopFolder.ParseDisplayName(IntPtr.Zero, IntPtr.Zero, folderName, 0, pidl, 0)
        desktopFolder.BindToObject(pidl, IntPtr.Zero, IID_IShellFolder, someFolder)

        someFolder.ParseDisplayName(IntPtr.Zero, IntPtr.Zero, shortFileName, 0, filePidl, 0)
        someFolder.GetUIObjectOf(IntPtr.Zero, 1, filePidl, IID_IExtractImage, 0, extract)

先ほど取得した「folderName」と「shortFileName」がここで出ました。
上2行でフォルダの情報を「someFolder」にバインドします。

下2行でサムネイル取得対象ファイルのオブジェクトを「extract」に設定する、かな。

ここの処理で時折ファイルパスを見失ってしまうことがあるのです、未だに謎(;´д`)

        Dim size As New SIZE
        size.cx = sizepic
        size.cy = sizepic

        Dim flags = IEIFLAG.ASPECT Or IEIFLAG.SCREEN
        Dim bmp As New IntPtr
        thePath = Marshal.AllocHGlobal(MAX_PATH)

        Try
            extract.GetLocation(thePath, MAX_PATH, 0, size, 32, flags)
            extract.Extract(bmp)
        Catch ex As Exception
        End Try

この処理でいよいよサムネイル画象を取得します。

「extract.GetLocation」でサムネイル画象の設定を行っていると思います。
その上の6行はプロパティ値の設定ですね。

そして「extract.Extract(bmp)」で変数「bmp」にサムネイル画象を取得します。

        If Not bmp.Equals(IntPtr.Zero) Then
            GetThumbnailImage = Image.FromHbitmap(bmp)
        Else
            GetThumbnailImage = Nothing
        End If

取得に成功していれば戻り値にサムネイル画象を設定

以下は後始末となっております。

        If thePath <> IntPtr.Zero Then
            Marshal.FreeHGlobal(thePath)
        End If

        If thePath <> IntPtr.Zero Then
            Marshal.FreeCoTaskMem(pidl)
        End If

        If thePath <> IntPtr.Zero Then
            Marshal.FreeCoTaskMem(filePidl)
        End If
    End Function

正直今回の記事、構成に失敗したかな？って思ってます。
コード切り離して全体が扱いづらくなっちゃったんじゃないかと。
というわけで上記のコードを纏めたものを

インポートから関数の終了まで

Imports System
Imports System.Text
Imports System.Drawing.Imaging.BitmapData
Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Drawing

Public Class Thumbnail
    Inherits System.Web.UI.Page

    Private MAX_PATH As Integer = 1024

    Public Enum IEIFLAG As Integer
        ASYNC = &H1
        CACHE = &H2
        ASPECT = &H4
        OFFLINE = &H8
        GLEAM = &H10
        SCREEN = &H20
        ORIGSIZE = &H40
        NOSTAMP = &H80
        NOBORDER = &H100
        QUALITY = &H200
    End Enum

    Public Function GetThumbnailImage(ByVal filePath As String, ByVal sizepic As Integer) As Image
        GetThumbnailImage = Nothing

        Dim desktopFolder As IShellFolder = Nothing
        Dim someFolder As IShellFolder = Nothing
        Dim extract As IExtractImage = Nothing
        Dim pidl As New IntPtr
        Dim filePidl As New IntPtr
        Dim thePath As New IntPtr

        Dim IID_IShellFolder = New Guid("000214E6-0000-0000-C000-000000000046")
        Dim IID_IExtractImage = New Guid("BB2E617C-0920-11d1-9A0B-00C04FC2D6C1")

        Dim folderName = Path.GetDirectoryName(filePath)
        Dim shortFileName = Path.GetFileName(filePath)

        ShellInterop.SHGetDesktopFolder(desktopFolder)

        desktopFolder.ParseDisplayName(IntPtr.Zero, IntPtr.Zero, folderName, 0, pidl, 0)
        desktopFolder.BindToObject(pidl, IntPtr.Zero, IID_IShellFolder, someFolder)

        someFolder.ParseDisplayName(IntPtr.Zero, IntPtr.Zero, shortFileName, 0, filePidl, 0)
        someFolder.GetUIObjectOf(IntPtr.Zero, 1, filePidl, IID_IExtractImage, 0, extract)

        Dim size As New SIZE
        size.cx = sizepic
        size.cy = sizepic

        Dim flags = IEIFLAG.ASPECT Or IEIFLAG.SCREEN
        Dim bmp As New IntPtr
        thePath = Marshal.AllocHGlobal(MAX_PATH)

        Try
            extract.GetLocation(thePath, MAX_PATH, 0, size, 32, flags)
            extract.Extract(bmp)
        Catch ex As Exception
        End Try

        If Not bmp.Equals(IntPtr.Zero) Then
            GetThumbnailImage = Image.FromHbitmap(bmp)
        Else
            GetThumbnailImage = Nothing
        End If

        If thePath <> IntPtr.Zero Then
            Marshal.FreeHGlobal(thePath)
        End If

        If thePath <> IntPtr.Zero Then
            Marshal.FreeCoTaskMem(pidl)
        End If

        If thePath <> IntPtr.Zero Then
            Marshal.FreeCoTaskMem(filePidl)
        End If
    End Function

そして最後に、「IShellFolder」や「IExtractImage」を使うのに必要なコードを記述します。
ここから先は本当に私のレベルでは理解が及ばないので、微妙な解説も無しなので、上記のコードとそのまま合わせて使ってみてください。

クラスの終わりまで

<StructLayout(LayoutKind.Sequential)> _
    Public Structure STRRET_CSTR
        Public uType As Integer
        <FieldOffset(4), MarshalAs(UnmanagedType.LPWStr)> _
        Public pOleStr As String
        <FieldOffset(4)> _
        Public uOffset As Integer
        <FieldOffset(4), MarshalAs(UnmanagedType.ByValArray, SizeConst:=520)> _
        Public strName As Byte()
    End Structure

    <StructLayout(LayoutKind.Sequential)> _
    Public Structure SIZE
        Public cx As Integer
        Public cy As Integer
    End Structure

    <ComImportAttribute(), _
     GuidAttribute("BB2E617C-0920-11d1-9A0B-00C04FC2D6C1"), _
     InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)> _
   Public Interface IExtractImage

        <PreserveSig()> Sub GetLocation( _
            ByVal pszPathBuffer As IntPtr, _
            ByVal cch As Integer, _
            ByRef pdwPriority As Integer, _
            ByRef prgSize As SIZE, _
            ByVal dwRecClrDepth As Integer, _
            ByRef pdwFlags As Integer)

        <PreserveSig()> Sub Extract(ByRef phBmpThumbnail As IntPtr)

    End Interface

    <ComImportAttribute(), _
    GuidAttribute("000214E6-0000-0000-C000-000000000046"), _
    InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)> _
    Public Interface IShellFolder

        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 EnumObjects( _
          ByVal hwndOwner As IntPtr, _
          <MarshalAs(UnmanagedType.U4)> ByVal grfFlags As Integer, _
          <Out()> ByRef ppenumIDList As IntPtr)

        Sub BindToObject( _
          ByVal pidl As IntPtr, _
          ByVal pbcReserved As IntPtr, _
          ByRef riid As Guid, _
          ByRef ppvOut As IShellFolder)

        Sub BindToStorage( _
          ByVal pidl As IntPtr, _
          ByVal pbcReserved As IntPtr, _
          ByRef riid As Guid, _
          <Out()> ByVal ppvObj 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 ppvOut As Object)

        Sub GetAttributesOf( _
          ByVal cidl As Integer, _
          ByVal apidl As IntPtr, _
          <MarshalAs(UnmanagedType.U4)> ByRef rgfInOut As Integer)

        Sub GetUIObjectOf( _
          ByVal hwndOwner As IntPtr, _
          ByVal cidl As Integer, _
          ByRef apidl As IntPtr, _
          ByRef riid As Guid, _
          <Out()> ByVal prgfInOut As Integer, _
          <Out(), MarshalAs(UnmanagedType.IUnknown)> ByRef ppvOut As Object)

        Sub GetDisplayNameOf( _
          ByVal pidl As IntPtr, _
          <MarshalAs(UnmanagedType.U4)> ByVal uFlags As Integer, _
          ByRef lpName As STRRET_CSTR)

        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

    Public Class ShellInterop
        <DllImport("shell32.dll", CharSet:=CharSet.Auto)> _
        Public Shared Function SHGetDesktopFolder( _
          <Out()> ByRef ppshf As IShellFolder) As Integer
        End Function
    End Class
End Class

以上です。
一応説明入れましたが間違ってる部分も多いと思いますし、ソース自体もマズイところがあるんじゃないかと思ってますので
この記事を読んでくださった方で、ここが駄目だ！ってところがあったら是非コメントいただけるとありがたいです！

ここまで読んでくださった方、長々と駄文にお付き合いだき、恐縮です。