W Delphi można powiązać interfejs z obiektem, który go nie implementuje.

Question

Wiem, że Delphi XE2 ma nowy interfejs TVirtualInterface do tworzenia implementacji interfejsu w środowisku wykonawczym. Niestety nie używam XE2 i zastanawiam się, jaki rodzaj hackery jest zaangażowany w robienie tego typu rzeczy w starszych wersjach Delphi.

Powiedzmy mam następujący interfejs:

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

to możliwe, aby wiązać się z tego interfejsu w czasie wykonywania bez pomocy kompilatora?

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; 

Próbowałem prosty dysk Obsada:

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

ale kompilator zapobiega temu.

Potem próbowałem as obsady i to przynajmniej skompilowane:

MyInterface := TMyClass.Create as IMyInterface; 

więc sobie wyobrazić, że kluczem jest dostać QueryInterface powrócić ważny wskaźnik do implementacji interfejsu poszukiwanych. W jaki sposób chciałbym zbudować jeden w czasie wykonywania?

mam wykopane przez System.pas więc jestem co najmniej dziwnie znajomy z jak GetInterface, GetInterfaceEntry i InvokeImplGetter pracy. (Na szczęście Embacadero zdecydował się opuścić źródło paschalne wraz ze zoptymalizowanym montażem). Być może nie czytam tego dobrze, ale wydaje się, że mogą istnieć wpisy interfejsu z przesunięciem zerowym, w którym to przypadku istnieje alternatywny sposób przypisania interfejsu przy użyciu InvokeImplGetter.

Moim ostatecznym celem jest symulowanie niektórych umiejętności dynamicznych serwerów proxy i makr dostępnych w językach z obsługą refleksji. Jeśli uda mi się pomyślnie powiązać obiekt, który ma takie same nazwy i sygnatury metod, jak interfejs, byłby to duży pierwszy krok. Czy to jest możliwe, czy też szczerzę złe drzewo?

Answer 1

Teoretycznie można dodać obsługę interfejsu do istniejącej klasy w środowisku wykonawczym, ale byłoby to naprawdę trudne i wymagałoby D2010 lub nowszej obsługi RTTI.

Każda klasa ma VMT, a VMT ma wskaźnik tabeli interfejsu. (Zobacz implementację TObject.GetInterfaceTable.) Tabela interfejsu zawiera wpisy interfejsu, które zawierają niektóre metadane, w tym identyfikator GUID, oraz wskaźnik do samego interfejsu interfejsu. Jeśli naprawdę chcesz, możesz utworzyć kopię tabeli interfejsu (NIE rób tego oryginalnie, prawdopodobnie uszkodzisz pamięć!) Dodaj nowy wpis zawierający nowy interfejs vtable ze wskaźnikami wskazanie poprawnych metod (które można dopasować, sprawdzając je za pomocą RTTI), a następnie zmienić wskaźnik tabeli interfejsu klasy, tak aby wskazywał na nową tabelę.

Bądź bardzo ostrożny. Ten rodzaj pracy naprawdę nie jest dla osób o słabym sercu i wydaje mi się, że jest to rodzaj ograniczonej użyteczności. Ale tak, to jest możliwe.

Answer 2

Nie jestem pewien, co chcesz osiągnąć i dlaczego chcesz dynamicznie powiązać tego interfejsu, ale tutaj jest sposób, aby to zrobić (nie wiem, czy pasuje do Twoich potrzeb):

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; 

I to jest odpowiedni kod testowy:

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;