What I am trying to do is to add common methods to these two classes which have the same indirect ancestor.
IMyMethods = interface
procedure SomeMethod;
end;
TMyADODataset =class(TADODataset, IMyMethods) // ADO
public
procedure SomeMethod;
end;
TMyUniDataset =class(TUniTable, IMyMethods) // UniDAC
public
procedure SomeMethod;
end;
SomeMethod would be implemented differently for ADO and for UniDAC. So I thought an interface is perfect.
Then we have
TMyTable =class
private
FDataset: TDataset;
end;
Here I have choosen TDataset as that is the common ancestor of TADODataset and TUniTable.
FDataset could be instantiated as follows:
if FProvider = prADO then
FDataset := TMyADODataset.Create
else
FDataset := TMyUniDataset.Create;
Now the problem is how to call SomeMethod of FDataset, the following does not compile and gives a type incompatibility error:
IMyMethods(FDataset).SomeMethod;
This is because TDataset does not implement IMyMethods, which is correct. But is there any way I can trick the compiler into accepting this? Or is there a better solution? I thought of class helpers but the implentation of SomeMethod will be different for ADO and UniDAC.
Use the SysUtils.Supports() function to obtain the IMyMethods interface from the FDataset object, eg:
uses
..., SysUtils;
var
Intf: IMyMethods;
...
if Supports(FDataset, IMyMethods, Intf) then
Intf.SomeMethod;
Just note that, in order for this to work, IMyMethods needs to have a Guid assigned to it, eg:
type
IMyMethods = interface
['{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}']
procedure SomeMethod;
end;
You can generate a new Guid directly in the Code Editor by pressing Ctrl+Shift+G.
Related
...or vice versa. Let's suppose two classes on which I have no control, both inherit from the same base class:
TDataSet1 = class(TDataSet)
...
end;
TDataSet2 = class(TDataSet)
...
end;
I have an interface declaration like this:
IMyDataSet = interface
procedure MyProc;
end;
Then I have two classes that inherit from the previous ones and that implement my interface:
TMyDataSet1 = class(TDataSet1, IMyDataSet)
procedure MyProc;
end;
TMyDataSet2 = class(TDataSet2, IMyDataSet)
procedure MyProc;
end;
Now my problem is: i have a bunch of procedures and functions which must accept as parameter an object which can be an instance of both my classes.
I don't need to access properties or methods specific to my two classes or to the ancestor ones, only those from the base class TDataSet and those declared in the interface IMyDataSet.
If I declare a procedure like this:
procedure Foo(ADataSet: TDataSet);
I can only call methods from TDataSet class.
If instead I declare the procedure in this way:
procedure Foo(ADataSet: IMyDataSet);
I can see only methods that belong to that interface.
Is there a way so that I can see both TDataSet and IMyDataSet methods on the reference I pass to the procedure?
You can declare parameter as interface and then typecast it to object reference inside method. (This kind of typecasting works in Delphi 2010 and newer)
procedure Foo(ADataSet: IMyDataSet);
var
LDataSet: TDataSet;
begin
LDataSet := TDataSet(ADataSet);
...
end;
Note: If IMyDataSet interface is not implemented on TDataSet class above typecast will fail without raising exception and return nil.
You can also use as operator to typecast, but in that case failure raises exception.
LDataSet := ADataSet as TDataSet;
Another option is to pass parameter as object instance and then retrieve interface from object. In that case your interface must have GUID.
IMyDataSet = interface
['{XXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX}'] // replace with actual GUID
procedure MyProc;
end;
procedure Foo(ADataSet: TDataSet);
var
LDataSet: IMyDataSet;
begin
if Supports(ADataSet, IMyDataSet, LDataSet) then
begin
...
end;
end;
I ran into a strange situation while testing something today.
I have a number of interfaces and objects. The code looks like this:
IInterfaceZ = interface(IInterface)
['{DA003999-ADA2-47ED-A1E0-2572A00B6D75}']
procedure DoSomething;
end;
IInterfaceY = interface(IInterface)
['{55BF8A92-FCE4-447D-B58B-26CD9B344EA7}']
procedure DoNothing;
end;
TObjectB = class(TInterfacedObject, IInterfaceZ)
procedure DoSomething;
end;
TObjectC = class(TInterfacedObject, IInterfaceY)
public
FTest: string;
procedure DoNothing;
end;
TObjectA = class(TInterfacedObject, IInterfaceZ, IInterfaceY)
private
FInterfaceB: IInterfaceZ;
FObjectC: TObjectC;
function GetBB: IInterfaceZ;
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
property BB: IInterfaceZ read GetBB implements IInterfaceZ;
property CC: TObjectC read FObjectC implements IInterfaceY;
end;
procedure TObjectB.DoSomething;
begin
Sleep(1000);
end;
procedure TObjectA.AfterConstruction;
begin
inherited;
FInterfaceB := TObjectB.Create;
FObjectC := TObjectC.Create;
FObjectC.FTest := 'Testing';
end;
procedure TObjectA.BeforeDestruction;
begin
FreeAndNil(FObjectC);
FInterfaceB := nil;
inherited;
end;
function TObjectA.GetBB: IInterfaceZ;
begin
Result := FInterfaceB;
end;
procedure TObjectC.DoNothing;
begin
ShowMessage(FTest);
end;
Now if I access the various implementations like this I get the following results:
procedure TestInterfaces;
var
AA: TObjectA;
YY: IInterfaceY;
ZZ: IInterfaceZ;
NewYY: IInterfaceY;
begin
AA := TObjectA.Create;
// Make sure that the Supports doesn't kill the object.
// This line of code is necessary in XE2 but not in XE4
AA._AddRef;
// This will add one to the refcount for AA despite the fact
// that AA has delegated the implementation of IInterfaceY to
// to FObjectC.
Supports(AA, IInterfaceY, YY);
YY.DoNothing;
// This will add one to the refcount for FInterfaceB.
// This is also allowing a supports from a delegated interface
// to another delegated interface.
Supports(YY, IInterfaceZ, ZZ);
ZZ.DoSomething;
// This will fail because the underlying object is actually
// the object referenced by FInterfaceB.
Supports(ZZ, IInterfaceY, NewYY);
NewYY.DoNothing;
end;
The first Supports call, which uses the variable in the implements, returns YY which is actually a reference to TObjectA. My AA variable is reference counted. Because the underlying reference counted object is a TObjectA, the second supports, which uses the interface in the supports call, works and returns me an interface. The underlying object is actually now a TObjectB. The internal object behind FInterfaceB is the object being reference counted. This part makes sense because GetBB is actually FInterfaceB. As expected here, the last call to Supports returns a null for NewYY and the call at the end fails.
My question is this, is the reference counting on TObjectA with the first supports call by design? In other words, when the property that implements the interface is returning an object and not an interface does this mean that the owner object will be the one doing the reference counting? I was always under the impression that implements would also result in the internal delegated object being reference counted instead of the main object.
The declarations are as follows:
property BB: IInterfaceZ read GetBB implements IInterfaceZ;
With this option above, the internal object behind FInterfaceB is the one that is reference counted.
property CC: TObjectC read FObjectC implements IInterfaceY;
With this second option above, TObjectA is the one that is being reference counted and not the delegated object FObjectC.
Is this by design?
Edit
I just tested this in XE2 and the behavior is different. The second Supports statement returns nil for ZZ. The debugger in XE4 tells me that the YY is referring to (TObjectA as IInterfaceY). In XE2 it tells me that its a (Pointer as IInterfaceY). Also, in XE2, the AA is not ref counted on the first support statement but the internal FObjectC is reference counted.
Additional Information after the question answered
There is one caveat to this. You can chain the Interface version but not the object version. That means that something like this will work:
TObjectBase = class(TInterfacedObject, IMyInterface)
…
end;
TObjectA = class(TInterfacedObject, IMyInterface)
FMyInterfaceBase: IMyInterface;
property MyDelegate: IMyInterface read GetMyInterface implements IMyInterface;
end;
function TObjectA.GetMyInterface: IMyInterface;
begin
result := FMyInterfaceBase;
end;
TObjectB = class(TInterfacedObject, IMyInterface)
FMyInterfaceA: IMyInterface;
function GetMyInterface2: IMyInterface;
property MyDelegate2: IMyInterface read GetMyInterface2 implements IMyInterface;
end;
function TObjectB.GetMyInterface2: IMyInterface;
begin
result := FMyInterfaceA;
end;
But the object version gives a compiler error with this saying that TObjectB doesn't implement the methods for the interface.
TObjectBase = class(TInterfacedObject, IMyInterface)
…
end;
TObjectA = class(TInterfacedObject, IMyInterface)
FMyObjectBase: TMyObjectBase;
property MyDelegate: TMyObjectBase read FMyObjectBase implements IMyInterface;
end;
TObjectB = class(TInterfacedObject, IMyInterface)
FMyObjectA: TObjectA;
property MyDelegate2: TObjectA read FMyObjectA implements IMyInterface;
end;
So if you want to start chaining the delegation then you need to stick to interfaces or work around it another way.
tl;dr This is all by design – it's just that the design changes between XE2 and XE3.
XE3 and later
There is quite a difference between delegation to an interface type property and delegation to a class type property. Indeed the documentation calls out this difference explicitly with different sections for the two delegation variants.
The difference from your perspective is as follows:
When TObjectA implements IInterfaceY by delegating to class type property CC, the implementing object is the instance of TObjectA.
When TObjectA implements IInterfaceZ by delegating to interface type property BB, the implementing object is the object that implements FInterfaceB.
One key thing to realise in all this is that when you delegate to a class type property, the class that is delegated to need not implement any interfaces. So it need not implement IInterface and so need not have _AddRef and _Release methods.
To see this, modify your code's definition of TObjectC to be like so:
TObjectC = class
public
procedure DoNothing;
end;
You will see that this code compiles, runs, and behaves exactly the same way as does your version.
In fact this is ideally how you would declare a class to which an interface is delegated as a class type property. Doing it this way avoids the lifetime issues with mixing interface and class type variables.
So, let's look at your three calls to Supports:
Supports(AA, IInterfaceY, YY);
Here the implementing object is AA and so the reference count of AA is incremented.
Supports(YY, IInterfaceZ, ZZ);
Here the implementing object is the instance of TObjectB so its reference count is incremented.
Supports(ZZ, IInterfaceY, NewYY);
Here, ZZ is an interface implemented by the instance of TObjectB which does not implement IInterfaceY. Hence Supports returns False and NewYY is nil.
XE2 and earlier
The design changes between XE2 and XE3 coincide with the introduction of the mobile ARM compiler and there were many low-level changes to support ARC. Clearly some of these changes apply to the desktop compilers too.
The behavioural difference that I can find concerns delegation of interface implementation to class type properties. And specifically when the class type in question supports IInterface. In that scenario, in XE2, the reference counting is performed by the inner object. That differs from XE3 which has the reference counting performed by the outer object.
Note that for a class type that does not support IInterface, the reference counting is performed by the outer object in all versions. That makes sense since there's no way for the inner object to do it.
Here's my example code to demonstrate the difference:
{$APPTYPE CONSOLE}
uses
SysUtils;
type
Intf1 = interface
['{56FF4B9A-6296-4366-AF82-9901A5287BDC}']
procedure Foo;
end;
Intf2 = interface
['{71B0431C-DB83-49F0-B084-0095C535AFC3}']
procedure Bar;
end;
TInnerClass1 = class(TObject, Intf1)
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
procedure Foo;
end;
TInnerClass2 = class
procedure Bar;
end;
TOuterClass = class(TObject, Intf1, Intf2)
private
FInnerObj1: TInnerClass1;
FInnerObj2: TInnerClass2;
public
constructor Create;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
property InnerObj1: TInnerClass1 read FInnerObj1 implements Intf1;
property InnerObj2: TInnerClass2 read FInnerObj2 implements Intf2;
end;
function TInnerClass1.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := 0
else
Result := E_NOINTERFACE;
end;
function TInnerClass1._AddRef: Integer;
begin
Writeln('TInnerClass1._AddRef');
Result := -1;
end;
function TInnerClass1._Release: Integer;
begin
Writeln('TInnerClass1._Release');
Result := -1;
end;
procedure TInnerClass1.Foo;
begin
Writeln('Foo');
end;
procedure TInnerClass2.Bar;
begin
Writeln('Bar');
end;
constructor TOuterClass.Create;
begin
inherited;
FInnerObj1 := TInnerClass1.Create;
end;
function TOuterClass.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := 0
else
Result := E_NOINTERFACE;
end;
function TOuterClass._AddRef: Integer;
begin
Writeln('TOuterClass._AddRef');
Result := -1;
end;
function TOuterClass._Release: Integer;
begin
Writeln('TOuterClass._Release');
Result := -1;
end;
var
OuterObj: TOuterClass;
I1: Intf1;
I2: Intf2;
begin
OuterObj := TOuterClass.Create;
Supports(OuterObj, Intf1, I1);
Supports(OuterObj, Intf2, I2);
I1.Foo;
I2.Bar;
I1 := nil;
I2 := nil;
Readln;
end.
The output on XE2 is:
TInnerClass1._AddRef
TOuterClass._AddRef
Foo
Bar
TInnerClass1._Release
TOuterClass._Release
The output on XE3 is:
TOuterClass._AddRef
TOuterClass._AddRef
Foo
Bar
TOuterClass._Release
TOuterClass._Release
Discussion
Why did the design change? I cannot answer that definitively, not being privy to the decision making. However, the behaviour in XE3 feels better to me. If you declare a class type variable you would expect its lifetime to be managed as any other class type variable would be. That is, by explicit calls to destructor on the desktop compilers, and by ARC on the mobile compilers.
The behaviour of XE2 on the other hand feels inconsistent. Why should the fact that a property is used for interface implementation delegation change the way its lifetime is managed?
So, my instincts tell me that this was a design flaw, at best, in the original implementation of interface implementation delegation. The design flaw has led to confusion and lifetime management troubles over the years. The introduction to ARC forced Embarcadero to review this issue and they changed the design. My belief is that the introduction of ARC required a design change because Embarcadero have a track record of not changing behaviour unless absolutely necessary.
The paragraphs above are clearly speculation on my part, but that's the best I have to offer!
You are mixing object pointers and interface pointers, which is always a recipe for disaster. TObjectA is not incrementing the reference count of its inner objects to ensure they stay alive for its entire lifetime, and TestInterfaces() is not incrementing the reference count of AA to ensure it survives through the entire set of tests. Object pointers DO NOT participate in reference counting! You have to manage it manually, eg:
procedure TObjectA.AfterConstruction;
begin
inherited;
FObjectB := TObjectB.Create;
FObjectB._AddRef;
FObjectC := TObjectC.Create;
FObjectC._AddRef;
FObjectC.FTest := 'Testing';
end;
procedure TObjectA.BeforeDestruction;
begin
FObjectC._Release;
FObjectB._Release;
inherited;
end;
AA := TObjectA.Create;
AA._AddRef;
Needless to say, manual reference counting undermines the use of interfaces.
When dealing with interfaces, you need to either:
Disable reference counting completely to avoid premature destructions. TComponent, for instance, does exactly that.
Do EVERYTHING using interface pointers, NEVER with object pointers. This ensures proper reference counting across the board. This is generally the preferred solution.
I'm doing a simple class definition in Delphi and I wanted to use a TStringList in the class & it's constructor (so everytime you create an object, you pass it a StringList and it does some magic stuff to the StringList data, copying the string list to it's own internal string list). The problem I get is that when I try to declare what it "uses" before the class definition (so it knows how to handle the TStringList), it fails on compile. But without that, it doesn't know what a TStringList is. So it seems to be a scoping issue.
Below is a (very simplified) class definition, similar to what I'm trying to do. Can someone suggest how I can make this work and get the scoping right?
I tried adding the uses statements at the project level as well, but it still fails. I wonder what I need to do to get this right.
unit Unit_ListManager;
interface
type
TListManager = Class
private
lmList : TStringList;
procedure SetList;
published
constructor Create(AList : TStringList);
end;
implementation
uses
SysUtils,
StrUtils,
Vcl.Dialogs;
constructor TBOMManager.Create(AList : TStringList);
begin
lmList := TStringList.Create;
lmList := AListList;
end;
procedure SetPartsList(AList : TStringList);
begin
lmList := AListList;
ShowMessage('Woo hoo, got here...');
end;
end.
Kind Regards
You didn't show where exactly you were adding the unit reference, but I'm betting it was the wrong place. Take note of the additional code between interface and type.
I've also corrected your definition of the constructor, which you had placed in published instead of public. Only property items belong in the published section.
unit Unit_ListManager;
interface
uses
Classes,
SysUtils,
StrUtils,
Vcl.Dialogs;
type
TListManager = Class
private
lmList : TStringList;
procedure SetList;
public
constructor Create(AList : TStringList);
end;
implementation
constructor TListManager.Create(AList : TStringList);
begin
inherited Create; // This way, if the parent class changes, we're covered!
// lmList := TStringList.Create; This would produce a memory leak!
lmList := AListList;
end;
procedure TListManager.SetList;
begin
// You never provided an implementation for this method
end;
end.
I have an interface.
type IProgressObserver = interface(IInterface)
procedure ReportProgress(Progress:Integer);
procedure ReportError(Message:string);
end;
I have implemented the interface using a named class, as follows:
type TProgressObserver=class(TInterfacedObject, IProgressObserver)
procedure ReportProgress(Progress:Integer);
procedure ReportError(Message:string);
end;
... implementation of methods go here .....
addProgressObserver(TProgressObserver.Create);
Is it possible to create an instance of this interface without declaring a class? Something like this (imaginary) code, that would do the same thing as above:
addProgressObserver(IProgressObserver.Create()
begin
procedure ReportProgress(Progress:Integer)
begin
ShowMessage('Progress Observed!');
end
procedure ReportError(Message:string)
begin
Log(Message);
end
end;);
Delphi has anonymous procedures, but does it have anonymous classes??
I found this similar question, but it's in Java.
I am using Delphi 2010
You can get pretty anonymous, implementing the interface using anonymous methods. But you don't get actual compiler support for this, you'll have to declare all the anonymous method types yourself, then implement the actual "anonymous" class. Given your IProgressObserver interface, the implementation would look something like this:
type
// This is the interface we'll be dealing with.
IProgressObserver = interface(IInterface)
procedure ReportProgress(Progress:Integer);
procedure ReportError(Message:string);
end;
// This will help us anonymously create implementations of the IProgressObserver
// interface.
TAnonymousObserverImp = class(TInterfacedObject, IProgressObserver)
type
// Declare reference types for all the methods the interface needs.
TReportProgressProc = reference to procedure(Progress:Integer);
TReportErrorProc = reference to procedure(Message:string);
strict private
FReportProgressProc: TReportProgressProc;
FReportErrorProc: TReportErrorProc;
// Actual implementation of interface methods.
procedure ReportProgress(Progress:Integer);
procedure ReportError(Message:string);
// private constructor, so we'll forced to use the public "Construct" function
constructor Create(aReportProgressProc: TReportProgressProc; aReportErrorProc: TReportErrorProc);
public
// This takes the required anonymous methods as parameters and constructs an anonymous implementation
// of the IProgressObserver interface.
class function Construct(aReportProgressProc: TReportProgressProc; aReportErrorProc: TReportErrorProc): IProgressObserver;
end;
{ TAnonymousObserverImp }
class function TAnonymousObserverImp.Construct(
aReportProgressProc: TReportProgressProc;
aReportErrorProc: TReportErrorProc): IProgressObserver;
begin
// Call the private constructor
Result := TAnonymousObserverImp.Create(aReportProgressProc, aReportErrorProc);
end;
constructor TAnonymousObserverImp.Create(
aReportProgressProc: TReportProgressProc; aReportErrorProc: TReportErrorProc);
begin
inherited Create;
// We simply save the references for later use
FReportProgressProc := aReportProgressProc;
FReportErrorProc := aReportErrorProc;
end;
procedure TAnonymousObserverImp.ReportError(Message: string);
begin
// Delegate to anonymous method
FReportErrorProc(Message);
end;
procedure TAnonymousObserverImp.ReportProgress(Progress: Integer);
begin
// Delegate to anonymous method
FReportProgressProc(Progress);
end;
Once all that code is in place you'll be able to write code like this:
var i: IProgressObserver;
begin
i := TAnonymousObserverImp.Construct(
procedure (Progress:Integer)
begin
// Do something with Progress
end
,
procedure (Message:string)
begin
// Do something with Message
end
)
end;
Looks pretty anonymous to me! Given the implementation of anonymous methods in Delphi it's also fairly fast and effective.
Short answer I'm afraid: sorry, no, Delphi doesn't have anonymous classes.
for a framework I wrote a wrapper which takes any object, interface or record type to explore its properties or fields. The class declaration is as follows:
TWrapper<T> = class
private
FType : TRttiType;
FInstance : Pointer;
{...}
public
constructor Create (var Data : T);
end;
In the constructor I try to get the type information for further processing steps.
constructor TWrapper<T>.Create (var Data : T);
begin
FType := RttiCtx.GetType (TypeInfo (T));
if FType.TypeKind = tkClass then
FInstance := TObject (Data)
else if FType.TypeKind = tkRecord then
FInstance := #Data
else if FType.TypeKind = tkInterface then
begin
FType := RttiCtx.GetType (TObject (Data).ClassInfo); //<---access violation
FInstance := TObject (Data);
end
else
raise Exception.Create ('Unsupported type');
end;
I wonder if this access violation is a bug in delphi compiler (I'm using XE).
After further investigation I wrote a simple test function, which shows, that asking for the class name produces this exception as well:
procedure TestForm.FormShow (Sender : TObject);
var
TestIntf : IInterface;
begin
TestIntf := TInterfacedObject.Create;
OutputDebugString(PChar (TObject (TestIntf).ClassName)); //Output: TInterfacedObject
Test <IInterface> (TestIntf);
end;
procedure TestForm.Test <T> (var Data : T);
begin
OutputDebugString(PChar (TObject (Data).ClassName)); //access violation
end;
Can someone explain me, what is wrong? I also tried the procedure without a var parameter which did not work either. When using a non generic procedure everything works fine, but to simplify the use of the wrapper the generic solution would be nice, because it works for objects and records the same way.
Kind regards,
Christian
Your code contains two wrong assumptions:
That you can obtain meaningful RTTI from Interfaces. Oops, you can get RTTI from interface types.
That a Interface is always implemented by a Delphi object (hence your attempt to extract the RTTI from the backing Delphi object).
Both assumptions are wrong. Interfaces are very simple VIRTUAL METHOD tables, very little magic to them. Since an interface is so narrowly defined, it can't possibly have RTTI. Unless of course you implement your own variant of RTTI, and you shouldn't. LE: The interface itself can't carry type information the way an TObject does, but the TypeOf() operator can get TypeInfo if provided with a IInterface
Your second assumption is also wrong, but less so. In the Delphi world most interfaces will be implemented by Delphi objects, unless of course you obtain the interface from a DLL written in an other programming language: Delphi's interfaces are COM-compatible, so it's implementations can be consumed from any other COM-compatible language and vice versa. But since we're talking Delphi XE here, you can use this syntax to cast an interface to it's implementing object in an intuitive and readable way:
TObject := IInterface as TObject;
that is, use the as operator. Delphi XE will at times automagically convert a hard cast of this type:
TObject := TObject(IInterface);
to the mentioned "as" syntax, but I don't like this magic because it looks very counter-intuitive and behaves differently in older versions of Delphi.
Casting the Interface back to it's implementing object is also wrong from an other perspective: It would show all the properties of the implementing object, not only those related to the interface, and that's very wrong, because you're using Interfaces to hide those implementation details in the first place!
Example: Interface implementation not backed by Delphi object
Just for fun, here's a quick demo of an interface that's not backed by an Delphi object. Since an Interface is nothing but an pointer to a virtual method table, I'll construct the virtual method table, create a pointer to it and cast the the pointer to the desired Interface type. All method pointers in my fake Virtual Method table are implemented using global functions and procedures. Just imagine trying to extract RTTI from my i2 interface!
program Project26;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
// This is the interface I will implement without using TObject
ITestInterface = interface
['{CFC4942D-D8A3-4C81-BB5C-6127B569433A}']
procedure WriteYourName;
end;
// This is a sample, sane implementation of the interface using an
// TInterfacedObject method
TSaneImplementation = class(TInterfacedObject, ITestInterface)
public
procedure WriteYourName;
end;
// I'll use this record to construct the Virtual Method Table. I could use a simple
// array, but selected to use the record to make it easier to see. In other words,
// the record is only used for grouping.
TAbnormalImplementation_VMT = record
QueryInterface: Pointer;
AddRef: Pointer;
ReleaseRef: Pointer;
WriteYourName: Pointer;
end;
// This is the object-based implementation of WriteYourName
procedure TSaneImplementation.WriteYourName;
begin
Writeln('I am the sane interface implementation');
end;
// This will implement QueryInterfce for my fake IInterface implementation. All the code does
// is say the requested interface is not supported!
function FakeQueryInterface(const Self:Pointer; const IID: TGUID; out Obj): HResult; stdcall;
begin
Result := S_FALSE;
end;
// This will handle reference counting for my interface. I am not using true reference counting
// since there is no memory to be freed, si I am simply returning -1
function DummyRefCounting(const Self:Pointer): Integer; stdcall;
begin
Result := -1;
end;
// This is the implementation of WriteYourName for my fake interface.
procedure FakeWriteYourName(const Self:Pointer);
begin
WriteLn('I am the very FAKE interface implementation');
end;
var i1, i2: ITestInterface;
R: TAbnormalImplementation_VMT;
PR: Pointer;
begin
// Instantiate the sane implementation
i1 := TSaneImplementation.Create;
// Instantiate the very wrong implementation
R.QueryInterface := #FakeQueryInterface;
R.AddRef := #DummyRefCounting;
R.ReleaseRef := #DummyRefCounting;
R.WriteYourName := #FakeWriteYourName;
PR := #R;
i2 := ITestInterface(#PR);
// As far as all the code using ITestInterface is concerned, there is no difference
// between "i1" and "i2": they are just two interface implementations.
i1.WriteYourName; // Calls the sane implementation
i2.WriteYourName; // Calls my special implementation of the interface
WriteLn('Press ENTER to EXIT');
ReadLn;
end.
Two possible answers.
If this always happens, even when T is an object, then it's a compiler error and you ought to file a QC report about it. (With Interfaces, the cast-an-interface-to-an-object thing requires some black magic from the compiler, and it's possible that the generics subsystem doesn't implement it properly.)
If you're taking a T that's not an object, though, such as a record type, and getting this error, then everything's working as designed; you're just using typecasts improperly.
Either way, there's a way to get RTTI information out of any arbitrary type. You know how TRttiContext.GetType has two overloads? Use the other one. Instead of calling GetType (TObject (Data).ClassInfo), try calling GetType(TypeInfo(Data)).
Oh, and declare FInstance as a T instead of a pointer. It'll save you a lot of hassle.