How to check if a class implements an interface, observing supersets?

I am learning COM and interfaces and have the following experimental code:

type
  IA = interface(IInterface)
  ['{C9C5C992-3F67-48C5-B215-7DCE6A61F0E8}']
  end;

  IB = interface(IA)
  ['{F1799437-AD12-471B-8716-F1D93D1692FC}']
  end;

  IC = interface(IB)
  ['{01780E8C-C47D-468E-8E42-4BFF3F495D51}']
  end;

  TBO = class(TInterfacedObject, IB)
  end;

procedure TForm1.FormCreate(Sender: TObject);
var
  x: TBO;
  a: IInterface;
begin
  x := TBO.Create;
  IInterface(x)._AddRef;

  if Assigned(TBO.GetInterfaceEntry(IA)) then memo1.lines.add('GetInterfaceEntry IA: OK'); // Why not?
  if Assigned(TBO.GetInterfaceEntry(IB)) then memo1.lines.add('GetInterfaceEntry IB: OK');
  if Assigned(TBO.GetInterfaceEntry(IC)) then memo1.lines.add('GetInterfaceEntry IC: OK');

  if x.QueryInterface(IA, a)=S_OK then memo1.lines.add('QueryInterface TA: OK'); // Why not?
  if x.QueryInterface(IB, a)=S_OK then memo1.lines.add('QueryInterface TB: OK');
  if x.QueryInterface(IC, a)=S_OK then memo1.lines.add('QueryInterface TC: OK');

  if Supports(TBO, IA) then memo1.lines.add('Supports TA: OK'); // Why not?
  if Supports(TBO, IB) then memo1.lines.add('Supports TB: OK');
  if Supports(TBO, IC) then memo1.lines.add('Supports TC: OK');

  if Supports(x, IA, a) then memo1.lines.add('Supports(2) TA: OK'); // Why not?
  if Supports(x, IB, a) then memo1.lines.add('Supports(2) TB: OK');
  if Supports(x, IC, a) then memo1.lines.add('Supports(2) TC: OK');
end;

Conclusion:

GetInterfaceEntry IB: OK
QueryInterface TB: OK
Supports TB: OK
Supports(2) TB: OK

But I need:

GetInterfaceEntry IA: OK
GetInterfaceEntry IB: OK
QueryInterface TA: OK
QueryInterface TB: OK
Supports TA: OK
Supports TB: OK
Supports(2) TA: OK
Supports(2) TB: OK

I understand what IBis a superset IAdue to interface inheritance. In my understanding, since it TBOimplements IB, it automatically implements IA. But why Supports(), QueryInterface(), GetInterfaceEntry()returns false?

How can I request if it TBOimplements IAdirectly or indirectly, i.e. by implementing superset IA? I need both static class functions, such as the GetInterfaceEntryvariant with a dynamic object, for example QueryInterface.

+4
2

Delphi. IB IA, TBO IA, IB, Supports() .

TBO = class(TInterfacedObject, IA, IB)

. - , TBO. .

+5

: "" , , , .

, , .

:

IA = interface
<guid>
end;
IA1 = interface(IA)
<guid>
end;
IA2 = interface(IA)
<guid>
end;

, IA1 IA2, :

TAggregate = class(TInterfacedObject, IA1, IA2)
private
  FIA1: IA1;
  FIA2: IA2;
protected
  property ImplIA1: IA1 read FIA1 implements IA1; 
  property ImplIA2: IA2 read FIA2 implements IA2;
end;

, TAggregate IA, ?

- "" , . , "", .


, :

procedure MethodIA; IA do IA TAggregate, . :

indentifier: 'MethodIA'

MethodIA , , FIA1 FIA2 . . FIA2:

  property ImplIA: IA2 read FIA2 implements IA;

, Delphi - . , .

. , , .

TIA1Implementor = class(TInterfacedObject, IA1)
protected
  procedure MethodIA;
end;

var
  LImplObj: TIA1Implementor;
  LA1: IA1;
  LA: IA;
begin
  LImplObj := TIA1Implementor.Create;
  LA1 := LImplObj; //Valid: TIA1Implementor implements IA1
  LA := LImplObj; //Does not compile: TIA1Implementor does not implement IA
  LA := LA1; //Valid: IA1 is an extension of IA
end;

, ( - ). .


, TypInfo , "" .

PTypeData = ^TTypeData;
TTypeData = packed record
  case TTypeKind of
    tkInterface: (
      IntfParent : PPTypeInfo; { ancestor }
      IntfFlags : TIntfFlagsBase;
      Guid : TGUID;
      IntfUnit : ShortStringBase;
     {PropData: TPropData});

, , , . .

+5

Source: https://habr.com/ru/post/1548123/


All Articles