[VB6] IPreviewHandler: Show non-image file previews from any reg'd preview handler

[fafalone]

IPreviewHandler Example

Many file types have registered preview handlers, not just images. Typically documents, videos, fonts, music, even registry files, all have a preview handler that you can put on your application with little effort.

Project Updated: 03 Dec 2015
-With the original version of this project, font previews showed all black boxes. This is a bug in the Windows font previewer, and can be fixed by resetting the background with the IPreviewHandlerVisuals interface. NOTE: It's very hard to deal with installed fonts; they can't be selected via the open dialog, and can't be expressed as a shell item like even objects like the control panel or my computer can, so: To preview installed fonts, you'll have to manually enter the path to the font file (C:\Windows\Fonts\whatever.ttf) and click preview. Font files not located in \Windows\Fonts can be selected and previewed normally.

-The update also adds an icon preview function, just to show how to make a comprehensive previewer (like the existing image previews in the original, IPreviewHandler isn't used unless your system has a custom one installed).

This update requires oleexp v4.0 or higher and mIID.bas from the oleexp download.

Requirements

-Reference to oleexp, v4.0 or higher. oleexp.tlb is required for the IDE only, you do not need to distribute it with a compiled program.
-oleexp addon mIID.bas - Found in the oleexp zip.

-Recently an issue was discovered where some preview handlers may require a manifest for Common Controls 6.0. So far only Outlook 2007 .msg files have this issue (probably related to their also being the only ones using the more modern IInitializeWithItem), but there may be others. See LaVolpe's excellent project for making manifests for your app.

Compatibility
The current sample project won't run on XP, but if you replace the IFileDialog file selection dialog and possibly a few other things, the core IPreviewHandler and IPreviewHandlerVisuals interfaces was available in XP.

-------------------------------

The registry holds registered preview handlers in the HKEY_CLASSES_ROOT\filetype\ShellEx\{8895b1c6-b41f-4c1c-a562-0d564250836f} key, but as a shortcut you can also use the AssocQueryString API with ASSOCSTR_SHELLEXTENSION as the sample project shows.

Here's the basic code to show a preview:

Private Sub ShowPreviewForFile(isi As IShellItem, hWnd As Long, rc As RECT, objpic As Object, Optional sFileIn As String = "")
Dim iif As IInitializeWithFile
Dim iis As IInitializeWithStream
Dim iisi As IInitializeWithItem
Dim pVis As IPreviewHandlerVisuals
Dim pUnk As oleexp.IUnknown
Dim hr As Long
Dim sFile As String, sExt As String
Dim lp As Long
Dim tHandler As UUID
On Error GoTo e0

If (isi Is Nothing) Then
    Debug.Print "no isi"
    If sFileIn <> "" Then
        sFile = sFileIn
    End If
Else
    Debug.Print "using isi"
    isi.GetDisplayName SIGDN_FILESYSPATH, lp
    sFile = BStrFromLPWStr(lp)
End If
    Debug.Print "sFile=" & sFile
    sExt = Right$(sFile, (Len(sFile) - InStrRev(sFile, ".")) + 1)
    Debug.Print "sExt=" & sExt

If sExt = "" Then Exit Sub

If (ipv Is Nothing) = False Then
    ipv.Unload
    Set ipv = Nothing
End If


hr = GetHandlerCLSID(sExt, tHandler)
If hr = 1 Then
    Debug.Print "Got handler CLSID; attempting to create IPreviewHandler"
    hr = CoCreateInstance(tHandler, 0, CLSCTX_INPROC_SERVER Or CLSCTX_LOCAL_SERVER, IID_IPreviewHandler, ipv)
    If (ipv Is Nothing) Then
        Debug.Print "Failed to create IPreviewHandler interface, hr=" & hr
        Exit Sub
    End If
    'Set iisi = ipv 'this normally can be used in place of Set pUnk / .QueryInterface, but we need the HRESULT
    Set pUnk = ipv
'    Set iif = ipv
    If pUnk.QueryInterface(IID_IInitializeWithFile, iif) = S_OK Then
        hr = iif.Initialize(sFile, STGM_READ)
        GoTo gpvh
    Else
        Debug.Print "IInitializeWithFile not supported."
    End If

    'use IStream
    Dim hFile As Long
    Dim pstrm As IStream
    Dim lpGlobal As Long
    Dim dwSize As Long
    Debug.Print "Attempting to use IStream"
'                Set iis = ipv
    Set pUnk = ipv
    hr = pUnk.QueryInterface(IID_IInitializeWithStream, iis)
    If (iis Is Nothing) Then
        Debug.Print "IInitializeWithStream not supported."
        Set pUnk = ipv
        If pUnk.QueryInterface(IID_IInitializeWithItem, iisi) = S_OK Then
            Debug.Print "IInitializeWithItem supported."
            If (isi Is Nothing) = False Then
                hr = iisi.Initialize(isi, STGM_READ)
                GoTo gpvh
            Else
                Debug.Print "Don't have needed IShellItem."
            End If
        Else
            Debug.Print "IInitializeWithItem not supported. No more initializers."
            GoTo out
        End If
    Else
        hFile = CreateFile(sFile, FILE_READ_DATA, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
        If hFile Then
            dwSize = GetFileSize(hFile, ByVal 0&)
            Debug.Print "Got file size=" & dwSize
            If dwSize = 0 Then Exit Sub
            hGlobal = GlobalAlloc(GPTR, dwSize)
            lpGlobal = GlobalLock(hGlobal)
            If lpGlobal Then
                Call ReadFile(hFile, ByVal lpGlobal, dwSize, dwSize, ByVal 0&)
                Call GlobalUnlock(hGlobal)
                Call CreateStreamOnHGlobal(hGlobal, 1, pstrm)
                hr = iis.Initialize(pstrm, STGM_READ)
            End If
            Call CloseHandle(hFile)
        End If
    End If


gpvh:
    hr = ipv.SetWindow(hWnd, rc)
    Debug.Print "SetWindow hr=" & hr
    hr = ipv.DoPreview()
    Debug.Print "DoPreview hr=" & hr
    Dim piunk As oleexp.IUnknown
    Set piunk = ipv
    hr = piunk.QueryInterface(IID_IPreviewHandlerVisuals, pVis)
    If (pVis Is Nothing) = False Then
        Debug.Print "Handler implements IPreviewHandlerVisuals; setting bk color to white"
        pVis.SetBackgroundColor &HFFFFFF
    End If
    If (isi Is Nothing) = False Then
        isi.GetDisplayName SIGDN_NORMALDISPLAY, lp
        sFile = BStrFromLPWStr(lp)
    End If
    Label1.Caption = "DoPreview called for " & sFile
Else
    'images and videos aren't handled that way normally, so we'll do it another way
    Debug.Print "No registered handler; trying alternate method for images..."
    Dim lPcv As Long
    lPcv = FilePtypeL(sExt)
    Debug.Print "Perceived type=" & lPcv
    If lPcv = PERCEIVED_TYPE_IMAGE Then
        If Right$(sFile, 4) = ".ico" Then
            'the below methods don't properly render icons transparent
            'so we'll use a different method that does
            If DoIcoPreview(sFile, objpic.hDC, 32) = -1 Then
                GoTo gfthm
            End If
            objpic.Refresh
            Label1.Caption = "Manually generated preview for icon."
            GoTo out
        Else
gfthm:
            Dim hbm As Long
            hbm = GetFileThumbnail(sFile, 0, objpic.ScaleWidth, objpic.ScaleHeight)
            Debug.Print "hbm=" & hbm
            objpic.Cls
            hBitmapToPictureBox objpic, hbm
            objpic.Refresh
            Label1.Caption = "Manually generated preview for image."
        End If
    Else
        Label1.Caption = "Could not find registered preview handler for file type."
    
    End If
End If
out:

Set iisi = Nothing
Set iif = Nothing
Set iis = Nothing

On Error GoTo 0
Exit Sub

e0:
Debug.Print "ShowPreviewForFile.Error->" & Err.Description & " (" & Err.Number & ")"
End Sub

It's really simpler than it looks; the hard part it the initialization, a preview handler typically only supports 1 out of the 3 IInitialize__ interfaces, so we have to go through all of them, and IStream ones are too common to omit, and that's the only complex part.

It may vary from system to system, but plain images generally aren't supported with this method, but there's a large variety of ways to preview them.

----------------
Project based on Using Preview Handlers in Windows Vista

---

UPDATE: The image file preview in the sample project won't work on XP, here's an alternative that will:

Public Declare Function SHCreateShellItem Lib "shell32" (ByVal pidlParent As Long, ByVal psfParent As Long, ByVal pidl As Long, ppsi As IShellItem) As Long

Public Function GetFileThumbnail2(sFile As String, pidlFQ As Long, CX As Long, CY As Long) As Long
'alternate method
Dim isi As IShellItem
Dim pidl As Long
Dim iei As IExtractImage
Dim hBmp As Long
Dim uThumbSize As oleexp.SIZE
    uThumbSize.CX = CX
    uThumbSize.CY = CY
Dim sRet As String
Dim uThumbFlags As IEIFlags
On Error GoTo e0

If pidlFQ Then
    Call SHCreateShellItem(0&, 0&, pidlFQ, isi)
Else
    pidl = ILCreateFromPathW(StrPtr(sFile))
    Call SHCreateShellItem(0&, 0&, pidl, isi)
    Call CoTaskMemFree(pidl) 'also a change that should have been made, had originally used ILFree, which shouldn't be used on Win2k+
End If

isi.BindToHandler ByVal 0&, BHID_ThumbnailHandler, IID_IExtractImage, iei
If (iei Is Nothing) Then
    Debug.Print "GetFileThumbnail2.Failed to create IExtractImage"
    Exit Function
End If

            uThumbFlags = IEIFLAG_ORIGSIZE
            sRet = String$(MAX_PATH, 0)
            iei.GetLocation StrPtr(sRet), MAX_PATH, 0&, uThumbSize, 32, uThumbFlags
hBmp = iei.Extract()
GetFileThumbnail2 = hBmp
Set iei = Nothing

On Error GoTo 0
Exit Function

e0:
Debug.Print "GetFileThumbnail2.Error->" & Err.Description & " (" & Err.Number & ")"
End Function

'NOTE: The below are not needed if your project includes oleexp's mIID.bas
Public Function BHID_ThumbnailHandler() As UUID
'{0x7B2E650A, 0x8E20, 0x4F4A, 0xB0,0x9E, 0x65,0x97,0xAF,0xC7,0x2F,0xB0}
Static iid As UUID
 If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H7B2E650A, &H8E20, &H4F4A, &HB0, &H9E, &H65, &H97, &HAF, &HC7, &H2F, &HB0)
 BHID_ThumbnailHandler = iid
End Function
Public Function IID_IExtractImage() As UUID
'{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}
Static iid As UUID
 If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &HBB2E617C, CInt(&H920), CInt(&H11D1), &H9A, &HB, &H0, &HC0, &H4F, &HC2, &HD6, &HC1)
  IID_IExtractImage = iid
End Function

UPDATE 1 July 2016 - As was pointed out below by Steve-N, SHCreateItemFromIDList is actually Vista+ too, image preview code in this post has been changed to use SHCreateShellItem instead, which MSDN states in available as of XP SP1.

UPDATE 24 Nov 2016 - Attached project and code in post updated to reference oleexp.tlb v4.0 or higher. Updates in post incorporated into project.

---

There's now a 64-bit compatible version of this project for twinBASIC!

https://github.com/fafalone/PreviewHandler


In addition to 64bit support, I updated the code to work better with the crappy Adobe PDF handler while not breaking the crappy MS TXT Preview handler, and additionally fixed an issue where local server created objects escape the automatic DPI scaling applied to your dpi unaware app.These changes can be backported to VB6 with a little effort, but I haven't done so yet.