delphi – 从接口获取子接口

所以我们可以用它来确定我们是否获得了祖先接口的VTable,或者是后代的接口.

至少这是它在XE3和XE5中的工作原理,我必须承认,如果接口实现的话,我有一点点n00b.

除此之外,除了依赖实现细节之外,如果将方法添加到IBase接口,则必须保持GetSub功能的同步.另外,如果你有两个不同的,不相关的,那么这个代码就不能检测到你有哪些.你可能可以闯入,但我宁可不去那里

{$APPTYPE CONSOLE}

uses
  System.SysUtils;

type
  IBase = interface
    procedure Foo;
  end;

  ISub = interface (IBase)
    procedure Bar;
  end;

  ISpecialBase = interface (IBase)
  end;

  ISpecialSub = interface (ISub)
  end;

  TMyClass = class(TInterfacedObject,ISpecialSub)

    procedure SpecialFoo1;
    procedure SpecialFoo2;
    procedure SpecialBar;

    procedure ISpecialBase.Foo = SpecialFoo1;

    procedure ISpecialSub.Foo = SpecialFoo2;
    procedure ISpecialSub.Bar = SpecialBar;

    function GetTheRightOne(const Param: boolean) : IBase;
  end;


{ TMyClass }

function TMyClass.GetTheRightOne(const Param: boolean): IBase;
begin
  if Param then
    Result := ISpecialBase(Self)
  else
    Result := ISpecialSub(Self);
end;

procedure TMyClass.SpecialBar;
begin
  WriteLn('SubBar');
end;

procedure TMyClass.SpecialFoo1;
begin
  WriteLn('BaseFoo');
end;

procedure TMyClass.SpecialFoo2;
begin
  WriteLn('SubFoo');
end;

function GetSub(const Intf: IInterface): ISub;
type
  PPVtable = ^PVtable;
  PVtable = ^TVtable;
  TVtable = array[0..MaxInt div SizeOf(Pointer) - 1] of Pointer;
var
  intfVTable: PPVtable;
  caddr: NativeUInt;
begin
  result := nil;
  intfVTable := PPVTable(Intf);
  // 3 is offset to user methods
  // +0 = first user method,+1 = second user method etc
  // get the "address" of the first method in ISub
  caddr := NativeUInt(intfVTable^[3+1]);
  // compiler stores number of interface entries the
  // implementing object implements right after the interface vtable
  // so if we get a low number here,it means Intf is the IBase interface
  // and not the ISub
  if caddr > $100 then
    result := ISub(Intf);
end;

procedure CallIt(const b: IBase);
var
  s: ISub;
begin
  b.Foo;

  s := GetSub(b);
  if Assigned(s) then
    s.Bar;
end;

var
  c: TMyClass;
  b: IBase;
begin
  try
    c := TMyClass.Create;

    b := c.GetTheRightOne(True);
    CallIt(b);

    WriteLn('---');

    b := c.GetTheRightOne(False);
    CallIt(b);

    WriteLn('...');

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

输出

BaseFoo
---
SubFoo
SubBar
...

我们想要的