2016-11-04 57 views
4

我正嘗試使用IPreviewHandler接口在我的應用程序中的TPanel上顯示一個類似於Windows 7的預覽。IPreviewHandler卸載COM對象需要很長時間並凍結應用程序

當我通過調用Unload(這意味着處理COM對象)並且然後將對象作爲對象來銷燬預覽對象時,就會出現問題。應用程序將凍結(直接在析構函數之後),直到預覽主機進程退出。這可能需要幾分鐘的時間。使用Adobe預覽.pdf時會發生很多情況。

我想知道是否有辦法避免這種情況/或以不同的方式來完成文件預覽?

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. 

創建預覽

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; 

回答

3

我們注意到了這個令人討厭的行爲也一樣,壞的事情是你無法控制的預覽處理程序需要多長時間裝載和卸載。我們最終爲每個預覽文件使用了一個帶有workerthread的線程池,在那些線程中我們現在可以加載和卸載,並且這種工作正常,沒有延遲。這可作爲閱讀使用的控制,我們ShellBrowser組件的一部分:https://www.jam-software.de/shellbrowser_delphi/file-preview.shtml

0
LInitializeWithFile.Initialize(StringToOleStr(FFileName), STGM_READ) 

導致內存泄漏。你的問題?

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

阻止它。

相關問題