IPreviewHandler Unload COM Objects takes a long time and freezes the application

Question

I am trying to use the IPreviewHandler interface to display a windows 7 like preview on a TPanel within my application.

The issue arises when I am destroying the preview object by calling Unload (which is meant to dispose of the COM objects) and then niling the object. The application will freeze (straight after the destructor) until the Preview host process exits. This can take several minutes. Happens alot when previewing .pdfs with adobe.

I want to know if there is a way to avoid this/ Or a different way to accomplish a file preview?

unit uHostPreview;

interface

uses
  Winapi.ShlObj, Winapi.Messages, Winapi.ShLwApi, Winapi.Windows,
  System.Classes,
  Vcl.Controls, Vcl.Dialogs;

type
  THostPreviewHandler = class(TCustomControl)
  private
    m_fileStream        : TFileStream;
    m_previewGUIDStr    : string;
    m_name              : string;
    m_memStream         : TMemoryStream;
    m_previewUnloading  : Boolean;
    m_loadFromMemStream : Boolean;
    m_hwnd              : HWND;
    m_previewHandler    : IPreviewHandler;
    m_msg               : string;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    function  CreateFileFromStream(const in_Stream : TMemoryStream) : string;
  protected
    procedure Paint; override;

  public

    procedure   LoadPreviewHandler;
    constructor Create(AOwner: TWinControl; in_FileName : String) overload; reintroduce;
    constructor Create(AOwner: TWinControl; in_Stream : TMemoryStream;
      in_name : string) overload; reintroduce;
    destructor  Destroy; override;
  end;

implementation

uses
 SysUtils, Graphics, ComObj, ActiveX,
 Registry, PropSys, ObBase, System.IOUtils;

constructor THostPreviewHandler.Create(AOwner: TWinControl; in_fileName : String) overload;
begin
  inherited Create(AOwner);

  m_hwnd              := AOwner.handle;
  m_previewHandler    := nil;
  m_previewGUIDStr    := '';
  m_fileStream        := nil;
  m_name              := in_fileName;
  m_loadFromMemStream := False;
  m_msg               := 'No Preview Available.';
end;

constructor THostPreviewHandler.Create(AOwner: TWinControl; in_stream : TMemoryStream;
in_name : string) overload;
begin
  inherited Create(AOwner);

 m_hwnd               := AOwner.handle;
  m_previewHandler    := nil;
  m_previewGUIDStr    := '';
  m_fileStream        := nil;
  m_memStream         := in_stream;
  m_name              := in_name;
  m_loadFromMemStream := True;
  m_msg               := 'No Preview Available.';
end;

//As Soon as the destructor finishes the application freezes until Preview Host processes end!!!
destructor THostPreviewHandler.Destroy;
begin
  if (m_previewHandler<>nil) then
  begin
    m_previewHandler.Unload;
    m_previewHandler := nil;
   end;

  if m_fileStream<>nil then
    FreeAndNil(m_fileStream);
  m_memStream := nil;

  inherited;
end;


procedure THostPreviewHandler.Paint;
var
  lpRect: TRect;
begin
//Now Done in the load preview. Means previews don't stall when rapidly switching between different files.
{ if (m_previewGUIDStr<>'') and (m_previewHandler<>nil) and not m_previewLoaded then
 begin
   m_previewLoaded := true;
   m_previewHandler.DoPreview;
   m_previewHandler.SetFocus;
 end
 else }
 if m_previewGUIDStr='' then
 begin
   lpRect:=Rect(0, 0, Self.Width, Self.Height);
   Canvas.Brush.Style :=bsClear;
   Canvas.Font.Color  :=clWindowText;
   DrawText(Canvas.Handle, PChar(m_msg) ,Length(m_msg), lpRect, DT_VCENTER or DT_CENTER or DT_SINGLELINE);
 end;
end;

function GetPreviewHandlerCLSID(const AFileName: string): string;
const
  SID_IPreviewHandler = '{8895B1C6-B41F-4C1C-A562-0D564250836F}';
var
  Buffer               : array [0..1024] of Char;
  BufSize              : DWord;
  RegQueryRes          : HResult;
  fileExtension        : string;
  LRegistry            : TRegistry;
  LExt, LFileClass     : string;
  LPerceivedType, LKey : string;

begin
  Result := '';

  fileExtension := ExtractFileExt(AFileName);

  // Searches the registry for the preview handler for the current file extension
  BufSize := Length(Buffer);
  RegQueryRes := AssocQueryString(
    ASSOCF_INIT_DEFAULTTOSTAR,
    ASSOCSTR_SHELLEXTENSION,
    PChar(fileExtension),
    SID_IPreviewHandler,
    Buffer,
    @BufSize
  );
  If RegQueryRes = S_OK then
  begin
    Result := String(Buffer)
  end
end;

procedure THostPreviewHandler.LoadPreviewHandler;
const
  GUID_ISHELLITEM = '{43826d1e-e718-42ee-bc55-a1e261c37bfe}';
var
  prc                   : TRect;
  LPreviewGUID          : TGUID;
  LInitializeWithFile   : IInitializeWithFile;
  LInitializeWithStream : IInitializeWithStream;
  LInitializeWithItem   : IInitializeWithItem;
  LIStream              : IStream;
  LShellItem            : IShellItem;
  fname                 : string;
begin
  HandleNeeded;

  m_previewGUIDStr:=GetPreviewHandlerCLSID(m_name);

  //If no matching preview handler is found. Exit.
  if m_previewGUIDStr='' then
  begin
    exit;
  end;

  if m_fileStream<>nil then
    FreeAndNil(m_fileStream);

  LPreviewGUID:= StringToGUID(m_previewGUIDStr);

  //Create a COM object to do the preview handling
  m_previewHandler := CreateComObject(LPreviewGUID) As IPreviewHandler;
  if (m_previewHandler = nil) then
  begin
    exit;
  end;

  if m_previewHandler.QueryInterface(IInitializeWithStream, LInitializeWithStream) = S_OK then
  begin
    if m_loadFromMemStream then
    begin
      LIStream := TStreamAdapter.Create(m_memStream, soReference) as IStream;
    end
    else
    begin
      m_fileStream := TFileStream.Create(m_name, fmOpenRead or fmShareDenyNone);
      LIStream := TStreamAdapter.Create(m_fileStream, soReference) as IStream;
    end;
    LInitializeWithStream.Initialize(LIStream, STGM_READ);
  end
  else if (m_previewHandler.QueryInterface(IInitializeWithFile, LInitializeWithFile) = S_OK) then
  begin
    if not m_loadFromMemStream then
    begin
      LInitializeWithFile.Initialize(StringToOleStr(m_name), STGM_READ);
    end
    else
    begin
      fname := CreateFileFromStream(m_memStream);
      LInitializeWithFile.Initialize(StringToOleStr(fname), STGM_READ);
    end;
  end
  else if ((m_previewHandler.QueryInterface(IInitializeWithItem, LInitializeWithItem) = S_OK) and (not m_loadFromMemStream)) then
  begin
    if not m_loadFromMemStream then
    begin
      SHCreateItemFromParsingName(PChar(m_name), nil, StringToGUID(GUID_ISHELLITEM), LShellItem);
      LInitializeWithItem.Initialize(LShellItem, 0);
    end
    else
    begin
      fname := CreateFileFromStream(m_memStream);
      SHCreateItemFromParsingName(PChar(fname), nil, StringToGUID(GUID_ISHELLITEM), LShellItem);
      LInitializeWithItem.Initialize(LShellItem, 0);
    end;
  end
  else
  begin
    m_msg := 'Preview Could Not be Intialized.';
  end;

  prc := ClientRect;
  m_previewHandler.SetWindow(m_hwnd, prc);
  m_previewHandler.DoPreview;
end;

function THostPreviewHandler.CreateFileFromStream(const in_Stream : TMemoryStream) : string;
var
tempPath : string;
begin
  tempPath := TPath.GetTempPath;
  tempPath := tempPath + m_name;
  in_Stream.SaveToFile(tempPath);
  result := tempPath;
end;

procedure THostPreviewHandler.WMSize(var Message: TWMSize);
var
  prc  : TRect;
begin
  inherited;
  if m_previewHandler<>nil then
  begin
    prc := ClientRect;
    m_previewHandler.SetRect(prc);
  end;
end;

end.

Creating the preview

  if m_attachPreview<>nil then
  begin
    FreeAndNil(m_attachPreview);
  end;

  memStream := TMemoryStream.Create;
  memStream.LoadFromFile('C:\Test');

  if loadFromStream then
  begin
  //Preview can be loaded from a stream or a file   
  m_attachPreview := THostPreviewHandler.Create(pnlPreview, TMemoryStream, name);
  end
  else
  begin
    m_attachPreview := THostPreviewHandler.Create(pnlPreview, filePath);
  end;

  m_attachPreview.Top := 0;
  m_attachPreview.Left := 0;
  m_attachPreview.Width := pnlPreview.ClientWidth;
  m_attachPreview.Height := pnlPreview.ClientHeight;
  m_attachPreview.Parent := pnlPreview;
  m_attachPreview.Align  := alClient;
  m_attachPreview.LoadPreviewHandler; 

Answer 1

LInitializeWithFile.Initialize(StringToOleStr(FFileName), STGM_READ)

causes a memory leak. Your problem?

os := StringToOleStr(FFileName);
LInitializeWithFile.Initialize(os, STGM_READ);
SysFreeString(os);

prevents it.

Answer 2

We noticed this annoying behavior too, the bad thing is that you cannot control how long a preview handler takes for loading and unloading. We finally used a threadpool with a workerthread for each previewed file, in those threads we now do loading and unloading and this works fine and without delays. This is available as read-to-use control as part of our ShellBrowser components: https://www.jam-software.de/shellbrowser_delphi/file-preview.shtml