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

<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

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
 
    Try
        Dim hr As Integer = SHCreateItemFromParsingName(filePath, IntPtr.Zero, iidShellItemImageFactory, shellItemPtr)
        If hr <> 0 OrElse shellItemPtr = IntPtr.Zero Then Return Nothing
 
        Dim imageFactory As IShellItemImageFactory = CType(Marshal.GetTypedObjectForIUnknown(shellItemPtr, GetType(IShellItemImageFactory)), IShellItemImageFactory)
        Dim nativeSizeObj As New NativeSize() With {.Width = width, .Height = height}
 
        'Получаем thumbnail
        hr = imageFactory.GetImage(nativeSizeObj, SIIGBF.RESIZETOFIT, hBitmap)
        If hr <> 0 OrElse hBitmap = IntPtr.Zero Then
            'Если нет thumbnail, то берем иконку файла
            hr = imageFactory.GetImage(nativeSizeObj, SIIGBF.ICONONLY, hBitmap)
            If hr <> 0 OrElse hBitmap = IntPtr.Zero Then
                Return Nothing
            End If
        End If
 
        Return GetBitmapWithAlpha(hBitmap)
 
    Finally
        If hBitmap <> IntPtr.Zero Then DeleteObject(hBitmap)
        If shellItemPtr <> IntPtr.Zero Then Marshal.Release(shellItemPtr)
    End Try
End Function

    <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 ' HRESULT
    End Function

Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
 
Public Module ShellThumbnailHelper
 
    'Структура размеров для Win API
    <StructLayout(LayoutKind.Sequential)>
    Private Structure NativeSize
        Public Width As Integer
        Public Height As Integer
    End Structure
 
    'Структура описания битовой карты для GDI+
    <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
 
    ' COM-интерфейс IShellItemImageFactory
    <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
 
    'Функция WinAPI для создания объекта ShellItem из пути к файлу
 
    <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 ' HRESULT
    End Function
 
    'Функция для получения информации о HBITMAP (нужна для альфа-канала)
    <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
 
    'Функция для освобождения памяти HBITMAP в GDI
    <DllImport("gdi32.dll", SetLastError:=True)>
    Private Function DeleteObject(ByVal ho As IntPtr) As Boolean
    End Function
 
    ''' <summary>
    ''' Возвращает миниатюру или иконку файла с сохранением прозрачности.
    ''' </summary>
    ''' <param name="filePath">Полный путь к файлу.</param>
    ''' <param name="width">Желаемая ширина в пикселях.</param>
    ''' <param name="height">Желаемая высота в пикселях.</param>
    ''' <returns>Объект Bitmap или Nothing в случае ошибки.</returns>
    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
 
        Try
            Dim hr As Integer = SHCreateItemFromParsingName(filePath, IntPtr.Zero, iidShellItemImageFactory, shellItemPtr)
            If hr <> 0 OrElse shellItemPtr = IntPtr.Zero Then Return Nothing
 
            Dim imageFactory As IShellItemImageFactory = CType(Marshal.GetTypedObjectForIUnknown(shellItemPtr, GetType(IShellItemImageFactory)), IShellItemImageFactory)
            Dim nativeSizeObj As New NativeSize() With {.Width = width, .Height = height}
 
            'Получаем thumbnail
            hr = imageFactory.GetImage(nativeSizeObj, SIIGBF.RESIZETOFIT, hBitmap)
            If hr <> 0 OrElse hBitmap = IntPtr.Zero Then
                'Если нет thumbnail, то берем иконку файла
                hr = imageFactory.GetImage(nativeSizeObj, SIIGBF.ICONONLY, hBitmap)
                If hr <> 0 OrElse hBitmap = IntPtr.Zero Then
                    Return Nothing
                End If
            End If
 
            Return GetBitmapWithAlpha(hBitmap)
 
        Finally
            If hBitmap <> IntPtr.Zero Then DeleteObject(hBitmap)
            If shellItemPtr <> IntPtr.Zero Then Marshal.Release(shellItemPtr)
        End Try
    End Function
 
    ''' <summary>
    ''' Вспомогательный метод для корректного переноса 32-битного HBITMAP с ARGB каналами
    ''' </summary>
    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) ' Fallback, если структуру не прочитать
        End If
 
        'Проверяем, является ли изображение 32-битным (содержит альфа-канал прозрачности)
        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
            )
 
            'Копируем пиксели напрямую из памяти GDI в управляемый Bitmap
            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
            'Для обычных 24-битных картинок используем стандартный метод
            Return Bitmap.FromHbitmap(hBitmap)
        End If
    End Function
 
End Module