Delphi - Cannot cast TVirtualInterface to base interface of virtualized interface

Question

Howdey,

I am using TVirtualInterface to implement some interfaces. Those interfaes represent Keys that can be found in a DB. I generate the interface definitions with a custom made code generator. For example :

// Base code 

IKey = interface
  function KeyFields : string;
  function KeyValues : Variant;
  function GetKeyValue(const aKeyName : string) : Variant;
  procedure SetKeyValue(const aKeyName : string; Value : Variant);
end;

// Generated code

ITable1Key = interface(IKey)
end;

ITable1Key1 = interface(ITable1Key)
  procedure SetField1(const Value : string);
  function GetField1 : string;
  property Field1 : string read GetField1 write SetField1;
end;

ITable1Key2 = interface(ITable1Key)
  procedure SetField1(const Value : string);
  function GetField1 : string;
  property Field1 : string read GetField1 write SetField1;
  procedure SetField2(const Value : string);
  function GetField2 : string;
  property Field2 : string read GetField1 write SetField1;
end;

// Other generated declarations

I use the TVirtualInterface to implement each IKey interface instead of implementing them one by one.

Though, in my TVirtualInterface :

TKey = TVirtualInterface
public
  constructor Create(aType : PTypeInfo);
  function Cast : IKey;
end;

TKey<T : IKey>
public
  constructor Create; reintroduce;
  function Cast : T;
end;


constructor TKey.Create(aType : PTypeInfo)
begin
  inherited Create(aType, aHandlerMethod);
end;

function TKey.Cast;
var
  pInfo: PTypeInfo;
begin
  pInfo := TypeInfo(IKey);
  if QueryInterface(GetTypeData(pInfo).Guid, Result) <> 0 then
  begin
    raise Exception.CreateFmt('Sorry, TKey is unable to cast %s to its interface ', [string(pInfo.Name)]);
  end;
end;

constructor TKey<T>.Create;
begin
  inherited Create(TypeInfo(T));
end;

function TKey<T>.Cast;
var
  pInfo: PTypeInfo;
begin
  pInfo := TypeInfo(T);
  if QueryInterface(GetTypeData(pInfo).Guid, Result) <> 0 then
  begin
    raise Exception.CreateFmt('Sorry, TKey<T> is unable to cast %s to its interface ', [string(pInfo.Name)]);
  end;
end;

I have no problem casting the TKey virtual interface to the T type using the TKey.Cast method, though TKey.Cast returns a Interface not supported error.

I checked in System.Rtti for the part that wasn't working the way I wanted it to :

function TVirtualInterface.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if iid = FIID then
  begin
    _AddRef;
    Pointer(Obj) := @VTable;
    Result := S_OK;
  end
  else
    Result := inherited
end;

Now, how can I force the TVirtualInterface to cast itself to a IID that is a parent interface of the FIID field ? Do I have to create another instance of the TVirtualInterface for the IKey interface ?

Thank you very much.

Answer 1

You are misusing TVirtualInterface. It is just an RTTI helper, you should not be deriving from it at all. You should be deriving from TInterfacedObject instead.

Also, both of your TKey classes are ignoring the PTypeInfo that is passed to the constructor. The non-Generic TKey.Cast() is always querying for IKey only, never a descendant interface. And the Generic TKey<T>.Cast is always re-querying T's RTTI to get its IID. So get rid of the PTypeInfo in the constructor, it is wasted.

Since the non-Generic TKey is just a base class that doesn't actually implement any derived interfaces at all, TKey.QueryInterface() will always fail for any interface other than IKey itself. At least the Generic TKey can query a derived interface.

Your Cast functions are redundant anyway, since you can use the as operator, or the SysUtils.Supports() function, to cast one interface to another. These are the preferred methods, not using QueryInterface() manually.

In any case, your interfaces are missing IIDs in their declarations, so you can't cast between interfaces anyway.

Try something more like this:

// Base code 

IKey = interface
  ['{D6D212E0-C173-468C-8267-962CFC3FECF5}']
  function KeyFields : string;
  function KeyValues : Variant;
  function GetKeyValue(const aKeyName : string) : Variant;
  procedure SetKeyValue(const aKeyName : string; Value : Variant);
end;

// Generated code

ITable1Key = interface(IKey)
  ['{B8E44C43-7248-442C-AE1B-6B9E426372C1}']
end;

ITable1Key1 = interface(ITable1Key)
  ['{0C86ECAA-A8E7-49EB-834F-77DE62BE1D28}']
  procedure SetField1(const Value : string);
  function GetField1 : string;
  property Field1 : string read GetField1 write SetField1;
end;

ITable1Key2 = interface(ITable1Key)
  ['{82226DE9-221C-4268-B971-CD72617C19C7}']
  procedure SetField1(const Value : string);
  function GetField1 : string;
  property Field1 : string read GetField1 write SetField1;
  procedure SetField2(const Value : string);
  function GetField2 : string;
  property Field2 : string read GetField1 write SetField1;
end;

// Other generated declarations

type
  TKey = class(TInterfacedObject, IKey)
  public
    function Cast : IKey;
    // IKey methods...
  end;

  TKey<T : IKey> = class(TInterfacedObject, IKey, T)
  public
    function Cast : T;
  end;

  TTable1Key = class(TKey, IKey, ITable1Key)
  end;

  TTable1Key1 = class(TTable1Key, IKey, ITable1Key, ITable1Key1)
  public
    // ITable1Key1 methods...
  end;

  TTable1Key2 = class(TTable1Key, IKey, ITable1Key, ITable1Key2)
  public
    // Table1Key2 methods...
  end;

// and so on ...

function TKey.Cast: IKey;
begin
  if not Supports(Self, IKey, Result) then
    raise Exception.Create('Sorry, unable to cast to IKey');
end;

function TKey<T>.Cast: T;
begin
  if not Supports(Self, GetTypeData(TypeInfo(T)).Guid, Result) then
    raise Exception.CreateFmt('Sorry, unable to cast to %s', [string(TypeInfo(T).Name)]);
end;

// other class methods as needed ...

Also note how the derived classes have to repeat the interfaces implemented by their base classes. That is a known Delphi limitation. Derived classes do not inherit base class interfaces. Each class has to explicitly specify the interfaces it implements, even if the actual implementation is in a base class.