InterfaceTable eines Interfaces?

[Kedariodakon]

Nun hab ich mal so eine ganz kuriose Sache, jedes TObject hat ja die bekannte Funktion "GetInterfaceTable"...

Komme ich über ein Interface auch an diese Tabelle?

Sprich ich hab ein Variable Intf: IUnknown, welche auch belegt ist, dass Object dahinter ist mir völlig unbekannt...
Nun würde ich gern alle GUIDs der implementierten Interfaces haben...

Bis jetzt mach ich es pie mal daumen so (Achtung, das ist nur ein grobes Funktionsbeispiel... :duck: ):

Delphi-Quellcode:

Function GetGUIDs( Const Intf: IUnknown ): {irgendwas...}
Begin
  If Supports( Intf, IInt1 ) Then {lalala}.Add( GUIDToString( IInt1 ) );
  If Supports( Intf, IInt2 ) Then {lalala}.Add( GUIDToString( IInt2 ) );
  If Supports( Intf, IInt3 ) Then {lalala}.Add( GUIDToString( IInt3 ) );
  If Supports( Intf, IInt4 ) Then {lalala}.Add( GUIDToString( IInt4 ) );
  If Supports( Intf, IInt5 ) Then {lalala}.Add( GUIDToString( IInt5 ) );
  { Mach mir ein wildes Result... }
End;

Nunja, aber da kann man ja schnell mal ein Interface vergessen, daher wär so eine Tabelle schon eine sehr feine Sache...
Vorallem, da ja eventuell mal ein neueres Modul mit einem alten Programm läuft, welches ja ev. mal das Interface nicht kennt (macht die Liste dannn ja unvollständig)...

Hat jemand eine Idee? :gruebel:


Bye Christian

[Kedariodakon]

Ok ich hab mal einen kleinen Umweg versucht:

Delphi-Quellcode:

Type
  IIntfTbl  = Interface
    ['{C93CB029-F127-493C-9A65-8C5E446BE830}']
    Function  GetObjInterfaceTable:  PInterfaceTable; StdCall;
  End;

{...}

  TBasisModulDingens = Class( TInterfacedObject, {viele weitere Interfaces...}, IIntfTbl )
  {...}
  Protected
    { Protected-Deklaration }
    Function  GetObjInterfaceTable:  PInterfaceTable; StdCall;
  {...}
  End;

{...}
Function TBasisModulDingens.GetObjInterfaceTable: PInterfaceTable;
Begin
  Result  := GetInterfaceTable;
End;
{...}

Nunja aber da is das Result immer Nil... liegt wohl daran, dass das Interface über eine DLL eingeladen wird, da fehlen wohl die RTTI...
Richtig?

Nunja kann man das dennoch irgendwie realisieren?

Bye Christian

[Kedariodakon]

*push*

[Kedariodakon]

Suche immer noch nach einer einfacehn Lösung bzw. einen Lösungsansatz...

:duck:

Bye Christian

[Kedariodakon]

*push* In Hoffnug auf eine Lösung :zwinker:

[negaH]

probiere mal

Delphi-Quellcode:

type
  IIntfTbl  = Interface
    ['{C93CB029-F127-493C-9A65-8C5E446BE830}']
    function SupportsInterface(Index: Integer; out GUID: TGUID): Bool; stdcall;
  end;

function TXyz.SupportsInterface(Index: Integer; out GUID: TGUID): Bool; stdcall;
var
  Table: PInterfaceTable;
  Class: TClass;
begin
  Result := False;
  Class := ClassType; 
  while (Index >= 0) and (Class <> nil) do
  begin
    Table := Class.GetInterfaceTable;
    if Table <> nil then
      if Index < Table.EntryCount then
      begin
        Move(Table.Entries[Index], GUID, SizeOf(TGUID));
        Result := True;
        Exit;
      end else Dec(Index, Table.EntryCount);
    Class := Class.ParentClass;
  end;
end;

procedure Test;
var
  I: Integer;
  IntfTbl: IIntfTbl; 
  GUID: TGUID;
begin
  I := 0;
  if IUnknown.QueryInterface(IIntfTbl, IntfTbl) = S_OK then
    while IntfTbl.SupportsInterface(I, GUID) do 
    begin
      ..... tue was mit GUID
      Inc(I);
    end;
end;

Du baust dir quasi eine einfache Iteriermethode die dir alle unterstützten GUIDs aller Klassen der Vererbungshierarchie zurückgibt.
Ein Zugriff direkt auf die RTTI's über Modulgrenzen hinweg ist eine sehr sehr schlechte Idee, dh. den Zeiger auf die PInterfaceTable zurückzugeben ist kontraproduktiv.

Gruß Hagen

[Kedariodakon]

Das Prinzip funktioniert :thumb:
Hab schon gar nicht mehr an eine Lösung geglaubt...

Hmm, nur hat ich sowas in der Art auch versucht, nur war der Pointer zur Table immer NIL...

Ich hab mir das noch ein wenig zusammengestutzt, rausgekommen ist das:
(Falls nochmal jemand sowas brauch)

Delphi-Quellcode:

Type
  IInterfaceTable  = Interface
    ['{19B847B4-37F6-40A7-A999-6AF680D6CFE2}']
    Function  GetCount:                   Integer;  StdCall;
    Function  GetItem( Index: Integer ):  TGUID;    StdCall;
    { *** }
    Property  Count:                    Integer Read GetCount;
    Property  Items[ Index: Integer ]:  TGUID   Read GetItem; Default;
  End;

{ ... }

Type
  TaObj = Class( {...}, IInterfaceTable )
  Protected
    { Protected-Deklaration }
    Function  ITGetCount:                     Integer;    StdCall;
    Function  ITGetItem(    Index: Integer ): TGUID;      StdCall;
    Function  ITGetRefItem( Index: Integer ): TGUID;      StdCall;    
    Function  IInterfaceTable.GetCount  = ITGetCount;
    Function  IInterfaceTable.GetItem   = ITGetItem;
    { ... }
  Public                     
    { Public-Deklaration }
    Property  IntfCount:                    Integer   Read ITGetCount;
    Property  IntfItems[ Index: Integer ]:  TGUID     Read ITGetItem;
    { ... }
  End;

{ ... }

Const
  cNullGUID:    TGUID     = ( D1: $00000000; D2: $0000; D3: $0000; D4: ( $00, $00, $00, $00, $00, $00, $00, $00 ); );

{ ... }

Function TaObj.ITGetRefItem(Index: Integer): TGUID;
Var Table:  PInterfaceTable;
    aClass: TClass;
    Res:    Boolean;
Begin
  Res     := False;
  aClass  := ClassType;
  While ( Index >= 0 ) And ( aClass <> Nil ) Do Begin
    Table := aClass.GetInterfaceTable;
    If  Table <> Nil Then Begin
      If Index < Table.EntryCount Then Begin        
        //  Move( Table.Entries[ Index ], GUID, SizeOf( TGUID ) );
        Result  := Table.Entries[ Index ].IID;
        Res     := True; 
        Break;
      End Else Begin
        Dec( Index, Table.EntryCount );
      End;
    End Else Begin
      //  Keine Tabelle vorhanden...
    End;
    aClass := aClass.ClassParent;
  End;
  If Not Res  Then Result := cNullGUID;
End;

Function TaObj.ITGetCount: Integer;
Var Table:  PInterfaceTable;
    aClass: TClass;
Begin
  aClass  := ClassType;
  If ( aClass <> Nil ) Then Begin
    Result  := 0; 
    While ( aClass <> Nil ) Do Begin
      Table := aClass.GetInterfaceTable;
      If ( Table <> Nil ) Then Inc( Result, Table.EntryCount );
      aClass := aClass.ClassParent;
    End;
  End Else Begin
    Result  := -1;  //  Kein "InterfaceTable" vorhanden...
  End;
End;

Function TaObj.ITGetItem( Index: Integer ): TGUID;
Var IntfCnt:  Integer;
    nIdx:     Integer;
Begin
  IntfCnt := ITGetCount;
  If ( Index >= 0 ) And ( Index < IntfCnt ) Then Begin
    nIdx    := IntfCnt - Index - 1;
    Result  := ITGetRefItem( nIdx );
  End Else Begin
    Result  := cNullGUID;
  End;
End;

Bye Christian

[Kedariodakon]

Aber so neben bei, kommt man auch an den Interface-Namen ran?

Bye Christian

[sirius]

Ich beobachte wohlwollend, was du hier machst :mrgreen: (persönliches Interesse) Hab nur grad keine Zeit da mitzuprobieren.

Was ist denn mit PInterfaceentry := getInterfaceEntry ?

[Kedariodakon]

Zitat:

Zitat von sirius

Ich beobachte wohlwollend, was du hier machst :mrgreen: (persönliches Interesse) Hab nur grad keine Zeit da mitzuprobieren.

:freak:

Zitat:

Zitat von sirius

Was ist denn mit PInterfaceentry := getInterfaceEntry ?

Kann dir nicht folgen...
Eigendlich sind in der Tabelle "TInterfaceEntry"s, die brauch ich ja nicht =p

Die Interface Liste ist ja eigendlich abgearbeitet, ich kann ja alle GUIDs auflisten die nun irgendwie, irgendwo reinimplementiert werden...

Nur richtig schön wäre es nun noch den passenden Namen zu haben (der In Delphi verwendet wird z.b. IInterface), falls man da überhaupt rann kommt... :duck:

Bye Christian