是否有用于Windows 7的预览处理程序VCL？

Question

本文

http://msdn.microsoft.com/en-gb/library/bb776867.aspx

介绍了在Windows预览处理当一个 项目被选择以显示 轻巧，丰富的，只读的预览 被称为

预览处理程序文件内容位于视图的 阅读窗格中。这是在没有 启动文件的关联 应用程序的情况下完成的。

和...

预览处理程序是一个托管 应用。主机包括 微软Windows资源管理器在Windows Vista中 或Microsoft Outlook 2007

是否有可以用来作为这样的处理程序起点一些德尔福VCL代码？

Answer 1

@Mjn，我知道我在为我的blog写一篇文章来实现Delphi预览处理程序，但由于时间不够，我不知道这是什么时候完成的，因为其他用户提到的那一刻不存在Delphi中的VCL组件实现预览处理程序，过去我为客户实现了几个预览处理程序，但是使用了Delphi-Prism和C＃。

作为起点，如果你想开始你自己的项目，这里我留下一些提示。

• 必须使用IPreviewHandler，InitializeWithFile，InitializeWithStream，IPreviewHandlerFrame，IPreviewHandlerVisuals接口。

这是这些接口

uses 
    Windows, ActiveX, AxCtrls, ShlObj, ComObj; 

type 


    IIPreviewHandler = interface(IUnknown) 
    ['{8895b1c6-b41f-4c1c-a562-0d564250836f}'] 
    function SetWindow(hwnd: HWND; var RectangleRef: TRect): HRESULT; stdcall; 
    function SetRect(var RectangleRef: TRect): HRESULT; stdcall; 
    function DoPreview(): HRESULT; stdcall; 
    function Unload(): HRESULT; stdcall; 
    function SetFocus(): HRESULT; stdcall; 
    function QueryFocus(phwnd: HWND): HRESULT; stdcall; 
    function TranslateAccelerator(PointerToWindowMessage: MSG): HRESULT; stdcall; 
    end; 

    IInitializeWithFile = interface(IUnknown) 
    ['{b7d14566-0509-4cce-a71f-0a554233bd9b}'] 
    function Initialize(pszFilePath: LPWSTR; grfMode: DWORD):HRESULT;stdcall; 
    end; 

    IInitializeWithStream = interface(IUnknown) 
    ['{b824b49d-22ac-4161-ac8a-9916e8fa3f7f}'] 
    function Initialize(pstream: IStream; grfMode: DWORD): HRESULT; stdcall; 
    end; 

    IIPreviewHandlerFrame = interface(IUnknown) 
    ['{fec87aaf-35f9-447a-adb7-20234491401a}'] 
    function GetWindowContext(pinfo: HWND): HRESULT; stdcall; 
    function TranslateAccelerator(PointerToWindowMessage: MSG): HRESULT; stdcall; 
    end; 

    IIPreviewHandlerVisuals = interface(IUnknown) 
    ['{8327b13c-b63f-4b24-9b8a-d010dcc3f599}'] 
     function SetBackgroundColor(color: COLORREF): HRESULT; stdcall; 
     function SetFont(plf:LOGFONTW): HRESULT; stdcall; 
     function SetTextColor(color: COLORREF): HRESULT; stdcall; 
    end; 

• 你必须创建一个类COM DLL从这些接口IIPreviewHandler下降的标头的德尔福翻译，IIPreviewHandlerVisuals，IOleWindow的，的IObjectWithSite管理可视化和第二类来加载文件来显示。这个班级必须从IPreviewHandler,IInitializeWithStream下降。

像这样

TMyPreviewHandler = class(IIPreviewHandler, IIPreviewHandlerVisuals, IOleWindow, IObjectWithSite) 

    TMyStream = class(IIPreviewHandler, IInitializeWithStream, IStream) 

• 现在你必须创建自己的实现的父接口的方法。 这是你需要实现的方法列表。

  IPreviewHandler - > DoPreview，SetWindow，SetRect，Unload，SetFocus，TranslateAccelerator，QueryFocus。

  IObjectWithSite - > GetSite，SetSite。

  IOleWindow的 - > GetWindow

  IPreviewHandlerVisuals - > SetBackgroundColor，setfont程序，为setColor

  InitializeWithStream - >初始化

• 最后，你必须在系统中注册的COM以及作为将使用你的PrevieHandler类的文件扩展名。

• 检查这个项目为起点Windows Preview Handler Pack（是用C＃）和本文View Data Your Way With Our Managed Preview Handler Framework

Answer 2

我从来没有见过这样的事情，但由于整个事情都是在COM中构建的，因此您首先需要导入类型库并实现所需的接口，包括IPreviewHandlerFrame。 [对不起，不是很有帮助。但是这是一个相当晦涩的领域，所以我并不感到惊讶，德尔福还没有为此设置预构建组件。]

Answer 3

我想你必须自己编写一个COM-Server，它提供了描述的IPreviwHandler- Interfacees。 （没有类型库可以导入...）我对这样的代码非常感兴趣，而且我正在寻找相当长的一段时间。我对COM-Server写作不是很有经验......如果你发现了什么，请告诉我！正如我将分享我的代码也是，如果我得到一些...

安德烈亚斯

Answer 4

我无法找到Delphi中使用IPreviewHandlerFrame任何引用，但还是设法拿出一个C＃示例here - 也许它会给你一个起点。

Answer 5

我做了这个单位来处理所有的预览处理程序的东西：

unit PreviewHandler; 

{$WARN SYMBOL_PLATFORM OFF} 
{.$DEFINE USE_CODESITE} 

interface 

uses 
    Classes, Controls, ComObj; 

type 
    TPreviewHandler = class abstract 
    public 
    { Create all controls needed for the preview and connect them to the 
     parent given. The parent follows the size, color and font of the preview 
     pane. The parent will stay valid until this instance is destroyed, so if 
     you make the parent also the owner of the controls you don't need to free 
     them in Destroy. } 
    constructor Create(AParent: TWinControl); virtual; 
    class function GetComClass: TComClass; virtual; abstract; 
    class procedure Register(const AClassID: TGUID; const AName, ADescription, AFileExtension: string); 
    {$REGION 'Clear Content'} 
    /// <summary>Clear Content</summary> 
    /// <remarks>This method is called when the preview should be cleared because 
    /// either another item was selected or the PreviewHandler will be 
    /// closed.</remarks> 
    {$ENDREGION} 
    procedure Unload; virtual; 
    end; 

    TStreamPreviewHandler = class abstract(TPreviewHandler) 
    public 
    {$REGION 'Render the preview from the stream data'} 
    /// <summary>Render the preview from the stream data</summary> 
    /// <remarks>Here you should render the data from the stream in whatever 
    /// fashion you want.</remarks> 
    {$ENDREGION} 
    procedure DoPreview(Stream: TStream); virtual; abstract; 
    class function GetComClass: TComClass; override; final; 
    end; 

    TFilePreviewHandler = class abstract(TPreviewHandler) 
    public 
    {$REGION 'Render the preview from the file path'} 
    /// <summary>Render the preview from the file path</summary> 
    /// <remarks>Here you should render the data from the file path in whatever 
    /// fashion you want.</remarks> 
    {$ENDREGION} 
    procedure DoPreview(const FilePath: String); virtual; abstract; 
    class function GetComClass: TComClass; override; final; 
    end; 

implementation 

uses 
{$IFDEF USE_CODESITE} 
    CodeSiteLogging, 
{$ENDIF} 
    Windows, ActiveX, ComServ, ShlObj, PropSys, Types, SysUtils, Graphics, ExtCtrls; 

type 
    TPreviewHandlerClass = class of TPreviewHandler; 
    TComPreviewHandler = class(TComObject, IPreviewHandler, IPreviewHandlerVisuals, IObjectWithSite, IOleWindow) 
    strict private 
    function IPreviewHandler.DoPreview = IPreviewHandler_DoPreview; 
    function ContextSensitiveHelp(fEnterMode: LongBool): HRESULT; stdcall; 
    function GetSite(const riid: TGUID; out site: IInterface): HRESULT; stdcall; 
    function GetWindow(out wnd: HWND): HRESULT; stdcall; 
    function IPreviewHandler_DoPreview: HRESULT; stdcall; 
    function QueryFocus(var phwnd: HWND): HRESULT; stdcall; 
    function SetBackgroundColor(color: Cardinal): HRESULT; stdcall; 
    function SetFocus: HRESULT; stdcall; 
    function SetFont(const plf: tagLOGFONTW): HRESULT; stdcall; 
    function SetRect(var prc: TRect): HRESULT; stdcall; 
    function SetSite(const pUnkSite: IInterface): HRESULT; stdcall; 
    function SetTextColor(color: Cardinal): HRESULT; stdcall; 
    function SetWindow(hwnd: HWND; var prc: TRect): HRESULT; stdcall; 
    function TranslateAccelerator(var pmsg: tagMSG): HRESULT; stdcall; 
    function Unload: HRESULT; stdcall; 
    private 
    FBackgroundColor: Cardinal; 
    FBounds: TRect; 
    FContainer: TWinControl; 
    FLogFont: tagLOGFONTW; 
    FParentWindow: HWND; 
    FPreviewHandler: TPreviewHandler; 
    FPreviewHandlerClass: TPreviewHandlerClass; 
    FPreviewHandlerFrame: IPreviewHandlerFrame; 
    FSite: IInterface; 
    FTextColor: Cardinal; 
    protected 
    procedure CheckContainer; 
    procedure CheckPreviewHandler; 
    procedure InternalUnload; virtual; abstract; 
    procedure InternalDoPreview; virtual; abstract; 
    property Container: TWinControl read FContainer; 
    property PreviewHandler: TPreviewHandler read FPreviewHandler; 
    public 
    destructor Destroy; override; 
    property PreviewHandlerClass: TPreviewHandlerClass read FPreviewHandlerClass write FPreviewHandlerClass; 
    end; 

    TComStreamPreviewHandler = class(TComPreviewHandler, IInitializeWithStream) 
    strict private 
    function IInitializeWithStream.Initialize = IInitializeWithStream_Initialize; 
    function IInitializeWithStream_Initialize(const pstream: IStream; grfMode: Cardinal): HRESULT; stdcall; 
    private 
    FIStream: IStream; 
    FMode: Cardinal; 
    function GetPreviewHandler: TStreamPreviewHandler; 
    protected 
    procedure InternalUnload; override; 
    procedure InternalDoPreview; override; 
    property PreviewHandler: TStreamPreviewHandler read GetPreviewHandler; 
    end; 

    TComFilePreviewHandler = class(TComPreviewHandler, IInitializeWithFile) 
    strict private 
    function IInitializeWithFile.Initialize = IInitializeWithFile_Initialize; 
    function IInitializeWithFile_Initialize(pszFilePath: LPCWSTR; grfMode: DWORD): HRESULT; stdcall; 
    private 
    FFilePath: string; 
    FMode: DWORD; 
    function GetPreviewHandler: TFilePreviewHandler; 
    protected 
    procedure InternalDoPreview; override; 
    procedure InternalUnload; override; 
    property PreviewHandler: TFilePreviewHandler read GetPreviewHandler; 
    end; 

    TComPreviewHandlerFactory = class(TComObjectFactory) 
    private 
    FFileExtension: string; 
    FPreviewHandlerClass: TPreviewHandlerClass; 
    class procedure DeleteRegValue(const Key, ValueName: string; RootKey: DWord); 
    class function IsRunningOnWOW64: Boolean; 
    protected 
    property FileExtension: string read FFileExtension; 
    public 
    constructor Create(APreviewHandlerClass: TPreviewHandlerClass; const AClassID: TGUID; const AName, ADescription, AFileExtension: string); 
    function CreateComObject(const Controller: IUnknown): TComObject; override; 
    procedure UpdateRegistry(Register: Boolean); override; 
    property PreviewHandlerClass: TPreviewHandlerClass read FPreviewHandlerClass; 
    end; 

    TWinControlHelper = class helper for TWinControl 
    public 
    procedure SetFocusTabFirst; 
    procedure SetFocusTabLast; 
    procedure SetBackgroundColor(AColor: Cardinal); 
    procedure SetBoundsRect(const ARect: TRect); 
    procedure SetTextColor(AColor: Cardinal); 
    procedure SetTextFont(const Source: tagLOGFONTW); 
    end; 

    TIStreamAdapter = class(TStream) 
    private 
    FTarget: IStream; 
    protected 
    function GetSize: Int64; override; 
    procedure SetSize(NewSize: Longint); override; 
    procedure SetSize(const NewSize: Int64); override; 
    public 
    constructor Create(ATarget: IStream); 
    function Read(var Buffer; Count: Longint): Longint; override; 
    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override; 
    function Write(const Buffer; Count: Longint): Longint; override; 
    property Target: IStream read FTarget; 
    end; 

procedure TWinControlHelper.SetFocusTabFirst; 
begin 
    SelectNext(nil, true, true); 
end; 

procedure TWinControlHelper.SetFocusTabLast; 
begin 
    SelectNext(nil, false, true); 
end; 

procedure TWinControlHelper.SetBackgroundColor(AColor: Cardinal); 
begin 
    Color := AColor; 
end; 

procedure TWinControlHelper.SetBoundsRect(const ARect: TRect); 
begin 
    SetBounds(ARect.Left, ARect.Top, ARect.Right - ARect.Left, ARect.Bottom - ARect.Top); 
end; 

procedure TWinControlHelper.SetTextColor(AColor: Cardinal); 
begin 
    Font.Color := AColor; 
end; 

procedure TWinControlHelper.SetTextFont(const Source: tagLOGFONTW); 
var 
    fontStyle: TFontStyles; 
begin 
    Font.Height := Source.lfHeight; 
    fontStyle := Font.Style; 
    if Source.lfWeight >= FW_BOLD then 
    Include(fontStyle, fsBold); 
    if Source.lfItalic = 1 then 
    Include(fontStyle, fsItalic); 
    if Source.lfUnderline = 1 then 
    Include(fontStyle, fsUnderline); 
    if Source.lfStrikeOut = 1 then 
    Include(fontStyle, fsStrikeOut); 
    Font.Style := fontStyle; 
    Font.Charset := TFontCharset(Source.lfCharSet); 
    Font.Name := Source.lfFaceName; 
    case Source.lfPitchAndFamily and $F of 
    VARIABLE_PITCH: Font.Pitch := fpVariable; 
    FIXED_PITCH: Font.Pitch := fpFixed; 
    else 
    Font.Pitch := fpDefault; 
    end; 
    Font.Orientation := Source.lfOrientation; 
end; 

constructor TComPreviewHandlerFactory.Create(APreviewHandlerClass: TPreviewHandlerClass; const AClassID: TGUID; const 
    AName, ADescription, AFileExtension: string); 
begin 
    inherited Create(ComServ.ComServer, APreviewHandlerClass.GetComClass, AClassID, AName, ADescription, ciMultiInstance, tmApartment); 
    FPreviewHandlerClass := APreviewHandlerClass; 
    FFileExtension := AFileExtension; 
end; 

function TComPreviewHandlerFactory.CreateComObject(const Controller: IUnknown): TComObject; 
begin 
    result := inherited CreateComObject(Controller); 
    TComPreviewHandler(result).PreviewHandlerClass := PreviewHandlerClass; 
end; 

class procedure TComPreviewHandlerFactory.DeleteRegValue(const Key, ValueName: string; RootKey: DWord); 
var 
    RegKey: HKEY; 
begin 
    if RegOpenKeyEx(RootKey, PChar(Key), 0, KEY_ALL_ACCESS, regKey) = ERROR_SUCCESS then begin 
    try 
     RegDeleteValue(regKey, PChar(ValueName)); 
    finally 
     RegCloseKey(regKey) 
    end; 
    end; 
end; 

class function TComPreviewHandlerFactory.IsRunningOnWOW64: Boolean; 
{ code taken from www.delphidabbler.com "IsWow64" } 
type 
    // Type of IsWow64Process API fn 
    TIsWow64Process = function(Handle: Windows.THandle; var Res: Windows.BOOL): Windows.BOOL; stdcall; 
var 
    IsWow64Result: Windows.BOOL; // Result from IsWow64Process 
    IsWow64Process: TIsWow64Process; // IsWow64Process fn reference 
begin 
{$IF defined(CPUX64)} 
    // compiled for 64-bit: can't be running on Wow64 
    result := false; 
{$ELSE} 
    // Try to load required function from kernel32 
    IsWow64Process := Windows.GetProcAddress(Windows.GetModuleHandle('kernel32'), 'IsWow64Process'); 
    if Assigned(IsWow64Process) then begin 
    // Function is implemented: call it 
    if not IsWow64Process(Windows.GetCurrentProcess, IsWow64Result) then 
     raise SysUtils.Exception.Create('IsWindows64: bad process handle'); 
    // Return result of function 
    Result := IsWow64Result; 
    end 
    else 
    // Function not implemented: can't be running on Wow64 
    Result := False; 
{$IFEND} 
end; 

procedure TComPreviewHandlerFactory.UpdateRegistry(Register: Boolean); 
var 
    plainFileName: string; 
    sAppID, sClassID, ProgID, ServerKeyName, RegPrefix: string; 
    RootKey: HKEY; 
    RootKey2: HKEY; 
begin 
    if Instancing = ciInternal then 
    Exit; 

    ComServer.GetRegRootAndPrefix(RootKey, RegPrefix); 
    if ComServer.PerUserRegistration then 
    RootKey2 := HKEY_CURRENT_USER 
    else 
    RootKey2 := HKEY_LOCAL_MACHINE; 
    sClassID := GUIDToString(ClassID); 
    ProgID := GetProgID; 
    ServerKeyName := RegPrefix + 'CLSID\' + sClassID + '\' + ComServer.ServerKey; 
    if IsRunningOnWOW64 then 
    sAppID := '{534A1E02-D58F-44f0-B58B-36CBED287C7C}' // for Win32 shell extension running on Win64 
    else 
    sAppID := '{6d2b5079-2f0b-48dd-ab7f-97cec514d30b}'; 

    if Register then begin 
    inherited; 
    plainFileName := ExtractFileName(ComServer.ServerFileName); 
    CreateRegKey(RegPrefix + 'CLSID\' + sClassID, 'AppID', sAppID, RootKey); 
    if ProgID <> '' then begin 
     CreateRegKey(ServerKeyName, 'ProgID', ProgID, RootKey); 
     CreateRegKey(ServerKeyName, 'VersionIndependentProgID', ProgID, RootKey); 
     CreateRegKey(RegPrefix + ProgID + '\shellex\' + SID_IPreviewHandler, '', sClassID, RootKey); 
     CreateRegKey(RegPrefix + FileExtension, '', ProgID, RootKey); 
     CreateRegKey('SOFTWARE\Microsoft\Windows\CurrentVersion\PreviewHandlers', sClassID, Description, RootKey2); 
    end; 
    end 
    else begin 
    if ProgID <> '' then begin 
     DeleteRegValue('SOFTWARE\Microsoft\Windows\CurrentVersion\PreviewHandlers', sClassID, RootKey2); 
     DeleteRegKey(RegPrefix + FileExtension, RootKey); 
     DeleteRegKey(RegPrefix + ProgID + '\shellex', RootKey); 
    end; 
    inherited; 
    end; 
end; 

destructor TComPreviewHandler.Destroy; 
begin 
    FPreviewHandler.Free; 
    FContainer.Free; 
    inherited Destroy; 
end; 

procedure TComPreviewHandler.CheckContainer; 
begin 
    if FContainer = nil then begin 
    { I sprang for a TPanel here, because it makes things so much simpler. } 
    FContainer := TPanel.Create(nil); 
    TPanel(FContainer).BevelOuter := bvNone; 
    FContainer.SetBackgroundColor(FBackgroundColor); 
    FContainer.SetTextFont(FLogFont); 
    FContainer.SetTextColor(FTextColor); 
    FContainer.SetBoundsRect(FBounds); 
    FContainer.ParentWindow := FParentWindow; 
    end; 
end; 

procedure TComPreviewHandler.CheckPreviewHandler; 
begin 
    if FPreviewHandler = nil then begin 
    CheckContainer; 
    FPreviewHandler := PreviewHandlerClass.Create(Container); 
    end; 
end; 

function TComPreviewHandler.ContextSensitiveHelp(fEnterMode: LongBool): HRESULT; 
begin 
    result := E_NOTIMPL; 
end; 

function TComPreviewHandler.GetSite(const riid: TGUID; out site: IInterface): HRESULT; 
begin 
    site := nil; 
    if FSite = nil then 
    result := E_FAIL 
    else if Supports(FSite, riid, site) then 
    result := S_OK 
    else 
    result := E_NOINTERFACE; 
end; 

function TComPreviewHandler.GetWindow(out wnd: HWND): HRESULT; 
begin 
    if Container = nil then begin 
    result := E_FAIL; 
    end 
    else begin 
    wnd := Container.Handle; 
    result := S_OK; 
    end; 
end; 

function TComPreviewHandler.IPreviewHandler_DoPreview: HRESULT; 
begin 
    try 
    CheckPreviewHandler; 
    InternalDoPreview; 
    except 
    on E: Exception do begin 
    {$IFDEF USE_CODESITE} 
     CodeSite.SendException(E); 
    {$ENDIF} 
    end; 
    end; 
    result := S_OK; 
end; 

function TComPreviewHandler.QueryFocus(var phwnd: HWND): HRESULT; 
begin 
    phwnd := GetFocus; 
    result := S_OK; 
end; 

function TComPreviewHandler.SetBackgroundColor(color: Cardinal): HRESULT; 
begin 
    FBackgroundColor := color; 
    if Container <> nil then 
    Container.SetBackgroundColor(FBackgroundColor); 
    result := S_OK; 
end; 

function TComPreviewHandler.SetFocus: HRESULT; 
begin 
    if Container <> nil then begin 
    if GetKeyState(VK_SHIFT) < 0 then 
     Container.SetFocusTabLast 
    else 
     Container.SetFocusTabFirst; 
    end; 
    result := S_OK; 
end; 

function TComPreviewHandler.SetFont(const plf: tagLOGFONTW): HRESULT; 
begin 
    FLogFont := plf; 
    if Container <> nil then 
    Container.SetTextFont(FLogFont); 
    result := S_OK; 
end; 

function TComPreviewHandler.SetRect(var prc: TRect): HRESULT; 
begin 
    FBounds := prc; 
    if Container <> nil then 
    Container.SetBoundsRect(FBounds); 
    result := S_OK; 
end; 

function TComPreviewHandler.SetSite(const pUnkSite: IInterface): HRESULT; 
begin 
    FSite := PUnkSite; 
    FPreviewHandlerFrame := FSite as IPreviewHandlerFrame; 
    result := S_OK; 
end; 

function TComPreviewHandler.SetTextColor(color: Cardinal): HRESULT; 
begin 
    FTextColor := color; 
    if Container <> nil then 
    Container.SetTextColor(FTextColor); 
    result := S_OK; 
end; 

function TComPreviewHandler.SetWindow(hwnd: HWND; var prc: TRect): HRESULT; 
begin 
    FParentWindow := hwnd; 
    FBounds := prc; 
    if Container <> nil then begin 
    Container.ParentWindow := FParentWindow; 
    Container.SetBoundsRect(FBounds); 
    end; 
    result := S_OK; 
end; 

function TComPreviewHandler.TranslateAccelerator(var pmsg: tagMSG): HRESULT; 
begin 
    if FPreviewHandlerFrame = nil then 
    result := S_FALSE 
    else 
    result := FPreviewHandlerFrame.TranslateAccelerator(pmsg); 
end; 

function TComPreviewHandler.Unload: HRESULT; 
begin 
    if PreviewHandler <> nil then 
    PreviewHandler.Unload; 
    InternalUnload; 
    result := S_OK; 
end; 

constructor TPreviewHandler.Create(AParent: TWinControl); 
begin 
    inherited Create; 
end; 

class procedure TPreviewHandler.Register(const AClassID: TGUID; const AName, ADescription, AFileExtension: string); 
begin 
    TComPreviewHandlerFactory.Create(Self, AClassID, AName, ADescription, AFileExtension); 
end; 

procedure TPreviewHandler.Unload; 
begin 
end; 

constructor TIStreamAdapter.Create(ATarget: IStream); 
begin 
    inherited Create; 
    FTarget := ATarget; 
end; 

function TIStreamAdapter.GetSize: Int64; 
var 
    statStg: TStatStg; 
begin 
    if Target.Stat(statStg, STATFLAG_NONAME) = S_OK then 
    result := statStg.cbSize 
    else 
    result := -1; 
end; 

function TIStreamAdapter.Read(var Buffer; Count: Longint): Longint; 
begin 
    Target.Read(@Buffer, Count, @result); 
end; 

function TIStreamAdapter.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; 
begin 
    Target.Seek(Offset, Ord(Origin), result); 
end; 

procedure TIStreamAdapter.SetSize(const NewSize: Int64); 
begin 
    raise ENotImplemented.Create('SetSize not implemented'); 
// Target.SetSize(NewSize); 
end; 

procedure TIStreamAdapter.SetSize(NewSize: Longint); 
begin 
    SetSize(Int64(NewSize)); 
end; 

function TIStreamAdapter.Write(const Buffer; Count: Longint): Longint; 
begin 
    raise ENotImplemented.Create('Write not implemented'); 
// Target.Write(@Buffer, Count, @result); 
end; 

function TComStreamPreviewHandler.GetPreviewHandler: TStreamPreviewHandler; 
begin 
    Result := inherited PreviewHandler as TStreamPreviewHandler; 
end; 

function TComStreamPreviewHandler.IInitializeWithStream_Initialize(const pstream: IStream; grfMode: Cardinal): HRESULT; 
begin 
    FIStream := pStream; 
    FMode := grfMode; 
    result := S_OK; 
end; 

procedure TComStreamPreviewHandler.InternalUnload; 
begin 
    FIStream := nil; 
end; 

procedure TComStreamPreviewHandler.InternalDoPreview; 
var 
    stream: TIStreamAdapter; 
begin 
    stream := TIStreamAdapter.Create(FIStream); 
    try 
    PreviewHandler.DoPreview(stream); 
    finally 
    stream.Free; 
    end; 
end; 

function TComFilePreviewHandler.GetPreviewHandler: TFilePreviewHandler; 
begin 
    Result := inherited PreviewHandler as TFilePreviewHandler; 
end; 

function TComFilePreviewHandler.IInitializeWithFile_Initialize(pszFilePath: LPCWSTR; grfMode: DWORD): HRESULT; 
begin 
    FFilePath := pszFilePath; 
    FMode := grfMode; 
    result := S_OK; 
end; 

procedure TComFilePreviewHandler.InternalDoPreview; 
begin 
    PreviewHandler.DoPreview(FFilePath); 
end; 

procedure TComFilePreviewHandler.InternalUnload; 
begin 
    FFilePath := ''; 
end; 

class function TFilePreviewHandler.GetComClass: TComClass; 
begin 
    result := TComFilePreviewHandler; 
end; 

class function TStreamPreviewHandler.GetComClass: TComClass; 
begin 
    result := TComStreamPreviewHandler; 
end; 

initialization 
{$IFDEF USE_CODESITE} 
    CodeSiteManager.ConnectUsingTcp; 
{$ENDIF} 
end. 

基于此单元的示例预览处理程序如下所示：

unit MyPreviewHandler; 

interface 

uses 
    PreviewHandler, Classes, Controls, StdCtrls; 

const 
    {$REGION 'Unique ClassID of your PreviewHandler'} 
    /// <summary>Unique ClassID of your PreviewHandler</summary> 
    /// <remarks>Don't forget to create a new one. Best use Ctrl-G.</remarks> 
    {$ENDREGION} 
    CLASS_MyPreviewHandler: TGUID = '{64644512-C345-469F-B5FB-EB351E20129D}'; 

type 
    {$REGION 'Sample PreviewHandler'} 
    /// <summary>Sample PreviewHandler</summary> 
    /// <remarks>A sample PreviewHandler. You only have to derive from 
    /// TFilePreviewHandler or TStreamPreviewHandler and override some methods.</remarks> 
    {$ENDREGION} 
    TMyPreviewHandler = class(TFilePreviewHandler) 
    private 
    FTextLabel: TLabel; 
    protected 
    public 
    constructor Create(AParent: TWinControl); override; 
    procedure Unload; override; 
    procedure DoPreview(const FilePath: string); override; 
    property TextLabel: TLabel read FTextLabel; 
    end; 

implementation 

uses 
    SysUtils; 

constructor TMyPreviewHandler.Create(AParent: TWinControl); 
begin 
    inherited; 
    FTextLabel := TLabel.Create(AParent); 
    FTextLabel.Parent := AParent; 
    FTextLabel.AutoSize := false; 
    FTextLabel.Align := alClient; 
    FTextLabel.Alignment := taCenter; 
    FTextLabel.Layout := tlCenter; 
    FTextLabel.WordWrap := true; 
end; 

procedure TMyPreviewHandler.DoPreview(const FilePath: string); 
begin 
    TextLabel.Caption := GetPackageDescription(PWideChar(FilePath)); 
end; 

procedure TMyPreviewHandler.Unload; 
begin 
    TextLabel.Caption := ''; 
    inherited; 
end; 

initialization 
    { Register your PreviewHandler with the ClassID, name, descripton and file extension } 
    TMyPreviewHandler.Register(CLASS_MyPreviewHandler, 'bplfile', 'BPL Binary Preview Handler', '.bpl'); 
end. 

library MyPreviewHandlerLib; 

uses 
    ComServ, 
    PreviewHandler in 'PreviewHandler.pas' {PreviewHandler: CoClass}, 
    MyPreviewHandler in 'MyPreviewHandler.pas'; 

exports 
    DllGetClassObject, 
    DllCanUnloadNow, 
    DllRegisterServer, 
    DllUnregisterServer, 
    DllInstall; 

{$R *.RES} 

begin 
end. 

你可能会对this article in my blog感兴趣，该文章描述了该框架的更多细节。