InterfaceTable eines Interfaces?

[Kedariodakon]

Das Prinzip funktioniert
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