En Delphi es posible vincular una interfaz a un objeto que no lo implementa

Question

Sé que Delphi XE2 tiene la nueva interfaz de TVirtual para crear implementaciones de una interfaz en tiempo de ejecución. Lamentablemente, no estoy usando XE2 y me pregunto qué tipo de piratería está involucrado en hacer este tipo de cosas en versiones anteriores de Delphi.

Digamos que tengo la siguiente interfaz:

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

¿Es posible que se unen a esta interfaz en tiempo de ejecución sin la ayuda del compilador?

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; 

He intentado un simple fundido duro:

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

pero el compilador lo impide.

Luego probé con un reparto as y al menos compilar:

MyInterface := TMyClass.Create as IMyInterface; 

Así que imaginemos la clave es conseguir QueryInterface para devolver un puntero válido para una implementación de la interfaz que se está consultando. ¿Cómo podría construir uno en tiempo de ejecución?

He buscado en System.pas, así que estoy al menos familiarizado con el funcionamiento de GetInterface, GetInterfaceEntry y InvokeImplGetter. (afortunadamente Embacadero eligió dejar la fuente pascal junto con el ensamblaje optimizado). Puede que no esté leyendo correctamente, pero parece que puede haber entradas de interfaz con un desplazamiento de cero, en cuyo caso hay un medio alternativo de asignar la interfaz usando InvokeImplGetter.

Mi objetivo final es simular algunas de las capacidades de proxies dinámicos y burlas que están disponibles en idiomas con soporte de reflexión. Si puedo enlazar con éxito a un objeto que tenga los mismos nombres de método y firmas que la interfaz, sería un gran primer paso. ¿Es esto posible o estoy ladrando el árbol equivocado?

Answer 1

La adición de soporte para una interfaz a una clase existente en tiempo de ejecución puede hacerse teóricamente, pero sería realmente complicado, y requeriría D2010 o posterior para soporte RTTI.

Cada clase tiene un VMT y el VMT tiene un puntero de tabla de interfaz. (Consulte la implementación de TObject.GetInterfaceTable). La tabla de interfaz contiene entradas de interfaz, que contienen algunos metadatos, incluido el GUID, y un puntero a la interfaz vtable. Si realmente quisiera, podría crear una copia de la tabla de la interfaz (¡NO haga esto la original, es probable que termine corrompiendo la memoria!) Agregue una nueva entrada que contenga una nueva interfaz vtable con los indicadores apuntando a los métodos correctos, (con los que podría hacer coincidir al buscarlos con RTTI) y luego cambie el puntero de la tabla de la interfaz de la clase para que apunte a la nueva tabla.

Ten mucho cuidado. Este tipo de trabajo no es realmente para los débiles de corazón, y me parece que tiene una utilidad limitada. Pero sí, es posible.

Answer 2

no estoy seguro, lo que quiere lograr y por qué desea enlazar dinámicamente esa interfaz, pero aquí es una manera de hacerlo (no sé si se ajusta a sus necesidades):

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; 

Y este es el código de prueba correspondiente:

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;