TGUID von Interface-Instanz herausfinden

[TiGü]

Hallo zusammen,

kann man über die RTTI (Stand XE3) die TGUID einer Interface-Instanz herausfinden?
Ich habe einen Anwendungsfall, bei dem ich eine lebendes Interface-Objekt zu einem generischen Dictionary hinzufügen muss.
Der Key ist dann die TGUID.
Darüber wird dann auch später das betreffende Element/Objekt aus der Liste entfernt.

Ich habe versucht das Ganze in einer übersichtlichen Beispiel-Unit unterzubringen.
Mir geht es konkret darum, die ewig langen if-else-Abfragen mit Supports() in der Methode GetInterfaceGUID zu vermeiden:

Delphi-Quellcode:

unit List;

interface

uses
  System.SysUtils,
  Generics.Collections;

const
  SID_MAIN   = '{BCA44697-4841-457B-8161-30A9BDC2A0A0}';
  SID_CHILD1 = '{C8527C3A-EB3C-46C1-94BB-3C9DFB12AF92}';
  SID_CHILD2 = '{A21F5DED-9BEC-4D25-BB7B-21AD3C46FB75}';
  SID_CHILD3 = '{8AE48CFE-2DDA-40C9-901A-660974B5DDA1}';

type
  IMainInterface = interface(IUnknown)
    [SID_MAIN]
  end;

  IChildInterface1 = interface(IUnknown)
    [SID_CHILD1]
  end;

  IChildInterface2 = interface(IUnknown)
    [SID_CHILD2]
  end;

  IChildInterface3 = interface(IUnknown)
    [SID_CHILD3]
  end;

  TMyList = class(TObject)
  private
    FInterfaceList : TDictionary<TGUID, IMainInterface>;
    function GetInterfaceGUID(const AInterfaceInstance : IMainInterface) : TGUID;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(const AInterfaceInstance : IMainInterface) : Boolean;
    function Remove(const AType : TGUID; out AInterfaceInstance : IMainInterface) : Boolean;
  end;

implementation


function TMyList.GetInterfaceGUID(const AInterfaceInstance : IMainInterface) : TGUID;
begin
  Result := IMainInterface;
  // wie geht das hier besser? Irgendwas mit GetTypeInfo von der RTTI oder sowas? 
  if Supports(AInterfaceInstance, IChildInterface1) then
  begin
    Result := IChildInterface1;
  end
  else if Supports(AInterfaceInstance, IChildInterface2) then
  begin
    Result := IChildInterface2;
  end
  else if Supports(AInterfaceInstance, IChildInterface3) then
  begin
    Result := IChildInterface3;
  end;
end;

constructor TMyList.Create;
begin
  inherited Create;
  FInterfaceList := TDictionary<TGUID, IMainInterface>.Create;
end;

destructor TMyList.Destroy;
begin
  FInterfaceList.Free;
  inherited Destroy;
end;

function TMyList.Remove(const AType : TGUID; out AInterfaceInstance : IMainInterface) : Boolean;
begin
  Result := FInterfaceList.TryGetValue(AType, AInterfaceInstance);
  if Result then
  begin
    FInterfaceList.Remove(AType);
  end;
end;

function TMyList.Add(const AInterfaceInstance : IMainInterface) : Boolean;
begin
  Result := not FInterfaceList.ContainsValue(AInterfaceInstance);
  if Result then
  begin
    FInterfaceList.Add(GetInterfaceGUID(AInterfaceInstance), AInterfaceInstance);
  end;
end;

end.

Angewendet wird dass dann bspw. so:

Delphi-Quellcode:

type
  TClass1 = class(TInterfacedObject, IChildInterface1, IMainInterface)
  end;

  TClass2 = class(TInterfacedObject, IChildInterface2, IMainInterface)
  end;

  TClass3 = class(TInterfacedObject, IChildInterface3, IMainInterface)
  end;

procedure TForm2.Button1Click(Sender: TObject);
var
  I1 : IMainInterface;
  I2 : IMainInterface;
  I3 : IMainInterface;
  List : TMyList;

begin
  I1 := TClass1.Create;
  I2 := TClass2.Create;
  I3 := TClass3.Create;

  List := TMyList.Create;
  List.Add(I1);
  List.Add(I2);
  List.Add(I3);

  List.Free;
end;

[Der schöne Günther]

Ich habe mich jetzt nicht ganz durchgewühlt, aber vom eigentlichen Typ bekommt man ja schnell die GUID:

Delphi-Quellcode:

program Project3;

{$APPTYPE CONSOLE}
{$R *.res}

uses
   System.SysUtils,
   System.TypInfo;

type
   ISomeInterface = interface
      ['{EDC39028-A340-4CA8-8746-0E6B5A6D06F2}']
   end;

   TSomeType = class(TInterfacedObject, ISomeInterface);

var
   someInstance: ISomeInterface;

begin
   try

      someInstance := TSomeType.Create();
      WriteLn( GetTypeData(TypeInfo(ISomeInterface))^.Guid.ToString() );

   except
      on E: Exception do
         WriteLn(E.ClassName, ': ', E.Message);
   end;

   ReadLn;

end.

Aber wie bekommt man nun von einer Referenz (von der, zumindest im Quelltext, ja klar ist von welchem Typ sie ist), den Typ? Das frage ich mich jetzt auch...:gruebel:

[himitsu]

Ich weiß jetzt auch nicht, wie das geht ... ich hab fast die Befürchtung, daß es nicht geht.
Abgesehn davon daß Interfaces im Delphi nichtmal eine IID haben müssen.

Aber du kannst dir das Objekt aus dem Interface ziehen (solange sich dahinter ein Delphi-Objekt versteckt), von dem listet man alle Interfaces auf,
holt sich über QueryInterface Instanzen dieser Interfaces, vergleicht die Instanzzeiger und würde so das passende finden.


[edit]
OK, anhand der Adresse des Index (Offset zur Objektinstanz) könnte man es auch direkt versuchen, aber das funktioniert dann doch vermutlich ebenfalls nur bei Interfaces?
Ich vermute mal an/ab den Adressen stehen jeweils die Pointer zu den Methoden der Interfaces. :gruebel:

Delphi-Quellcode:

type
  IMyIntfA = interface
    ['{12082AEC-4031-481B-A0AE-5EC82EABD13F}']
    procedure ProcA;
  end;
  IMyIntfB = interface
    ['{B82BC941-C831-451E-ACCC-E957CD9CBEFA}']
    procedure ProcA;
    procedure ProcB;
  end;
  IMyIntfC = interface
    procedure ProcA;
  end;

  TMyClass = class(TInterfacedObject, IMyIntfA, IMyIntfB, IMyIntfC)
    procedure ProcA;
    procedure ProcB;
  end;

procedure TMyClass.ProcA;
begin
end;

procedure TMyClass.ProcB;
begin
end;

var
  O, X: TMyClass;
  A, B, C, D, E: IInterface;
  P, Q: Pointer;
begin
  O := TMyClass.Create;
  A := O as IMyIntfA;
  B := O as IMyIntfB;
  C := O as IMyIntfC;
  D := B as IMyIntfA;
  B.QueryInterface(IMyIntfA, E);  // E := B as IMyIntfA;
//F := B as IMyIntfC;             // [dcc32 Fataler Fehler] Unit14.pas(2022): F2084 Interner Fehler: C13823
//B.QueryInterface(IMyIntfC, F);  // [dcc32 Fehler] Unit14.pas(890): E2232 Interface 'IMyIntfC' besitzt keine Interface-Identifikation
  X := A as TMyClass;
//P := @IMyIntfB(B).ProcA;
//Q := @IMyIntfB(B).ProcB;
  ShowMessage(
    'O = ' + IntToHex(Integer(O), 8) + sLineBreak +
    'A = ' + IntToHex(Integer(A), 8) + sLineBreak +
    'B = ' + IntToHex(Integer(B), 8) + sLineBreak +
    'C = ' + IntToHex(Integer(C), 8) + sLineBreak +
    'D = ' + IntToHex(Integer(D), 8) + sLineBreak +
    'E = ' + IntToHex(Integer(E), 8) + sLineBreak +
    'X = ' + IntToHex(Integer(X), 8) + sLineBreak);

O = $15333E40
A = $15333E54 (A) O+20
B = $15333E50 (B) O+16
C = $15333E4C (C) O+10
D = $15333E54 (A)
E = $15333E54 (A)
X = $15333E40

Delphi-Quellcode:

O = $14A30080
A = $14A30094 $1BEB4B70 - $00000000 $14A2FE80 $000204B0
B = $14A30090 $1BEB4B5C $1BEB4B70 - $00000000 $14A2FE80
C = $14A3008C $1BEB4B4C - $1BEB4B5C $1BEB4B70 $00000000
D = $14A30094
E = $14A30094
X = $14A30080

[Union]

Das klingt ja alles sehr kompliziert. Ginge es nicht so wie Der Schöne Günther bereits schrieb:

Delphi-Quellcode:

function TMyList.GetInterfaceGUID(const AInterfaceInstance : IMainInterface) : TGUID;
begin
  result := GetTypeData(TypeInfo(AInterfaceInstance))^.Guid;
end;

[TiGü]

Vielen Dank für den bisherigen Input.
Ich ahnte schon, dass es unmöglich und/oder kompliziert sein würde.

Zitat:

Zitat von Union (Beitrag 1258274)

Das klingt ja alles sehr kompliziert. Ginge es nicht so wie Der Schöne Günther bereits schrieb:

Delphi-Quellcode:

function TMyList.GetInterfaceGUID(const AInterfaceInstance : IMainInterface) : TGUID;
begin
  result := GetTypeData(TypeInfo(AInterfaceInstance))^.Guid;
end;

Leider zickt da mein XE3: [dcc32 Error] List.pas(51): E2133 TYPEINFO standard function expects a type identifier

Sowas hatte ich nämlich auch schon im Sinn und bin an ähnlichen Fehlermeldungen gescheitert.

@Günther: Wenn man eh den genauen Typ weiß, braucht man auch keine RTTI:

Delphi-Quellcode:

var
  InterfaceGUID : TGUID;
begin
  InterfaceGUID := GetTypeData(TypeInfo(IMainInterface))^.Guid;
  InterfaceGUID := IMainInterface;

Man muss dazu sagen, dass ich von einer C++-DLL diese Instanzen erhalte, es sind also leider keine Delphi-Objekte.
Ich weiß halt nur, dass diese Instanzen das IMainInterface implementieren.
Nun gilt es herauszufinden, welches andere Interface sie noch unterstützen, um ihre Aufgabe zweifelsfrei zu identifizieren (Child1 bis Child3 im Beispiel).

Oder um es etwas konkreter zu machen:

Delphi-Quellcode:

  ICanDrive = interface(IUnknown)
    [SID_DRIVE]
  end;

  IAmACar = interface(IUnknown)
    [SID_CAR]
  end;

  IAmATruck = interface(IUnknown)
    [SID_TRUCK]
  end;

  IAmAMoped = interface(IUnknown)
    [SID_MOPED]
  end;

Ich erhalte ICanDrive-Instanzen und muss schauen ob es nun ein Auto, LKW oder Mofa ist.
Mit if-else-Supports-Check gehts es zwar auch, ist aber halt sehr wartungsanfällig und fehlerbehaftet.

[TiGü]

Nachtrag:
Beim Schreiben des vorigen Beitrages ist mir diese Lösung eingefallen:

Delphi-Quellcode:

const
  MyDriveInterfaces : array[1..3] of TGUID = (SID_CAR, SID_TRUCK, SID_MOPED);

function TMyList.GetInterfaceGUID(const AInterfaceInstance : ICanDrive) : TGUID;
var
  InterfaceGUID: TGUID;
begin
  for InterfaceGUID in MyDriveInterfaces do
  begin
    if Supports(AInterfaceInstance, InterfaceGUID) then
      Result := InterfaceGUID;
  end;
end;

Zwar muss man bei neuen oder veralteten Interfaces mitdenken und das Array anpacken, aber irgendeinen Tod muss man anscheinend immer sterben.

[himitsu]

Damit bekommst du aber nur raus, ob die Instanz in dem Interface das kann, aber nicht ob das auch wirklich grade genau dieser Interfacetyp ist.

Beim Auflisten der RTTI hatte ich mir grade einen Code zusammengebastelt, um die "unterstüttzten" Interfaces einer Interfaceinstanz auszulesen.
(leider fehlen da Interfaces, welche zwar über Supports gefunden werden, aber die eigentlich in einer anderen Objektinstanz sind, welche dort allerdings verlinkt wird)

Aber der Code liefert erstmal fast alle IIDs/GUIDs und diese könnte man man dann via Suppots/QueryInterface abfragen und dann die zurückgegebenen Interfaceinstanzen prüfen.

[TiGü]

Zitat:

Zitat von himitsu (Beitrag 1258289)

Damit bekommst du aber nur raus, ob die Instanz in dem Interface das kann, aber nicht ob das auch wirklich grade genau dieser Interfacetyp ist.

Aber ist das nicht das Gleiche? :wiejetzt:

Also um bei den Beispiel mit den Fahrzeugen zu bleiben, ich weiß das die C++Klassen immer das ICanDrive implementieren.
Zusätzlich dann noch eins, um ihre wahre Funktion zu definieren.

Nie aber implementiert eine dieser C++-Klassen gleichzeitig IAmACar und IAmATruck.

Code:

class Car : public ICanDrive, public IAmACar

[Stevie]

Zitat:

Zitat von TiGü (Beitrag 1258223)

kann man über die RTTI (Stand XE3) die TGUID einer Interface-Instanz herausfinden?

Nein.

Warum? Weil eine Interface-Instanz nichts weiter ist, als ein Zeiger auf ein Array von Methodenzeigern. Es gibt keinen weiteren State oder Informationen zu ihrem Typ.

Kann man irgendwie tricksen?

Ja, aber nur, wenn man weiß, dass hinter der Interface-Instanz ein Delphi Objekt steckt (intf as TObject), damit man dann in der Interface Table des Objektes nachschauen und die Interface VMTs vergleichen kann - aber das wird sehr hässlich und fehleranfällig.

In deinem Fall aber eh nicht anwendbar, da du ja keine Delphi Objekte hast. Wenn du sicher stellen kannst, dass die verschiedenen Interfaces nur exklusiv implementiert werden, dürfte die Möglichkeit aus Post 6 die Beste sein, was du unter den gegebenen Umständen machen kannst.

[TiGü]

Okay, vielen lieben Dank an alle.

Ich wollte vor allen sichergehen, dass ich nicht irgendetwas übersehe und die

Delphi-Quellcode:

function GetGUIDFromInterfaceInstanceWithMagic()

einfach nur nicht finde.
Die Erklärung von Stevie ist einleuchtend.

Falls jemand in Zukunft ein ähnliches Problem hat, hier meine entgültige Lösung:

Delphi-Quellcode:

const
  MyDriveInterfaces : array[1..3] of TGUID = (SID_CAR, SID_TRUCK, SID_MOPED);

function TMyList.GetInterfaceGUID(const AInterfaceInstance : ICanDrive) : TGUID;
var
  InterfaceGUID : TGUID;
begin
  Result := ICanDrive;
  for InterfaceGUID in MyDriveInterfaces do
  begin
    if Supports(AInterfaceInstance, InterfaceGUID) then
    begin
      Result := InterfaceGUID;
      break;
    end;
  end;
end;