Delphiでは、インターフェイスを実装していないオブジェクトにインターフェイスをバインドすることが可能です

Question

Delphi XE2には、実行時にインターフェイスの実装を作成するための新しいTVirtualInterfaceがあります。残念ながら、私はXE2を使用していません。古いバージョンのDelphiでは、この種の処理にどのような種類のハッカーが関係しているのでしょうか？

IMyInterface = interface 
    ['{8A827997-0058-4756-B02D-8DCDD32B7607}'] 
    procedure Go; 
    end; 

それは、コンパイラの助けを借りずに、実行時にこのインターフェースにバインドすることは可能です：

は、私は、次のインタフェースを持っているとしましょうか？

TMyClass = class(TObject, IInterface) 
public 
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; 
    function _AddRef: Integer; stdcall; 
    function _Release: Integer; stdcall; 
    procedure Go; //I want to dynamically bind IMyInterface.Go here 
end; 

私は、単純なハードキャストしようとしました：

var MyInterface: IMyInterface; 
begin 
    MyInterface := IMyInterface(TMyClass.Create); 
end; 

をコンパイラはこれを防ぐことができます。

は、その後、私はasキャストを試してみましたが、それは、少なくともコンパイル：

MyInterface := TMyClass.Create as IMyInterface; 

だから私は鍵がQueryInterfaceが照会されているインタフェースの実装に有効なポインタを返してもらうことであると想像します。実行時にどのように構築するのですか？

私はSystem.pasを通して掘り下げましたので、少なくともGetInterface、GetInterfaceEntry、およびInvokeImplGetterがどのように機能するのかよく知っています。 （ありがたいことにEmbacaderoは最適化されたアセンブリと一緒にパスカルソースを残すことにしました）。私はそれを正しく読んでいないかもしれませんが、0のオフセットを持つインタフェースエントリが存在する可能性があります。この場合、InvokeImplGetterを使用してインタフェースを割り当てる別の手段があります。

私の究極の目標は、リフレクションをサポートしている言語で利用可能なダイナミックプロキシとモックの能力の一部をシミュレートすることです。インターフェイスと同じメソッド名とシグネチャを持つオブジェクトに正常にバインドできれば、大きな第一歩になります。これも可能ですか、間違った木を鳴らしていますか？

Answer 1

実行時に既存のクラスへのインターフェイスのサポートを追加することは理論的には可能ですが、実際は難しく、RTTIをサポートするにはD2010以降が必要です。

各クラスにはVMTがあり、VMTにはインターフェイステーブルポインタがあります。 （TObject.GetInterfaceTableの実装を参照してください）。インタフェーステーブルには、GUIDを含むいくつかのメタデータとインタフェースvtableへのポインタを含むインタフェースエントリが含まれています。もしあなたが本当にしたいのであれば、あなたはインターフェイステーブルのコピーを作成することができます（元のものをやってはいけません;メモリが壊れてしまうでしょう！）ポインタを使って新しいインタフェースvtableを含む新しいエントリを追加してください正しいメソッドを指しています（RTTIでそれらを探すことで一致させることができます）。次に、クラスのインタフェーステーブルポインタを新しいテーブルを指すように変更します。

非常に注意してください。この種の仕事は本当に心がかすかなものではなく、限られた有用性を持っているようです。しかし、はい、可能です。

Answer 2

（それはあなたの必要性に合うかどうかを知りません）私はあなたが達成したいのか、わからないんだけど、あなたは動的にそのインターフェイスをバインドしたい理由が、ここでそれを行う方法です：

type 
    IMyInterface = interface 
    ['{8A827997-0058-4756-B02D-8DCDD32B7607}'] 
    procedure Go; 
    end; 

    TMyClass = class(TInterfacedObject, IInterface) 
    private 
    FEnabled: Boolean; 
    protected 
    property Enabled: Boolean read FEnabled; 
    public 
    constructor Create(AEnabled: Boolean); 
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; 
    procedure Go; //I want to dynamically bind IMyInterface.Go here 
    end; 

    TMyInterfaceWrapper = class(TAggregatedObject, IMyInterface) 
    private 
    FMyClass: TMyClass; 
    protected 
    property MyClass: TMyClass read FMyClass implements IMyInterface; 
    public 
    constructor Create(AMyClass: TMyClass); 
    end; 

constructor TMyInterfaceWrapper.Create(AMyClass: TMyClass); 
begin 
    inherited Create(AMyClass); 
    FMyClass := AMyClass; 
end; 

constructor TMyClass.Create(AEnabled: Boolean); 
begin 
    inherited Create; 
    FEnabled := AEnabled; 
end; 

procedure TMyClass.Go; 
begin 
    ShowMessage('Go'); 
end; 

function TMyClass.QueryInterface(const IID: TGUID; out Obj): HResult; 
begin 
    if Enabled and (IID = IMyInterface) then begin 
    IMyInterface(obj) := TMyInterfaceWrapper.Create(Self); 
    result := 0; 
    end 
    else begin 
    if GetInterface(IID, Obj) then 
     Result := 0 
    else 
     Result := E_NOINTERFACE; 
    end; 
end; 

そして、これは、対応するテストコードです：

var 
    intf: IInterface; 
    my: IMyInterface; 
begin 
    intf := TMyClass.Create(false); 
    if Supports(intf, IMyInterface, my) then 
    ShowMessage('wrong'); 

    intf := TMyClass.Create(true); 
    if Supports(intf, IMyInterface, my) then 
    my.Go; 
end;