IPreviewHandler Unload COM Objects is time consuming and freezes the application

I am trying to use the IPreviewHandler interface to display window 7, like viewing on TPanel in my application.

The problem occurs when I destroy the preview object by calling Unload (which is designed to delete COM objects) and then destroy the object. The application freezes (immediately after the destructor) until the preview process is complete. This may take several minutes. It happens a lot when .pdfs is viewed with adobe.

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

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.

Create 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; 
+4
2

, , , . , , threadpool workthread , , , , . ShellBrowser: https://www.jam-software.de/shellbrowser_delphi/file-preview.shtml

+3
LInitializeWithFile.Initialize(StringToOleStr(FFileName), STGM_READ)

. ?

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

.

0

Source: https://habr.com/ru/post/1659811/


All Articles