Как получить миниатюру видеофайла?

myPic.RotateFlip(RotateFlipType.RotateNoneFlipY)

Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
 
Public Module ShellThumbnailHelper
 
    <StructLayout(LayoutKind.Sequential)>
    Private Structure NativeSize
        Public Width As Integer
        Public Height As Integer
    End Structure
 
    <StructLayout(LayoutKind.Sequential)>
    Private Structure BITMAP_STRUCT
        Public bmType As Integer
        Public bmWidth As Integer
        Public bmHeight As Integer
        Public bmWidthBytes As Integer
        Public bmPlanes As Short
        Public bmBitsPixel As Short
        Public bmBits As IntPtr
    End Structure
 
    <Flags>
    Public Enum SIIGBF
        RESIZETOFIT = &H0
        BIGGERSIZEOK = &H1
        INMEMORYONLY = &H2
        ICONONLY = &H4
        THUMBNAILONLY = &H8
        INCACHEONLY = &H10
    End Enum
 
    <ComImport>
    <Guid("bcc18b79-ba16-442f-80c4-8a59c30c463b")>
    <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
    Private Interface IShellItemImageFactory
        <PreserveSig>
        Function GetImage(
            <MarshalAs(UnmanagedType.Struct)> ByVal size As NativeSize,
            ByVal flags As SIIGBF,
            <Out> ByRef phbm As IntPtr
        ) As Integer
    End Interface
 
    <DllImport("shell32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Unicode)>
    Private Function SHCreateItemFromParsingName(
        <MarshalAs(UnmanagedType.LPWStr)> pszPath As String,
        pbc As IntPtr,
        ByRef riid As Guid,
        <Out> ByRef ppv As IntPtr
    ) As Integer
    End Function
 
    <DllImport("gdi32.dll", SetLastError:=True)>
    Private Function GetObject(ByVal hObject As IntPtr, ByVal nCount As Integer, ByRef lpObject As BITMAP_STRUCT) As Integer
    End Function
 
    <DllImport("gdi32.dll", SetLastError:=True)>
    Private Function DeleteObject(ByVal ho As IntPtr) As Boolean
    End Function
 
    ''' <summary>
    ''' Возвращает миниатюру или иконку файла.
    ''' Если это иконка, автоматически применяется RotateNoneFlipY.
    ''' </summary>
    Public Function GetFileThumbnail(filePath As String, width As Integer, height As Integer) As Bitmap
        Dim shellItemPtr As IntPtr = IntPtr.Zero
        Dim hBitmap As IntPtr = IntPtr.Zero
        Dim iidShellItemImageFactory As Guid = GetType(IShellItemImageFactory).GUID
        Dim isIcon As Boolean = False
 
        Try
            Dim hr As Integer = SHCreateItemFromParsingName(filePath, IntPtr.Zero, iidShellItemImageFactory, shellItemPtr)
            If hr <> 0 OrElse shellItemPtr = IntPtr.Zero Then
                Return Nothing
            End If
 
            Dim imageFactory As IShellItemImageFactory = TryCast(Marshal.GetTypedObjectForIUnknown(shellItemPtr, GetType(IShellItemImageFactory)), IShellItemImageFactory)
            If imageFactory Is Nothing Then Return Nothing
 
            Dim nativeSizeObj As New NativeSize() With {.Width = width, .Height = height}
 
            ' !!!!!!!!!!!!! Пытаемся получить именно эскиз (THUMBNAILONLY) !!!!!!!!!!!!
            hr = imageFactory.GetImage(nativeSizeObj, SIIGBF.THUMBNAILONLY Or SIIGBF.BIGGERSIZEOK, hBitmap)
            If hr <> 0 OrElse hBitmap = IntPtr.Zero Then
                ' Если эскиз отсутствует, берём иконку
                hr = imageFactory.GetImage(nativeSizeObj, SIIGBF.ICONONLY, hBitmap)
                If hr <> 0 OrElse hBitmap = IntPtr.Zero Then
                    Return Nothing
                End If
                isIcon = True
            End If
 
            Dim result As Bitmap = GetBitmapWithAlpha(hBitmap)
            If result Is Nothing Then Return Nothing
 
            ' !!!!!!!!!!!!! Если это иконка, применяем RotateNoneFlipY !!!!!!!!!!!!!!!
            If isIcon Then
                result.RotateFlip(RotateFlipType.RotateNoneFlipY)
            End If
 
            Return result
 
        Finally
            If hBitmap <> IntPtr.Zero Then DeleteObject(hBitmap)
            If shellItemPtr <> IntPtr.Zero Then Marshal.Release(shellItemPtr)
        End Try
    End Function
 
    Private Function GetBitmapWithAlpha(hBitmap As IntPtr) As Bitmap
        Dim bmpObj As New BITMAP_STRUCT()
        If GetObject(hBitmap, Marshal.SizeOf(bmpObj), bmpObj) = 0 Then
            Return Bitmap.FromHbitmap(hBitmap)
        End If
 
        If bmpObj.bmBitsPixel = 32 AndAlso bmpObj.bmBits <> IntPtr.Zero Then
            Dim managedBitmap As New Bitmap(bmpObj.bmWidth, bmpObj.bmHeight, PixelFormat.Format32bppArgb)
            Dim bmpData As BitmapData = managedBitmap.LockBits(
                New Rectangle(0, 0, bmpObj.bmWidth, bmpObj.bmHeight),
                ImageLockMode.WriteOnly,
                PixelFormat.Format32bppArgb
            )
            Dim bytesToCopy As Integer = bmpObj.bmWidthBytes * bmpObj.bmHeight
            Dim buffer(bytesToCopy - 1) As Byte
            Marshal.Copy(bmpObj.bmBits, buffer, 0, bytesToCopy)
            Marshal.Copy(buffer, 0, bmpData.Scan0, bytesToCopy)
            managedBitmap.UnlockBits(bmpData)
            Return managedBitmap
        Else
            Return Bitmap.FromHbitmap(hBitmap)
        End If
    End Function
End Module