IImplementation


A Piece of "Emit" Art ...

Sometimes asking for an  explanation on what interfaces are you get a laconic answer that sounds like this:

    an interface is a sort of "contract"

    an interface value is a "pointer"

    an interface type is a GUID (for example: {00000000-0000-0000-C000-000000000046} )

    an interface implementation is a VMT (vtable)

I feel this not very satisfactory, but now i have understood why  the answers are so concise ... 

A in depth description of interface implementation would take one long chapter in Developer Guide ! 

I'm surely not able to write this kind of things, but anyway let's try ...

mm.. where to start ?

maybe the better place is before TObject.Create ...

When a new Delphi object is requested by calling a class constructor, the first thing to do is to allocate a piece of memory for instance data. 

This task is performed by TObject.NewInstance (class) method, that calls GetMem with TObject.InstanceSize.

So what should be the size of an object ?

type

   IAInterface = interface(IUnknown)
   ['{713252E1-4636-11D5-B572-00AA00ACFD08}']
      procedure AMethod;
   end;

   IBInterface = interface(IAInterface)
   ['{713252E2-4636-11D5-B572-00AA00ACFD08}']
      procedure BMethod;
   end;

   ICInterface = interface(IAInterface)
   ['{713252E3-4636-11D5-B572-00AA00ACFD08}']
      procedure BMethod;
      procedure CMethod;
   end;

   IZInterface = interface(IUnknown)
   ['{713252E4-4636-11D5-B572-00AA00ACFD08}']
   end;

type
   TFoo = class(TObject,IBInterface,IAInterface,IZInterface)
   private
      FDummy: Char;
   protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
   private
      procedure BMethod;
   public
      procedure AMethod;
      property  Dummy: Char read FDummy;
   end;

   TBar = class(TFoo,ICInterface,IBInterface)
   private
      procedure IBInterface.AMethod = ADifferentMethod;
      procedure IBInterface.BMethod = BSecondMethod;
      procedure ICInterface.BMethod = BMethod;
      procedure ADifferentMethod;
      procedure BSecondMethod;
   public
      procedure CMethod;
   end;

 

The size of "TFoo" is 16 bytes and that of "TBar" is 24, why ?

First of all consider instance data as a non "packed" record, aligned to 32 bit boundary per faster memory access (a single char can takes 4 byte).

Then consider that (at offset 0) every object contains a pointer to the class VMT (4 bytes)

The remaning space is for interface "hidden" pointers, and the memory layout could be something like this

type
   _TFooInstance = {not packed} record  //SizeOf(_TFooInstance) = 16
      FooClassVMT: Pointer;             //(offset:0)  Pointer to TFoo Class VMT
      FDummy: Char;                     //(offset:4)  fields are 32 bit aligned
      IZInterfaceVMT: Pointer;          //(offset:8)  Pointer to TFoo.IZVTBL
      IBInterfaceVMT: Pointer;          //(offset:12) Pointer to TFoo.IBVTBL 
                                        // (can point to TFoo.IAVTBL too)
   end;   
    
   _TBarInstance = {not packed} record  //SizeOf(_TBarInstance) = 24
      BarClassVMT: Pointer;             //(offset:0)  Pointer to TBar Class VMT
      FDummy: Char;                     //(offset:4)  fields are 32 bit aligned
      IZInterfaceVMT: Pointer;          //(offset:8)  Pointer to TFoo.IZVTBL
     _IBInterfaceVMT: Pointer;          //(offset:12) Hidden Pointer to TFoo.IBVTBL
      IBInterfaceVMT: Pointer;          //(offset:16) Pointer to TBar.IBVTBL 
                                        // (can point to TBar.IAVTBL too)
      ICInterfaceVMT: Pointer;          //(offset:20) Pointer to TFoo.ICVTBL
   end;   

but where this pointers points to and when are they filled ?

the class pointer points to the class (quite obvious), precisely to the start of the class Virtual Method Table used to implement polymorphism.

at negative fixed offset  respect to the VMT, there's a lot of class type data, and for interfaces three fields are important:

 

  1. class self pointer (at offset vmtSelfPtr = -76)  that points to the start of the VMT of a class
  2. parent class pointer (at offset vmtParent = -36) that points to the class self pointer of the parent class
    (single inheritance = just one pointer)
  3. interface table pointer (at offset vmtIntfTable = -72) that points to an array TInterfaceEntry record 
    (see System.pas)

every entry in an interface record contains 4 fields: 

  1. a GUID (for example: {00000000-0000-0000-C000-000000000046} )
  2. a Pointer to an Interface VTable (described later)
  3. an Integer Offset
  4. a strange thing called ImplementationGetter

Ignoring ImplementationGetter for now, for the classes listed above we should have:

 



                         +----->  TObjectVMT
                         |
                         +--- -76 TObject.SelfPtr
                                     ^
                                     |
                         +-----------+
                         |
                         |    -72  TFoo.IntfTable -> {713252E4-4636-11D5-B572-00AA00ACFD08},^TFoo.IZVTBL,8,0
                         +--- -36  TFoo.Parent       {713252E1-4636-11D5-B572-00AA00ACFD08},^TFoo.IAVTBL,12,0
                                                     {713252E2-4636-11D5-B572-00AA00ACFD08},^TFoo.IBVTBL,12,0
AFoo --> ^FooClassVMT ---+-------> TFoo.VMT 
                         |       
                         +--- -76 TFoo.SelfPtr
                                     ^
                                     |
                         +-----------+
                         |
                         |    -72  TBar.IntfTable -> {713252E2-4636-11D5-B572-00AA00ACFD08},^TBar.IBVTBL,16,0
                         +--- -36  TBar.Parent       {713252E3-4636-11D5-B572-00AA00ACFD08},^TBar.ICVTBL,20,0
                              
ABar --> ^BarClassVMT -----------> TBar.VMT 
                     


Returning to the constructor of our object, for a new TBar, the first thing to to is to allocate (with GetMem) 24 bytes of memory in NewInstance. This is a strange function because does not return, but instead jump into InitInstance class function.

It's here where the hidden pointers gets filled in this way:

 

  1. the allocated memory is cleared (set to zero)
  2. the interface table of the class is scan, and for every entry with a not nil VTable address,
    the vtable address is moved in the hidden pointer

    but where is the hidden pointer located ?
    starting from the address of the new chunk of memory, 
    you have to offset the number of bytes you find in the interface entry table 
  3. the parent class is located via Parent pointer
    and the previous operation is repeated for all the interfaces of the parent,
    until you reach TObject class that has no parent (nil)
  4. the address of the allocated memory (the object Self) is returned as new object to the caller

the effect of TObject.NewInstance (+TObject.InitInstance) is similar to this

(but it works with an interface loop inside a class loop...)   

 
type PPointer = ^Pointer;
var o: Pointer;
begin
   GetMem(o,SizeOf(_TBarInstance));
   // o^ := 0 clear memory (see New,Initialize ...)
   
   //o^.BarClassVMT := @TBar.VMT
   
   PPointer(o)^ := @TBar.VMT                                               


   // o^.IBInterfaceVMT := @TBar.IBVTBL   
   
   PPointer(Interger(o) + (TBar.IntfTable^)[1].IOffSet)^ := (TBar.IntfTable^)[1].VTable   
   
   // o^.ICInterfaceVMT := @TBar.ICVTBL   
   
   PPointer(Interger(o) + (TBar.IntfTable^)[2].IOffSet)^ := (TBar.IntfTable^)[2].VTable   
   
   // o^._IZInterfaceVMT := @TFoo.IZVTBL
   
   PPointer(Interger(o) + (TFoo.IntfTable^)[1].IOffSet)^ := (TFoo.IntfTable^)[1].VTable   

   // o^.IBInterfaceVMT := @TFoo.IBVTBL    ( = @TFoo.IAVTBL )
   
   PPointer(Interger(o) + (TFoo.IntfTable^)[2].IOffSet)^ := (TFoo.IntfTable^)[2].VTable   
   
   result := TBar(o);
   
end;   




Now we have a TBar object, so we can assign it to an interface variable in this way ...

 
var
{
 _ABar: ^_TBarInstance;
 _AFoo: ^_TFooInstance;
}
  ABar: TBar;
  AFoo: TFoo;
  AIAInterface: IAInterface;
  AIBInterface: IBInterface;
  AICInterface: ICInterface;
  AIZInterface: IZInterface;
  AIUnknown: IUnknown;
begin

   ABar := TBar.Create;     //a TBar is a kind of TFoo ...
   AFoo := ABar;            //AFoo := TFoo(^_TFooInstance(^_TBarInstance(ABar)))

{
  _ABar := ^_TBarInstance(ABar);    //object are (de)-references ...
  _AFoo := ^_TFooInstance(AFoo);
}

   AICInterface := ABar;    //assign @(_ABar^.ICInterfaceVMT)  (^^TBar.ICInterfaceVTable)
   AIBInterface := ABar;    //assign @(_ABar^.IBInterfaceVMT)  (^^TBar.IBInterfaceVTable)
   AIAInterface := ABar;    //assign @(_ABar^._IBInterfaceVMT) (^^TFoo.IBInterfaceVTable)
   AIZInterface := ABar;    //assign @(_ABar^.IZInterfaceVMT)  (^^TFoo.IZInterfaceVTable)
// AIUnknown    := ABar;    //illegal: nothing to assign from a _TBarInstance

// AICInterface := AFoo;    //illegal: no ICInterfaceVMT field in a _TFooInstance
   AIBInterface := AFoo;    //assign @(_AFoo^._IBInterfaceVMT) (^^TFoo.IBInterfaceVTable)
   AIAInterface := AFoo;    //assign @(_AFoo^._IBInterfaceVMT) (^^TFoo.IBInterfaceVTable)
   AIZInterface := AFoo;    //assign @(_AFoo^.IZInterfaceVMT)  (^^TFoo.IZInterfaceVTable)
// AIUnknown    := AFoo;    //illegal: nothing to assign from a _TFooInstance

   AIUnknown    := AICInterface;   //legal: cast ^^TBar.IBInterfaceVTable to a ^^IUnknownVTable

   AIAInterface := ABar;
   AIAInterface.AMethod;         //calls TFoo.AMethod;

   AIBInterface := ABar;
   AIAInterface := AIBInterface; //legal: cast ^^TBar.IBInterfaceVTable to a ^^IAInterfaceVTable
   AIAInterface.AMethod;         //calls TBar.ADifferentMethod;

   AIBInterface := ABar;
   AIBInterface.BMethod;         //calls TBar.BSecondMethod;

   AIBInterface := AFoo;
   AIBInterface.BMethod;         //calls TFoo.BMethod;

   ABar.Free;

end;




So an Interface variable store a kind of pointer, but a question raises at this point ...

if this pointer contains a different value from object Self pointer, how can the implementation obtain the Self back ?

and what is an Interface VTable ?

a (messy) picture worths a thousand (messy) words ...

 
                                                     
ABar --------------> _TBarInstance
                :           ClassPtr
                :             ...
            offset=20         ...
                :             ...
                :             ...
AICinterface  ------>  ICInterfaceVMT  ------+
                                             |   
                                             +---> TBar.ICInterfaceVTable
 +------------------------------------------------------------ @TBar.ICInterfaceQueryInterfaceThunk
 | +---------------------------------------------------------- @TBar.ICInterface_AddRefThunk
 | | +-------------------------------------------------------- @TBar.ICInterface_ReleaseThunk
 | | | +------------------------------------------------------ @TBar.ICInterfaceAMethodThunk
 | | | | +---------------------------------------------------- @TBar.ICInterfaceBMethodThunk
 | | | | | +-------------------------------------------------- @TBar.ICInterfaceCMethodThunk
 | | | | | |
 | | | | | |         
 | | | | | |  TBar.ICInterfaceThunkTable
 | | | | | |    
 | | | | | +-->  TBar.ICInterfaceCMethodThunk
 | | | | |         (first parameter = AICInterface Ptr)                                                CODE of TBar
 | | | | |         Self := first parm - 20 //offset                                                       :
 | | | | |         jmp  ------------------------------------------>  TBar.CMethod entry point             :                                   
 | | | | |                                                                 Self as first parameter        :  
 | | | | +---->  TBar.ICInterfaceBMethodThunk                              :                              :  
 | | | |           (first parameter = AICInterface Ptr)                    ret (return)                   : 
 | | | |           Self := first parm - 20 //offset
 | | | |           jmp  ------------------------------------------>  TFoo.BMethod entry point          CODE of TFoo
 | | | |                                                                   Self as first parameter        :  
 | | | +------>  TBar.ICInterfaceAMethodThunk                              :                              : 
 | | |             (first parameter = AICInterface Ptr)                    ret (return)                   : 
 | | |             Self := first parm - 20 //offset                                                       : 
 | | |             jmp  ------------------------------------------>  TFoo.AMethod entry point             :
 | | |                                                                     Self as first parameter        :   
 | | +-------->  TBar.ICInterface_ReleaseThunk                             :                              : 
 | |               (first parameter = AICInterface Ptr)                    ret (return)                   : 
 | |               Self := first parm - 20 //offset                                                       : 
 | |               jmp  ------------------------------------------>  TFoo._Release entry point            :
 | |                                                                       Self as first parameter        :
 | +---------->  TBar.ICInterface_AddRefThunk                              :                              :
 |                 (first parameter = AICInterface Ptr)                    ret (return)                   : 
 |                 Self := first parm - 20 //offset                                                       :
 |                 jmp  ------------------------------------------>  TFoo._AddRef entry point             :
 |                                                                         Self as first parameter        : 
 +------------>  TBar.ICInterfaceQueryInterfaceThunk                       :                              :
                   (first parameter = AICInterface Ptr)                    ret (return)                   :
                   Self := first parm - 20 //offset                                                       :
                   jmp  ------------------------------------------>  TFoo.QueryInterface entry point      : 
                                                                           Self as first parameter        : 
                                                                              :                           :
                                                                           ret (return)                   :






Trying to describe

A Class that implements an interface carry some code table with it (for a Class not for an Object instance)

  1. the InterfaceEntry array described before
  2. a VTable for every <Class, Interface> couple, composed by an array of (Code) pointers
    for the whole (with inheritance) interface
  3. a "Thunk" code table containing small chunk of code used to de-offset Self pointer
    and branching into the implementing class method

(I' m not sure if Delphi does some optimization, recycling thunk code and VTables for similar interfaces in inheritance ?!?)

Now we can compare an object virtual method call with an Interface method call and found how that they are similar

 

 

 
var
   AObject: TMyBaseObject;                                                     
   ADerivedObject: TMyDerivedObject;                                                     
   AInterface: IMyInterface;
begin

   AObject :=  ADerivedObject;
   AObject.VirtualMethod;
	
	AInterface := ADerivedObject;
	AInterface.InterfaceMethod;

end;    
                                                     
/// Object Virtual Call /////////////////////////////////////////////////////////////////////////
                                                     
   AObject -----+
                |
                |
                V 
      _TMyDerivedObjectInstance
   
  (offset:0)    TMyDerivedObjectVMTPtr  -----+
                                             |
                                             |
                                             V  
                                     TMyDerivedObject.VMT                  
                                             :
            (offset of VirtualMethod)   @TMyDerivedObject.VirtualMethod 
                                        


   ClassPtr   := AObject^  
   ClassVMT   := ClassPtr^  
   EntryPtr   := ClassVMT + (VMToffset of VirtualMethod)
   
   call EntryPtr^ ( AObject );
   
  
/// Interface Method Call /////////////////////////////////////////////////////////////////////////
                                                     
   AInterface ----+
                  |
                  |
                  V
    _TMyDerivedObjectInstance.IMyInterface (hidden field)
   
(offset:0)    TMyDerivedObjectIMyInterfaceVTablePtr  ----+
                                                         |
                                                         |
                                                         V  
                                     TMyDerivedObjectIMyInterfaceVTable                  
                                                        :
          (offset of InterfaceMethod)   @TMyDerivedObjectIMyInterfaceVTableInterfaceMethodThunk 
                                        


   VTablePtr  := AInterface^  
   VTable     := VTablePtr^  
   ThunkPtr   := VTable + (VTable offset of InterfaceMethod)
   
   call ThunkPtr^ ( AInterface );
   
   
   (thunk code)
   
   		Self := AInterface - constant offset
   		jmp  ImplEntry 



This is quite important, because let you fool VB client by let them believe to call regular VC++ COM Server ... 

More seriuosly, VPtr,VTable are a part of COM specification, and DAX (Delphi COM internal implementation) follows this specification. 

(BTW, there a lot more in DAX: Class Factories, Registration, Type Libraries, Marshalling, Events, MTS...)

 

So far, so good ...

But sometime things are trickier.

What about calling convention and implementation with virtual methods?

Delphi by default uses Register calling (left to right parameter passing, stored possibly in register), Delphi COM uses safecall (an stdcall variant, with right to left parameter passing, stored in the stack) and there are also pascal and cdecl calling modes.

The effect is that there are many possible position where Self pointer as to be adjusted, and this as to be declared in both interface declaration and implementing method. The generated code has to handle all the cases...

For virtual calls, everything work as expected:

 

  1. adjust the Self pointer (in the right place)
  2. dereference the Self pointer to get the VMT pointer of the implementing class
  3. read the address of the virtual method (at fixed offset from VMT start)
  4. jump into this address, passing in the right position the self pointer as first parameter

 

And the "implements" keyword ...

 

 
type

   IXInterface = interface(IUnknown)
   ['{713252E5-4636-11D5-B572-00AA00ACFD08}']
      procedure XStaticMethod;
      procedure XVirtualMethod;
   end;

   IYInterface = interface(IUnknown)
   ['{713252E6-4636-11D5-B572-00AA00ACFD08}']
      procedure YMethod;
   end;

   IZInterface = interface(IUnknown)
   ['{713252E4-4636-11D5-B572-00AA00ACFD08}']
   end;


type
   TInnerObject = class(TAggregatedObject,IXInterface,IYInterface)
   public
      procedure XStaticMethod;
      procedure XVirtualMethod; virtual;
      procedure YMethod;
   end;

   TSpecialObject = class(TInnerObject,IXInterface,IYInterface)
   public
      procedure XStaticMethod;
      procedure XVirtualMethod; override;
      procedure YMethod;
   end;

   TFoo = class(TObject,IXInterface,IYInterface,IZInterface)
   private
      FInnerX: TInnerObject;
   protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    function GetX: TInnerObject; virtual;
    function GetY: IYInterface;
   public
      constructor Create;
      destructor  Destroy; override;
      property  InnerX: TInnerObject read GetX implements IXInterface;
      property  InnerY: IYInterface  read GetY implements IYInterface;
   end;

   TBar = class(TFoo,IXInterface,IYInterface,IUnknown)
   private
    FX: TSpecialObject;
    FY: IYInterface;
   protected
      function GetX: TInnerObject; override;
   public
      constructor Create;
      destructor  Destroy; override;
      property Y: IYInterface  read FY implements IYInterface;
      property  X: TSpecialObject read FX implements IXInterface;
   end;

The "implements" keyword lets you delegate the implementation of an interface to a property. This is a very powerful feature that can be applied to COM style aggregation in a quite simple way. But there a lot of work behind ...

There are two ways to implements an interface with a property

but there are also three ways to implement a property getter (read clause in property declaration)

This is definitively 2 hard 4 me! I hope i can read it on the next Developer Guide

I just write here some "impressions"

Interface Field in this case, there no hidden pointer and vtable generation for the class, but when the interface is requested the value of the field is returned (instead of is address)
Interface Static again, no hidden pointer and vtable, but the value of interface field is retrieved by a call to the static property getter
Interface Virtual as above, with a virtual function call
Class Field here we have a different Self to pass to the delegated implementation, so the hidden interface pointer points to a VTable for the interface that direct to a special version of thunk code that after adjusting the Self of the delegating class, uses this information to read the delegated Self to pass to the implementation call (jump)
Class Static similar to the previous, with the addition that the Self is not available, but is returned by a static (function) method call
Class Virtual again, but this time the function getter to call is virtual (retrieved by delegating Self, ClassPtr, ClassVMT + function offset)

 

just for example,

 


 
{ TFoo }

constructor TFoo.Create;
var
   i: IZInterface;
begin
   i := Self;
   FInnerX := TInnerObject.Create(i);  //interface inh. to IUnknown
end;

destructor TFoo.Destroy;
begin
  WriteLn('TFoo.Destroy');
  FInnerX.Free;
  inherited;
end;

function TFoo.GetX: TInnerObject;
begin
   result := FInnerX;
end;

{ TFoo.IUnknown }

function TFoo._AddRef: Integer;
begin
   result := -1;
end;

function TFoo._Release: Integer;
begin
   result := -1;
end;

function TFoo.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;

function TFoo.GetY: IYInterface;
begin
   result := FInnerX;
end;

{ TBar }

constructor TBar.Create;
begin
   inherited;
   FX := TSpecialObject.Create(Self);  //explicit IUnknown
   FY := FX;
end;

destructor TBar.Destroy;
begin
  WriteLn('TBar.Destroy');
  FY := nil;
  FX.Free;
  inherited;
end;

function TBar.GetX: TInnerObject;
begin
   result := FX;
end;


{ TInnerObject }

procedure TInnerObject.XStaticMethod;
begin
  WriteLn(Format(
  'Calls TInnerObject.XStaticMethod  on a %s',[ClassName]));
end;

procedure TInnerObject.XVirtualMethod;
begin
  WriteLn(Format(
  'Calls TInnerObject.XVirtualMethod on a %s',[ClassName]));
end;


procedure TInnerObject.YMethod;
begin
  WriteLn(Format(
  'Calls TInnerObject.YMethod on a %s',[ClassName]));
end;

{ TSpecialObject }

procedure TSpecialObject.XStaticMethod;
begin
  WriteLn(Format(
  'Calls TSpecialObject.XStaticMethod  on a %s',[ClassName]));
end;

procedure TSpecialObject.XVirtualMethod;
begin
  // inherited;
  WriteLn(Format(
  'Calls TSpecialObject.XVirtualMethod on a %s',[ClassName]));
end;

procedure TSpecialObject.YMethod;
begin
  WriteLn(Format(
  'Calls TSpecialObject.YMethod on a %s',[ClassName]));
end;




here a test code ...

 
procedure TestFoo(AFoo: TFoo);
var
   o: TFoo;
   x: IXInterface;
   y: IYInterface;
   z: IZInterface;
begin

  o := AFoo;

  x := o;
  x.XStaticMethod;   // if AFoo is TBar TFoo.XStatic hides TBar.XStatic
  x.XVirtualMethod;

  y := o;
  y.YMethod;

  z := x as IZInterface;
  z := y as IZInterface;

  z := o;
  x := z as IXInterface;

end;

procedure TestBar(ABar: TBar);
var
   o: TBar;
   x: IXInterface;
   y: IYInterface;
   z: IZInterface;
begin

  o := ABar;

  x := o;
  x.XStaticMethod;
  x.XVirtualMethod;

  y := o;
  y.YMethod;

  z := x as IZInterface;
  z := y as IZInterface;

  z := o;
  x := z as IXInterface;

end;

procedure Test;
var
   AFoo: TFoo;
   ABar: TBar;
begin
   AFoo := TFoo.Create;
   ABar := TBar.Create;

   WriteLn('***TestFoo(AFoo)*****************');
   TestFoo(AFoo);
   Pause;

   WriteLn('***TestFoo(ABar)*****************');
   TestFoo(ABar);
   Pause;

   WriteLn('***TestBar(ABar)*****************');
   TestBar(ABar);
   Pause;

   AFoo.Free;
   ABar.Free;

   Pause;
end;


initialization
   WriteLn('IntGetter.TInnerObject.InstanceSize: ',TInnerObject.InstanceSize);
   WriteLn('IntGetter.TSpecialObject.InstanceSize: ',TSpecialObject.InstanceSize);
   WriteLn('IntGetter.TFoo.InstanceSize: ',TFoo.InstanceSize);
   WriteLn('IntGetter.TBar.InstanceSize: ',TBar.InstanceSize);
end.




and its output ...

 
IntGetter.TInnerObject.InstanceSize: 16
IntGetter.TSpecialObject.InstanceSize: 24
IntGetter.TFoo.InstanceSize: 16
IntGetter.TBar.InstanceSize: 32

***TestFoo(AFoo)*****************
Calls TInnerObject.XStaticMethod  on a TInnerObject
Calls TInnerObject.XVirtualMethod on a TInnerObject
Calls TInnerObject.YMethod on a TInnerObject

***TestFoo(ABar)*****************
Calls TInnerObject.XStaticMethod  on a TSpecialObject
Calls TSpecialObject.XVirtualMethod on a TSpecialObject
Calls TInnerObject.YMethod on a TInnerObject

***TestBar(ABar)*****************
Calls TSpecialObject.XStaticMethod  on a TSpecialObject
Calls TSpecialObject.XVirtualMethod on a TSpecialObject
Calls TSpecialObject.YMethod on a TSpecialObject

TFoo.Destroy
TBar.Destroy
TFoo.Destroy




--- After a pause, a dark night has fallen&  ---

but we must not be frightened by the darkness

 

... let's return to interfaces

The description made until now just covers only one aspect of Delphi interface: 

abusing term, we could call it "the static face" of interfaces

But there is another characteristic in interfaces that (also abusing) we call "dynamic discovery" ...

This is a COM specification aspect, but it has nothing to do with M$-COM implementation.

(Delphi interfaces are a native language feature and DO NOT require COM as you may want to verify trying Kylix on Linux.

There are (a lot of) Delphi interfaces that provide COM support, but the vice versa is not true! )

Interface inheritance is single rooted, and the root is IInterface (=IUnknown) type, declared in  System.pas.

And the first method in the root is "Query Interface", that has to be very "primitive", considering its position and the fact that, because of inheritance, every interface requires the implementation of a "Query" ability.

What the action of query, applied to an interface, is supposed to do?

 
  IUnknown = interface
  ...
	function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  ...	

 At a first sight it seems quite cryptic, but it has to conform to COM specification ...

It is a function with a out parameter, so returns two things:

 

the only input parameter is a IID of type TGUID, passed by (constant) reference, and if this is not enough, the function is declared "stdcall".

Starting from the last:

 mm..., maybe i ought to have started from the first ...

An Universally Unique Identifier (UUID) is a "key" that can be generated independently by a computer system in a way that is (statistically) guaranteed to be different from all other UUID generated by the same or other computer somewhere in the world (universe ?). It is a DCE standard specification required by RPC (Remote Procedure Call) protocol, from which COM derives. 

A "Global Unique Identifier" (GUID) is a 16 bytes binary constant  and it is the Windows equivalent of a UUID, that follows  DCE specification. A GUID can be obtained from Windows OS with a API call to CoCreateGuid. 

In Delphi, GUID constants are declared of type TGUID, a record type in System.pas. VCL provides a Pascal wrapper of CoCreateGuid with the CreateClassID function (in the group of COM utility functions as IsEqualGuid, GUIDToString and StringToGUID that do what their name let guess). In Delphi editor, you may press "Ctrl-Shift-G" to insert a new fresh GUID in your source. 

TGUID type is somewhat "special" and the compiler reserves it a form of "meta" handling.

Consider this code:

 

 
  ...
   IXInterface = interface(IUnknown)
   ['{713252E5-4636-11D5-B572-00AA00ACFD08}']  // TGUIDs are (special) "Attributes"
      procedure XStaticMethod;
      procedure XVirtualMethod;
   end;

   IYInterface = interface(IUnknown)
   ['{713252E6-4636-11D5-B572-00AA00ACFD08}']
      procedure YMethod;
   end;

   IZInterface = interface(IUnknown)
   ['{713252E4-4636-11D5-B572-00AA00ACFD08}']
   end;
  
  ...	

///////////////////////////////////////////////////////////////////////////////

{ Test }

procedure TestGuidType(AObject: TObject; const IID: TGUID);
var
   x: IXInterface;
   y: IYInterface;
   z: IZInterface;
begin

   if Supports(AObject,IZInterface,z) then  //Supports (overloaded) function
   begin

     if IsEqualGUID(IID,IXInterface) then  // IID = IXInterface (type var = type const) ...
     begin
        WriteLn('IXInterface:',GuidToString(IXInterface));   //Interface Type to string
        
        if z.QueryInterface(IXInterface,x) = S_OK then       // QueryInterface (interface) call 
           x.XStaticMethod;
     end;

     if IsEqualGUID(IID,IYInterface) then
     begin
        WriteLn('IYInterface:',GuidToString(IYInterface));
        
        y :=  z as IYInterface;         // "as" operator (can raise EInterfaceNotSupported)
        y.YMethod;
        
     end;

   end;
end;

procedure TestGuid;
var
   o: TBar;
begin

  o := TBar.Create;

  TestGuidType(o,IXInterface);   //Interface Types cast to a TGUID
  TestGuidType(o,IYInterface);

  o.Free;

end;

  
  ...	
  
 

If you look at interface declaration, you see an "extra" construct  [{...}]. It 's an interface identification attribute, that is not used only to provide (possible) COM support, but it gives Delphi a way to uniquely identify an interface type. In effect, the compiler automatically provides a form of cast between (static) interface type constants and the associated GUID (talking of interfaces, GUIDs are called IIDs ... ).

Variable of TGUID type can be seen as "interface-type" variable, in analogy to what happens with Delphi "MetaClasses", although this analogy is not complete (more on this later).

Returning to the "query" question, we can describe QueryInterface as the action, applied to an interface value, of asking to its implementation if is able to provide another "view" of itself, in the form of an interface value (out pointer) of the (variable) type specified in  IID input parameter.

A very important point here is that the identity of the object behind the returned interface can be different from the one behind the interface queried !  (consider "implements" keyword...) 

COM specification is very strict on this point and requires the following (equivalence) rules:

 

Delphi is more tolerant, but it is not wise to brake these rules ...

With all these requirements, it could seem that implementing a QueryInterface function were a complex task, but this is not the case. Rarely it takes more than three lines of code, thanks to TObject.GetInterface method.

In fact, for non-delegated interfaces, a typical implementation looks like:

 

  
function TFoo.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
    if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;

 

  while, for a delegated one, this version can be used

 

  
function TDelegated.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
    Result := IUnknown(FDelegating).QueryInterface(IID, Obj);
end;

mm.., the second has a "recursive" taste and, despite its brief form it's actually trickier...

and if we follow the path of calls, we should find another GetInterface.

So what GetInterface does for us ?

In description of InitInstance function, we consider IntfTable as an array of interface entry records of four fields.

in InitInstance, the GUID field was not used, it is there to mark the "key" of the interface record that is needed by GetInterface to retrieve the entry corresponding to the IID input parameter. The search for an entry starts from the IntfTable of the class of the object, and it can continue for along class inheritance (Class.Parent/Class.Self).

This structure is a kind of "mirror", to which the object has to see, to retrieve its hidden interface pointer (that already owns...) .

What is returned (as pointer) in out variable is this address:

Self + InterfaceEntry.Offset

and that's the "inverse" of what "thunk" code compute!

For delegated interfaces ("implements") of interface type, ImplGetter field allows to "retrieve" the value of the interface pointer field with a property access (see InvokeImplGetter for details)

In case of class type property delegation, the address of the hidden interface field of the delegating object is returned (see "class type interface delegation" above...).

In brief,  GetInterface retrieve the address of an interface pointer for the instance, of the interface type (=> GUID) required.

Although they looks quite similar, GetInterface and QueryInterface have a different meaning:

If an object delegates the implementation of an interface to another object, we cannot use GetInterface of the delegated object to retrieve the interfaces of the delegating one (a good thing with delegation is that we can reuse implementation for many delegating classes ...).

But if we consider that GetInterface of the delegating object is able to retrieve all the interfaces (delegated or not), we have a simple solution to equivalence problem:

 

  
function TDelegated.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
   Result := IUnknown(FDelegating).QueryInterface(IID, Obj);
end;

the only thing needed here is that delegated object stores a "reference" to delegating one (possibly passed as constructor argument).

OK, but why this cast?

    IUnknown(FDelegating)

It's indeed a big (and a bit controversial) question ...

COM specification of IUnknown does not stop at QueryInterface but it goes further:

  IUnknown = interface
    ['{00000000-0000-0000-C000-000000000046}']
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

It requires that every interface must provide a support for "reference counting", with an increment (_AddRef) and decrement (_Release) methods.

But the heavy part is on the client side, because it requires also that every interface (obtained by a QueryInterface or by assignment) must be properly _AddRefed and _Released.

These requirements are a sign of COM heritage as a local (machine) way of dynamic linking executable code (DLL are refcounted...) and although it was extended to LAN environments (DCOM), it does not work well in wider contexts (there are many other problems here, and SOAP may surely help more COM than CORBA ...).

The good news here is that Delphi handles transparently all this stuff, without a single line of code!

Maybe you may want to read these two (quite old) articles of Don Box, to compare Delphi COM programming to C++ COM coding 

In fact, Delphi interface pointers aren't just pointer, they are "smarter"...

The compiler generates around interface variable the code needed to handle reference count (without errors, it's a compiler!). There are several cases to deal with:

As a small sample of this behavior:

unit IntCount;

interface

uses
   SysUtils;

type

   IPInterface = interface
   ['{82F64441-505E-11D5-B57A-00AA00ACFD08}']
   end;

   IQInterface = interface
   ['{82F64442-505E-11D5-B57A-00AA00ACFD08}']
   end;

   TFoo = class(TObject,IPInterface,IQInterface,IUnknown)
   protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
   public
     destructor Destroy; override;
   end;

   TBar = class(TInterfacedObject,IPInterface,IQInterface)
   protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
   public
     destructor Destroy; override;
   end;

procedure Test;

implementation

uses
   IntUti,
   Windows, //for E_NOINTERFACE
   ComObj;  //for GuidToString

{ TFoo }

function TFoo._AddRef: Integer;
begin
   result := -1;
   WriteLn(ClassName,'._AddRef (After)');
end;

function TFoo._Release: Integer;
begin
   WriteLn(ClassName,'._Release (Before)');
   result := -1;
end;

function TFoo.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  WriteLn(ClassName,'.QueryInterface for ',GuidToString(IID));
  if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
end;

destructor TFoo.Destroy;
begin
  WriteLn(ClassName,'.Destroy');
  inherited;
end;

{ TBar }

function TBar._AddRef: Integer;
begin
   result := inherited _AddRef;
   WriteLn(ClassName,'._AddRef (After):',RefCount);
end;

function TBar._Release: Integer;
begin
   WriteLn(ClassName,'._Release (Before):',RefCount);
   result := inherited _Release;
end;

function TBar.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
   WriteLn(ClassName,'.QueryInterface for ',GuidToString(IID));
   result := inherited QueryInterface(IID,Obj);
end;

destructor TBar.Destroy;
begin
  WriteLn(ClassName,'.Destroy');
  inherited;
end;

///////////////////////////////////////////////////////////////////////////////

{ Test }

procedure NoNeedsQ(Q: IQInterface);
begin
   WriteLn('Inside NoNeedsQ');   // no reference to Q in body ...
end;


procedure NeedsQ(Q: IQInterface; DoRaise: Boolean);
var
   Z: IPInterface;
begin                         // here Q is stabilized (_AddRef) once more

   WriteLn('Inside NeedsQ - Before Z');

   Z := Q as IPInterface;

   WriteLn('Inside NeedsQ - After Z');

   if DoRaise then
      raise Exception.Create('Raise in NeedsQ');

   WriteLn('Inside NeedsQ - not raised ...');

end;                       // here Z and Q are _Released (if not raised only ...)


procedure TestExceptCounted;
var
   P: IPInterface;
begin

   P := TBar.Create;                // P._AddRef in assignment

   try

      WriteLn('Before NeedsQ');

      NeedsQ(P as IQInterface, true);  //temporary (_AddRefed) interface by QueryInterface

      WriteLn('After NeedsQ');

   except                           // stack cleanup (_Release of Z,Q)
   
      WriteLn('Exception in NeedsQ');
      
   end;

   P := nil;                        // P._Release

   WriteLn('After P := nil');

end;  // temporary interface released here ...

procedure TestRefCounted;
var
   P: IPInterface;
begin

   P := TBar.Create;                // P._AddRef in assignment

   WriteLn('Before NoNeedsQ');

   NoNeedsQ(P as IQInterface);  //temporary (_AddRefed) interface by QueryInterface

   WriteLn('After NoNeedsQ');

   WriteLn('Before NeedsQ');

   NeedsQ(P as IQInterface, false);  //temporary (_AddRefed) interface by QueryInterface

   WriteLn('After NeedsQ');

   P := nil;                        // P._Release

   WriteLn('After P := nil');

end;  // temporary interface released here ...


procedure TestNODanger;
var
   AFoo: TFoo;
begin

   AFoo := TFoo.Create;

   NoNeedsQ(AFoo); // static (compiler) @hidden pointer (no temporary/_AddRef)

   AFoo.Free;

   WriteLn('AFoo DESTROYED HERE ...');

end; // ok, safe

procedure TestAVDanger;
var
   AFoo: TFoo;
begin

   AFoo := TFoo.Create;

   NoNeedsQ(AFoo as IQInterface); // temporary _AddRefed

   AFoo.Free;

   WriteLn('AFoo DESTROYED HERE ...');

end;  // calls _Release on a Destroyed object; BANG...



procedure Test;
begin

   WriteLn('--- Before TestNODanger---------------------');
   TestNODanger;
   WriteLn('--- After  TestNODanger---------------------');
   WriteLn('');
   WriteLn('--- Before TestAVDanger---------------------');
   TestAVDanger;
   WriteLn('--- After  TestAVDanger---------------------');

   WriteLn('');
   WriteLn('--- Before TestRefCounted-------------------');
   TestRefCounted;
   WriteLn('--- After  TestRefCounted-------------------');
   WriteLn('');
   WriteLn('--- Before TestExceptCounted----------------');
   TestExceptCounted;
   WriteLn('--- After  TestExceptCounted----------------');
   Pause;
end;

end.

that gives this output ...


--- Before TestNODanger----------------------
Inside NoNeedsQ
TFoo.Destroy
AFoo DESTROYED HERE ...
--- After  TestNODanger----------------------


--- Before TestAVDanger----------------------
TFoo._AddRef (After)
Inside NoNeedsQ
TFoo.Destroy
AFoo DESTROYED HERE ...
TFoo._Release (Before)
--- After  TestAVDanger----------------------


--- Before TestRefCounted--------------------
TBar._AddRef (After):1
Before NoNeedsQ
TBar.QueryInterface for {82F64442-505E-11D5-B57A-00AA00ACFD08}
TBar._AddRef (After):2
Inside NoNeedsQ
After NoNeedsQ
Before NeedsQ
TBar.QueryInterface for {82F64442-505E-11D5-B57A-00AA00ACFD08}
TBar._AddRef (After):3
TBar._AddRef (After):4
Inside NeedsQ - Before Z
TBar.QueryInterface for {82F64441-505E-11D5-B57A-00AA00ACFD08}
TBar._AddRef (After):5
Inside NeedsQ - After Z
Inside NeedsQ - not raised ...
TBar._Release (Before):5
TBar._Release (Before):4
After NeedsQ
TBar._Release (Before):3
After P := nil
TBar._Release (Before):2
TBar._Release (Before):1
TBar.Destroy
--- After  TestRefCounted--------------------


--- Before TestExceptCounted-----------------
TBar._AddRef (After):1
Before NeedsQ
TBar.QueryInterface for {82F64442-505E-11D5-B57A-00AA00ACFD08}
TBar._AddRef (After):2
TBar._AddRef (After):3
Inside NeedsQ - Before Z
TBar.QueryInterface for {82F64441-505E-11D5-B57A-00AA00ACFD08}
TBar._AddRef (After):4
Inside NeedsQ - After Z
TBar._Release (Before):4
TBar._Release (Before):3
Exception in NeedsQ
TBar._Release (Before):2
After P := nil
TBar._Release (Before):1
TBar.Destroy
--- After  TestExceptCounted-----------------

in particular, an example on how things can sometimes go wrong with reference counting, look at this apparently innocent code

procedure TestAVDanger;
var
   AFoo: TFoo;
begin

   AFoo := TFoo.Create;

   NoNeedsQ(AFoo as IQInterface); // temporary _AddRefed

   AFoo.Free;

   WriteLn('AFoo DESTROYED HERE ...');

end;  // calls _Release on a Destroyed object; BANG...

here you may have an "access violation" because temporary interface is Relesed after object destruction ...

TFoo._AddRef (After)
Inside NoNeedsQ
TFoo.Destroy
AFoo DESTROYED HERE ...
TFoo._Release (Before)

 

but if you don't mix different allocation approaches (reference counting vs explicit destruction) everything works well, even with exceptions!

Smart pointers are for "client" side. In the "server", there are four alternatives for "reference counting" implementation:

 

Returning to the cast question

    IUnknown(FDelegating)

If you look at TAggregatedObject class, you see that the Controller parameter of IUnknown type is stored in a untyped pointer field, and casted back to IUnknown when used. The reason why is that casting an interface to a pointer "disables"  automatic _AddRef,_Release call generation. This is important to avoid the "Circular Reference Problem", when two object references one another, and don't bias interface counter for the delegating object. Without this trick, the delegating object could  never be freed.

 

"Aggregation" is a very powerful feature, and very easy to do in Delphi:

 

unit GlueBox;

interface

uses
   ComObj,ComServ;

const
  SIID_IFirst           = '{B96D9865-4006-11D5-B56D-00AA00ACFD08}';
 SCLASS_First           = '{B96D9866-4006-11D5-B56D-00AA00ACFD08}';
   IID_IFirst:          TGUID =
  SIID_IFirst;
  CLASS_First:          TGUID =
 SCLASS_First;

  SIID_ISecond          = '{B96D9867-4006-11D5-B56D-00AA00ACFD08}';
 SCLASS_Second          = '{B96D9868-4006-11D5-B56D-00AA00ACFD08}';
   IID_ISecond:         TGUID =
  SIID_ISecond;
  CLASS_Second:         TGUID =
 SCLASS_Second;

  SIID_IThird           = '{B96D9869-4006-11D5-B56D-00AA00ACFD08}';
 SCLASS_Third           = '{B96D986A-4006-11D5-B56D-00AA00ACFD08}';
   IID_IThird:          TGUID =
  SIID_IThird;
  CLASS_Third:          TGUID =
 SCLASS_Third;

type
   IFirst = interface(IUnknown)
   [SIID_IFirst]
      procedure Execute;
   end;

   ISecond = interface(IUnknown)
   [SIID_ISecond]
      procedure Execute;
   end;

   IThird = interface(IUnknown)
   [SIID_IThird]
      procedure Execute;
   end;

type
   TBase = class(TComObject)
   private
    FName: string;
   protected
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
   public
    function ObjQueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall;
    function ObjAddRef: Integer;  override; stdcall;
    function ObjRelease: Integer;  override; stdcall;
    procedure Initialize; override;
    destructor Destroy; override;
    procedure Execute; virtual;
   end;

   TFirst = class(TBase,IFirst)
   public
    procedure Initialize; override;
   end;

   TSecond = class(TBase,ISecond,IFirst)
   private
    FFirst: IUnknown;
    function GetFirst: IFirst;
   public
    property First: IFirst read GetFirst implements IFirst;
    procedure Initialize; override;
    destructor Destroy; override;
   end;

   TThird = class(TBase,IThird,ISecond,IFirst)
   private
    FSecond: IUnknown;
    function GetSecond: ISecond;
    function GetFirst: IFirst;
   public
    property First: IFirst read GetFirst implements IFirst;
    property Second: ISecond read GetSecond implements ISecond;
    procedure Initialize; override;
    destructor Destroy; override;
   end;


procedure Test;

implementation

uses
   GlueUti;

///////////////////////////////////////////////////////////////////////////////

{ TBase }

function TBase._AddRef: Integer;
begin
   WriteLn(ClassName,'._AddRef');
   result := inherited _AddRef;
end;

function TBase._Release: Integer;
begin
   WriteLn(ClassName,'._Release');
   result := inherited _Release;
end;

function TBase.ObjAddRef: Integer;
begin
   WriteLn(ClassName,'.ObjAddRef');
   result := inherited ObjAddRef;
end;

function TBase.ObjRelease: Integer;
begin
   WriteLn(ClassName,'.ObjRelease');
   result := inherited ObjRelease;
end;

function TBase.ObjQueryInterface(const IID: TGUID; out Obj): HResult;
begin
   WriteLn(ClassName,'.ObjQueryInterface:',GuidToString(IID));
   result := inherited ObjQueryInterface(IID,Obj);
end;

function TBase.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
   WriteLn(ClassName,'.QueryInterface:',GuidToString(IID));
   result := inherited QueryInterface(IID,Obj);
end;

procedure TBase.Execute;
begin
   WriteLn(ClassName,'.Execute ................');
end;

destructor TBase.Destroy;
begin
  WriteLn(ClassName,'.Destroy');
  inherited;
end;

procedure TBase.Initialize;
begin
  inherited;
  FName := ClassName;  //4 debug ...
  WriteLn(ClassName,'.Initialize');
end;

///////////////////////////////////////////////////////////////////////////////

{ TFirst }

procedure TFirst.Initialize;
begin
  inherited;
end;

{ TSecond }

function TSecond.GetFirst: IFirst;
begin
   result := FFirst as IFirst;
end;

procedure TSecond.Initialize;
var
   Unk: IUnknown;
begin
  inherited;

  if Assigned(Controller) then
     Unk := Controller
  else
     Unk := Self;

   FFirst :=  // IUnknown
    ComClassManager.GetFactoryFromClassID(CLASS_First)
       .CreateComObject(Unk)
end;

destructor TSecond.Destroy;
begin
  FFirst := nil;
  inherited;
end;

{ TThird }

destructor TThird.Destroy;
begin
  FSecond := nil;
  inherited;
end;

function TThird.GetFirst: IFirst;
begin
   result := FSecond as IFirst;
end;

function TThird.GetSecond: ISecond;
begin
   result := FSecond as ISecond;
end;

procedure TThird.Initialize;
var
   Unk: IUnknown;
begin
  inherited;

  if Assigned(Controller) then
     Unk := Controller
  else
     Unk := Self;

   FSecond :=  // IUnknown
    ComClassManager.GetFactoryFromClassID(CLASS_Second)
       .CreateComObject(Unk)
end;

///////////////////////////////////////////////////////////////////////////////

{ Test }

procedure NeedsFirst(o: IFirst);
begin
   o.Execute;
end;

procedure NeedsSecond(o: ISecond);
begin
   o.Execute;
end;

procedure NeedsThird(o: IThird);
begin
   o.Execute;
end;

procedure TestBox;
var
   Unk: IUnknown;
   First: IFirst;
   Second: ISecond;
   Third: IThird;
begin

   WriteLn('---TestBox--------------------------');

   Unk :=
      ComClassManager.GetFactoryFromClassID(CLASS_Third)
         .CreateComObject(nil);

   Third  := Unk as IThird;
   Second := Unk as ISecond;
   First  := Unk as IFirst;

   NeedsThird(Third);
   NeedsSecond(Second);
   NeedsFirst(First);

   NeedsThird(Third);
   NeedsSecond(Third as ISecond);
   NeedsFirst(Third as IFirst);

   NeedsSecond(Second);
   NeedsThird(Second as IThird);
   NeedsFirst(Second as IFirst);

   NeedsFirst(First);
   NeedsThird(First as IThird);
   NeedsSecond(First as ISecond);

   Third  := nil;
   Second := nil;
   First  := nil;

   WriteLn('Still Alive ...');

end; //destroyed here

procedure Test;
begin
   TestBox;
   GlueUti.Pause;
end;


initialization
  TComObjectFactory.Create(ComServ.ComServer, TFirst, Class_First,
    'First','First',ciMultiInstance, tmApartment);  // tmSingle?
  TComObjectFactory.Create(ComServ.ComServer, TSecond, Class_Second,
    'Second','Second',ciMultiInstance, tmApartment);
  TComObjectFactory.Create(ComServ.ComServer, TThird, Class_Third,
    'Third','Third',ciMultiInstance, tmApartment);
end.

 

just few comments on this code:

 

uh.., i'm quite tired and the sun is rising now ...

but just one more thing ...

"Interface reflection"

With Type Library Delphi offers a rich set of reflection features for interfaces (see ITypeInfo COM interface), you may "query" your interfaces deep down method argument types (useful for automatic marshalling). There's an example for that in Eric Harmon's "Delphi COM Programming" nice book.

But this is a COM feature, and i prefer to mention this OP feature.

In  unit TypInfo, you find functions to access RTTI (RunTimeTypeInfo) tables for a lot of things, and interfaces are in, as you may guess ...

 

unit IntSight;

interface

uses
  Windows,SysUtils,Classes;

type

   IAInterface = interface(IUnknown)
   ['{713252E1-4636-11D5-B572-00AA00ACFD08}']
      procedure AMethod;
   end;

   IBInterface = interface(IAInterface)
   ['{713252E2-4636-11D5-B572-00AA00ACFD08}']
      procedure BMethod;
   end;

   ICInterface = interface(IAInterface)
   ['{713252E3-4636-11D5-B572-00AA00ACFD08}']
      procedure BMethod;
      procedure CMethod;
   end;

   IZInterface = interface(IUnknown)
   ['{713252E4-4636-11D5-B572-00AA00ACFD08}']
   end;

implementation

uses
   ActiveX,ComObj,TypInfo,IntUti;

///////////////////////////////////////////////////////////////////////////////

{ Test }

procedure TestDumpType(IntfInfo: PTypeInfo);
var
   pInfo: PTypeInfo;
   pData: PTypeData;
begin
   WriteLn('--------------------------------');

   pInfo := IntfInfo;

   while pInfo <> nil do
   begin
      WriteLn('Type:', pInfo.Name );
      pData := GetTypeData(pInfo);
      WriteLn('Guid:',GuidToString(pData.Guid));
      WriteLn('Unit:',pData.IntfUnit);
      pInfo := nil;
      if pData.IntfParent <> nil then
         pInfo := pData.IntfParent^
   end;

end;

procedure TestType;
begin

   TestDumpType(TypeInfo(ICInterface));
   TestDumpType(TypeInfo(IBInterface));
   TestDumpType(TypeInfo(IAInterface));
   TestDumpType(TypeInfo(IZInterface));

end;





--------------------------------
Type:ICInterface
Guid:{713252E3-4636-11D5-B572-00AA00ACFD08}
Unit:IntSight
Type:IAInterface
Guid:{713252E1-4636-11D5-B572-00AA00ACFD08}
Unit:IntSight
Type:IUnknown
Guid:{00000000-0000-0000-C000-000000000046}
Unit:System
--------------------------------
Type:IBInterface
Guid:{713252E2-4636-11D5-B572-00AA00ACFD08}
Unit:IntSight
Type:IAInterface
Guid:{713252E1-4636-11D5-B572-00AA00ACFD08}
Unit:IntSight
Type:IUnknown
Guid:{00000000-0000-0000-C000-000000000046}
Unit:System
--------------------------------
Type:IAInterface
Guid:{713252E1-4636-11D5-B572-00AA00ACFD08}
Unit:IntSight
Type:IUnknown
Guid:{00000000-0000-0000-C000-000000000046}
Unit:System
--------------------------------
Type:IZInterface
Guid:{713252E4-4636-11D5-B572-00AA00ACFD08}
Unit:IntSight
Type:IUnknown
Guid:{00000000-0000-0000-C000-000000000046}
Unit:System


Next  Up..