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实现,因为以前设计的唯一目的是准确地使单个实例处理许多未完成的接口(即,TMyClass的RefCount可以获得千分之一).
现在的问题是GetTheRightOne()返回一个IBase,但在某些时候我想检查是否可以将该IBase转换为ISub.
有没有办法用上述申报表来做？
function GetSub : ISub;
到IBase,但这真的使设计更重,因为它必须为每个ISpecialXxxx实现,并将与ISpecialXxxx“继承”多余,所以我正在寻找一个更优雅的解决方案(假设它存在) .
(我有其他“膨胀”的解决方案,所以我真的想强调我正在寻找一个不膨胀的解决方案)
编辑：一些更多的细节
> GUID是在原始代码中(但是它们的缺点并不是造成困难的)
>支持& QueryInterface不起作用,因为ISpecialXxx需要具有每个类的多个版本的接口,所以ISub没有被清楚地列出,所以没有找到.两者都使用适配器/ dummy类来延迟接口(因为可以明确列出ISub)
edit2：如果你想要血腥细节
检查https://code.google.com/p/dwscript/source/browse/trunk/Source/dwsJSONConnector.pas(r2492),TdwsJSONConnectorType类和IJSONLow接口,目标是当IConnectorFastCall作为IConnectorCall传递时,检测到IConnectorFastCall,从而能够调用LowFastCall而不是LowCall.
检测必须发生在TConnectorCallExpr.AssignConnectorSym,第294行,其中当前有一个QueryInterface.
请注意,QueryInterface适用于TdwsJSONIndexReadCall& TdwsJSONIndexWriteCall,因为它们实现了IConnectorCall&不同类别的IConnectorFastCall实例.但这是我想避免的.
当然理想的做法是将所有内容折叠到ConnectorType类(单一类,单一实例)中,对于每个接口,一个特定的ConnectorType类应该可以自由地实现IConnectorCall或IConnectorFastCall.
解决方法
所以我们可以用它来确定我们是否获得了祖先接口的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 ...
我们想要的