delphi - 从接口(interface)获取子接口(interface)

这是接口(interface)的一种特殊情况，其中一个类实现了同一接口(interface)的多个版本，即。类似于以下内容

IBase = interface
   procedure Foo;
end;

ISub = interface (IBase)
   procedure Bar;
end;

ISpecialBase = interface (IBase) end;

ISpecialSub = interface (ISub) end;

TMyClass = class(TInterfacedObject, ISpecialBase, ISpecialSub)

   procedure SpecialFoo1;
   procedure SpecialFoo2;
   procedure SpecialBar;

   procedure ISpecialBase.Foo = SpecialFoo1;

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

   function GetTheRightOne(parameters) : IBase;

end;

...

function TMyClass.GetTheRightOne(parameters) : IBase;
begin
   if (something complex depending on parameters) then
      Result := ISpecialBase(Self)
   else Result := ISpecialSub(Self)
end;

当然，在实际情况中大约有十几个 ISpecialXxxx。

有一个非常重要的需要，即只有一个实例。我想避免为了推迟 ISpecialXxxx 实现而不得不创建适配器或虚拟实例，因为以前设计的唯一目的正是让单个实例处理许多出色的接口(interface)(即 TMyClass 的 RefCount 可以达到千分之一)。

现在的问题是 GetTheRightOne() 返回一个 IBase，但有时我想检查该 IBase 是否可以转换为 ISub。

有没有办法用上面的声明表来做？

一种方法是添加一个

function GetSub : ISub;

到 IBase，但这确实使设计变得更重，因为它必须为每个 ISpecialXxxx 实现，并且与 ISpecialXxxx“继承”是多余的，所以我正在寻找一个更优雅的解决方案(假设它存在) .

(我有其他“膨胀”解决方案，所以我真的想强调我正在寻找非膨胀解决方案)

编辑:更多细节

GUID 存在于原始代码中(但它们的缺乏并不是造成困难的原因)

Supports & QueryInterface 不起作用，因为 ISpecialXxx 需要每个类有多个版本的接口(interface)，ISub 没有明确列出，所以没有找到。然而，当使用适配器/虚拟类延迟接口(interface)时，两者都有效(因为可以显式列出 ISub)

edit2 : 如果你想要血腥的细节

检查 https://code.google.com/p/dwscript/source/browse/trunk/Source/dwsJSONConnector.pas (r2492)、TdwsJSONConnectorType 类和 IJSONLow 接口(interface)，目标是在 IConnectorFastCall 作为 IConnectorCall 传递时从中检测到 IConnectorFastCall，从而能够调用 LowFastCall 而不是 LowCall。

检测必须发生在 TConnectorCallExpr.AssignConnectorSym，第 294 行，其中当前有一个 QueryInterface。

请注意，QueryInterface 在 TdwsJSONIndexReadCall 和 TdwsJSONIndexWriteCall 的情况下工作，因为它们从不同的类和实例实现 IConnectorCall 和 IConnectorFastCall。但这正是我想避免的。

当然，理想情况下，目标是将所有内容都折叠回 ConnectorType 类(单个类、单个实例)，并且对于每个接口(interface)，特定的 ConnectorType 类应该可以自由地实现 IConnectorCall 或 IConnectorFastCall。

最佳答案

一种骇人听闻的方式依赖于编译器如何存储接口(interface) VTable 数据。编译器为对象实现的每个接口(interface)存储单独的 VTable。在每个 VTable 之后，它存储对象实现的接口(interface)数量。

所以我们可以用它来确定我们是否得到了祖先接口(interface)的 VTable，或者后代接口(interface)的 VTable。

至少这就是它在 XE3 和 XE5 中的工作方式，我必须承认，当谈到接口(interface)的实现方式时，我有点不以为然。

除了依赖于实现细节之外，这样做的缺点是如果向 IBase 接口(interface)添加方法，则必须保持 GetSub 函数同步。此外，如果您有两个不同的、不相关的 ISub，则此代码无法检测到您获得的是哪个。你也许可以破解它，但我宁愿不去那里......

{$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, ISpecialBase, 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
...

如我们所愿。

关于delphi - 从接口(interface)获取子接口(interface)，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/22840183/