TInterfacedObjectを使用して既存のインターフェースIMessageFilterを拡張する方法は？

Question

私がここで説明したようIOleMessageFilterを実装する：

How to: Fix 'Application is Busy' and 'Call was Rejected By Callee' Errors

私は正常に動作Delphiの実装を発見した：

`EOleException: Call was rejected by callee` while iterating through `Office.Interop.Word.Documents`

（解答でUPDATE＃1を参照）

実装は次のようになります。

type 
    TOleMessageFilter = class(TInterfacedObject, IMessageFilter) 
    public 
    // IMessageFilter 
    function HandleInComingCall(dwCallType: Longint; htaskCaller: HTask; 
     dwTickCount: Longint; lpInterfaceInfo: PInterfaceInfo): Longint;stdcall; 
    function RetryRejectedCall(htaskCallee: HTask; dwTickCount: Longint; 
     dwRejectType: Longint): Longint;stdcall; 
    function MessagePending(htaskCallee: HTask; dwTickCount: Longint; 
     dwPendingType: Longint): Longint;stdcall; 

    // TOleMessageFilter 
    procedure RegisterFilter; 
    procedure RevokeFilter; 
    end; 

implementation 

function TOleMessageFilter.HandleInComingCall(dwCallType: Integer; htaskCaller: HTask; dwTickCount: Integer; lpInterfaceInfo: PInterfaceInfo): Longint; 
begin 
    Result := 0; 
end; 

function TOleMessageFilter.MessagePending(htaskCallee: HTask; dwTickCount, dwPendingType: Integer): Longint; 
begin 
    Result := 2 //PENDINGMSG_WAITDEFPROCESS 
end;   

function TOleMessageFilter.RetryRejectedCall(htaskCallee: HTask; dwTickCount, dwRejectType: Integer): Longint; 
begin 
    Result := -1; 
    if dwRejectType = 2 then 
    Result := 99; 
end; 

procedure TOleMessageFilter.RegisterFilter; 
var 
    OldFilter: IMessageFilter; 
    NewFilter: IMessageFilter; 
begin 
    OldFilter := nil; 
    NewFilter := TOleMessageFilter.Create as IMessageFilter; 
    CoRegisterMessageFilter(NewFilter,OldFilter); 
end; 

procedure TOleMessageFilter.RevokeFilter; 
var 
    OldFilter: IMessageFilter; 
    NewFilter: IMessageFilter; 
begin 
    OldFilter := nil; 
    NewFilter := nil; 
    CoRegisterMessageFilter(NewFilter,OldFilter); 
end; 

この正確なデルファイコードは、Web上の他の多くのサイトにあります。ここまでは順調ですね。私はの代わりにクラス名をTOleMessageFilterに変更しました。

しかし、使い方はちょっと面倒です。私がしたいことはインターフェイスなどとして宣言されるように、Filterある

var 
    Filter: TOleMessageFilter; 

Filter := TOleMessageFilter.Create; 
Filter.RegisterFilter;  
...  
Filter.RevokeFilter; 
Filter.Free; 

IOleMessageFilter。

var 
    Filter: IOleMessageFilter; 

Filter := TOleMessageFilter.Create as IOleMessageFilter; 
Filter.RegisterFilter; 
... 
Filter.RevokeFilter; 
Filter := nil; 

であり、自動解放の恩恵を受けるTInterfacedObjectです。

どのように私はTOleMessageFilter = class(TInterfacedObject, IOleMessageFilter)として実装され、まだIMessageFilterは（RegisterFilter()方法で使用される期待するCoRegisterMessageFilter()でも、それを使うことができているIMessageFilterから「派生」が、まだ新しい方法RegisterFilter()とRevokeFilter()を持って、新しいIOleMessageFilterを作成してください）？

私は宣言しようとしている：

：私としても TOleMessageFilterを宣言しようとしてい

：

IOleMessageFilter = interface(IMessageFilter) 
    procedure RegisterFilter; 
    procedure RevokeFilter; 
end; 

TOleMessageFilter = class(TInterfacedObject, IOleMessageFilter) 
... 
end; 

をしかし、その後CoRegisterMessageFilterを呼び出すと、エラーがスローされます。

Interface not supported.

はEDIT

TOleMessageFilter = class(TInterfacedObject, IMessageFilter, IOleMessageFilter) 

どちらが「うまくいくか」はわかりますが、正しいアプローチであるかどうかはわかりません。

Answer 1

は、両方のインターフェイスを分割し、TOleMessageFilterがボーナスとして、あなたがこのコンストラクタ/デストラクタから行われますよう、もはやRegisterFilterとRevokeFilterを呼び出す必要はありません、実際のメッセージフィルタへの参照を保持してみましょう：

program SO46913922; 

{$APPTYPE CONSOLE} 

{$R *.res} 

uses 
    ActiveX, 
    Windows, 
    SysUtils; 


type 
    IOleMessageFilter = interface 
    ['{0ECA5DA7-F6C7-4D21-8FD3-872558F88CBE}'] 
    procedure RegisterFilter; 
    procedure RevokeFilter; 
    end; 

    TMessageFilter = class(TInterfacedObject, IMessageFilter) 
    public 
    // IMessageFilter 
    function HandleInComingCall(dwCallType: Longint; htaskCaller: HTask; 
     dwTickCount: Longint; lpInterfaceInfo: PInterfaceInfo): Longint;stdcall; 
    function RetryRejectedCall(htaskCallee: HTask; dwTickCount: Longint; 
     dwRejectType: Longint): Longint;stdcall; 
    function MessagePending(htaskCallee: HTask; dwTickCount: Longint; 
     dwPendingType: Longint): Longint;stdcall; 
    end; 

    TOleMessageFilter = class(TInterfacedObject, IOleMessageFilter) 
    private 
    Filter : IMessageFilter; 
    procedure RegisterFilter; 
    procedure RevokeFilter; 
    public 
    constructor Create; 
    destructor Destroy; override; 
    end; 


function TMessageFilter.HandleInComingCall(dwCallType: Integer; htaskCaller: HTask; dwTickCount: Integer; lpInterfaceInfo: PInterfaceInfo): Longint; 
begin 
    Result := 0; 
end; 

function TMessageFilter.MessagePending(htaskCallee: HTask; dwTickCount, dwPendingType: Integer): Longint; 
begin 
    Result := 2 //PENDINGMSG_WAITDEFPROCESS 
end; 

function TMessageFilter.RetryRejectedCall(htaskCallee: HTask; dwTickCount, dwRejectType: Integer): Longint; 
begin 
    Result := -1; 
    if dwRejectType = 2 then 
    Result := 99; 
end; 

procedure TOleMessageFilter.RegisterFilter; 
var 
    OldFilter: IMessageFilter; 

begin 
    OldFilter := nil; 
    Filter := TMessageFilter.Create; 
    CoRegisterMessageFilter(Filter,OldFilter); 
end; 

procedure TOleMessageFilter.RevokeFilter; 
var 
    OldFilter: IMessageFilter; 
    NewFilter: IMessageFilter; 
begin 
    OldFilter := nil; 
    NewFilter := nil; 
    CoRegisterMessageFilter(NewFilter,OldFilter); 
    Filter := nil; 
end; 

constructor TOleMessageFilter.Create; 
begin 
RegisterFilter; 
end; 

destructor TOleMessageFilter.Destroy; 
begin 
RevokeFilter; 
inherited; 
end; 

var 
    Filter : IOleMessageFilter; 

begin 
    try 
    CoInitialize(nil); 
    Filter := TOleMessageFilter.Create; 
    Readln; // do something 
    Filter := nil; 
    finally 
    CoUninitialize(); 
    end; 
    Readln; 
end.