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.. |