Zur Laufzeit entscheiden ob ein Interface implementiert wird oder nicht

[Der schöne Günther]

Je nachdem was ich im Konstruktor eingegeben habe möchte ich dass eine Klasse ein bestimmtes Interface implementiert, oder eben nicht.


Da die Methode QueryInterface(..) von TInterfacedObject nicht virtuell ist muss ich eine neue Klasse erstellen.

Die Basisklasse sieht jetzt so aus:

Delphi-Quellcode:

   TInterfacedObject_VirtualQuery = class(TObject, IInterface)
   private var
      RefCount: Integer;
   public
      function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall;
      function _AddRef(): Integer; stdcall;
      function _Release(): Integer; stdcall;
   end;

Delphi-Quellcode:

function TInterfacedObject_VirtualQuery.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
   if GetInterface(IID, Obj) then
      Result := S_OK
   else
      Result := E_NOINTERFACE;
end;

function TInterfacedObject_VirtualQuery._AddRef(): Integer;
begin
   Result := TInterlocked.Increment(RefCount);
end;

function TInterfacedObject_VirtualQuery._Release(): Integer;
begin
   Result := TInterlocked.Decrement(RefCount);
   if (Result = 0) then
      Destroy();
end;

Wenn ich jetzt eine Klasse möchte die sich zur Laufzeit entscheidet ob sie ein Interface implementiert überschreibe ich QueryInterface(..) so:

Delphi-Quellcode:

   TMyObject = class(TInterfacedObject_VirtualQuery, ISomeInterface)
   public
      function QueryInterface(const IID: TGUID; out Obj): HRESULT; override; stdcall;
   end;

Delphi-Quellcode:

function TMyObject.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
   Result := inherited QueryInterface(IID, Obj);
   if IID = TGUID(ISomeInterface) then
      begin
         if ichEntscheideMichEsNichtZuImplentieren then
            Result := E_NOINTERFACE;
      end;
end;

Habe ich etwas übersehen? Kann man das so machen?

[Stevie]

Naja dir fehlt die gesamte Mechanik aus TInterfacedObject, die dafür sorgt, dass das Objekt nicht in die Luft fliegt, wenn du während dem Erstellen oder Freigeben implizit die eigene Referenzzählung triggerst.

Außerdem würd ich die Überprüfung vorher machen und nur im positiven Fall ins inherited springen.

Fun fact: Den Cast auf TGUID kannst dir sparen, der Compiler erkennt das auch so.


Ob das nun sicher ist, kann ich dir nicht sagen. Es soll auch Code geben, der nimmt die Abkürzung über GetInterface. Und da würd dein TMyObject das implementieren. Einfachster Fall:

Delphi-Quellcode:

var
  i: ISomeInterface;
begin
  i := TMyObject.Create;
  Writeln(Supports(i, ISomeInterface)); // WAT?!

Das heißt, wenn das QueryInterface dynamisch zur Laufzeit entscheiden soll, dann würd ich das Interface nicht auf der Klasse implementieren, sondern ein Delegat erstellen - oder wenn du mutig genug bist, die Adjustor Thunks für das Interface selbst bauen.

[Dennis07]

Zitat von Stevie:

Fun fact: Den Cast auf TGUID kannst dir sparen, der Compiler erkennt das auch so.

Besser noch: Referenzen zu Interface-Typen sind nichts anderes als TGUID-Objekte. Es gibt bei Interfaces nämlich überhaupt keine Klassentypen wie beispielsweise bei Klassen. Das geht dort nur über die TypeInfo, bzw. deren GUID.

[freimatz]

Zitat von Der schöne Günther:

Habe ich etwas übersehen? Kann man das so machen?

Ja - zu erklären, warum man so was krudes machen will.

[Der schöne Günther]

Gerne:

Es gab bislang immer ein Interface ISomething . Diese Instanzen wurden mittels Decorator-Pattern teilweise ein, oder zwei mal eingepackt.

Jetzt kam leider ein Interface ISomething2 hinzu dass unheimlich toll und wichtig ist. Und die Decorator können ja nicht per se ISomething2 unterstützten und wenn das dekorierte Objekt es eben nicht tut dann einfach ein ENotSupported werfen oder so.

Der Arbeitsablauf "Wenn das Ding nun ISomething2 unterstützt machen wir grad noch das und das" sollte nicht geändert werden.


Edit: Hier scheint jemand im Endeffekt die gleiche Frage zu haben und erhält darauf keine Antworten.

[Stevie]

Ein sehr schönes Beispiel, das bestätigt, was ich oft sage: Interface Casts sind in gewisser Weise ein Code Smell.

Gegeben, dass TFoo, IThis und IThat implementiert und per Decorator für IThis irgendwo reingegeben wird. Wenn ich nun dieses IThis (was den Decorator repräsentiert) anfrage, dann wird das selbst nicht IThat implementieren. Aber ich könnte den Cast (QueryInterface) an die dekorierte Komponente weitergeben und diese (also die TFoo Instanz) anfragen, ob sie IThat unterstützt.

Soweit so gut - wenn ich nun aber dieses IThat fragen würde, ob es IThis kann, dann werde ich nur das TFoo als IThis bekommen, also undekoriert, was nicht mehr mein ursprüngliches IThis (der Dekorator) ist.

Ebenso könnte es sein, dass ich auch für IThat einen Decorator habe, und diesen über meine TFoo Instanz stülpe, wenn ich diese irgendwo als IThat hereingebe. Somit wissen die beiden Decorator nichts von einander und man landet per Interface Cast immer auf der ursprünglichen undekorierten Instanz.

[Der schöne Günther]

Zitat von Stevie:

Ein sehr schönes Beispiel, das bestätigt, was ich oft sage: Interface Casts sind in gewisser Weise ein Code Smell.

Ich habe jetzt in den sauren Apfel gebissen und umgebaut.

Vorher:

Delphi-Quellcode:

type
   IThis = interface;
   IThat = interface(IThis);
   
   TImplementation = class(TInterfacedObject, IThis, IThat);
   
   TThisDecorator = class(TInterfacedObject, IThis)
      protected var
         delegate: IThis;
      public
         constructor Create(delegate: IThis);
   end;

Nachher:

Delphi-Quellcode:

type
   IThis = interface
      // Kann nil sein
      function getThat(): IThat;
   end;
   
   IThat = interface;
   
   TThisDecorator = class(TInterfacedObject, IThis)
      protected var
         delegate: IThis;
         thatDelegate: IThat; // Ist dann ein TThatDecorator
      public
         constructor Create(delegate: IThis);
         function getThat(): IThat; // liefert dann einen TThatDecorator
   end;

Ich glaube damit werde ich jetzt glücklich.

[stahli]

So ganz verstehe ich das obige Problem nicht...


Für eigene Zwecke habe ich mir etwas Artverwandtes(?) gebaut, das vielleicht als Anregung für ähnliche Anwendungen dienen kann.

Ich nutze viel "Supports()" um zu erkennen, was ich für Objekte vor mir habe.
Nun habe ich mir eine Funktion SupportsIn() gebaut, der ich einfach eine Menge von zu akzeptierenden Interfaces übergeben kann.

Als Sonderfall kann ich auch Interfaces übergeben, die das geprüfte Objekt gar nicht wirklich unterstützt, aber bei denen die Funktion TRUE zurück gibt, wenn das Objekt z.B. eine bestimmte Eigenschaft hat.

So kann ich im Programmablauf zum Einen leicht auf eine Liste von zu akzeptierenden Interfaces prüfen und zum Anderen einfach "Dummy-Interfaces" einführen, die zusätzlich gleich noch irgendwelche anderen Bedingungen prüfen und das Objekt entsprechend durch lassen oder nicht.

Ist natürlich etwas frickelig, aber hat sich für mich als sehr praktikabel bewährt (vereinfacht u.U. eben die Prüfungen in der Geschäftslogik deutlich).

Delphi-Quellcode:

TDetectArray = array of TGUID;

function SupportsIn(const aIntf: IInterface; aArray: TDetectArray): Boolean;
var
  I: Integer;
  lDetectComment_Base: IDetectComment_Base;
begin

  Result := False;

  for I := low(aArray) to high(aArray) do
  begin

    if (aArray[I] = IDetectComment_Real) then // Sonderfall !
    begin
      if Supports(aIntf, IDetectComment_Base, lDetectComment_Base) then
      begin
        if (lDetectComment_Base.RealComment) then
        begin
          Exit(True); // Dummy-Interface wird als "unterstützt" angesehen
        end;
      end;
    end;

    if Supports(aIntf, aArray[I]) then
    begin
      Exit(True);
    end;

  end;
end;


if SupportsIn(myIntf, [IDies, IDas, IDetectComment_Real]) then
  Beep;