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:
every entry in an interface record contains 4 fields:
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:
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)
(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:
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.. |