I have set up a pointer which I want to point to a component but the component it points to won't be the same one every time the procedure is called which it is simply declared as a 'Pointer'. Here is the code where the pointer is pointed to a component.
Procedure DestroyConnection(Component,ID,Connections:Integer);
Var
ComponentPtr: Pointer;
begin
if Component = 1 then
ComponentPtr := Cell;
if Component = 2 then
ComponentPtr := Bulb;
And here is the code where the pointer is reused.
Procedure DestroyLink(Ptr:Pointer; ID:Integer);
var
Component: ^TObject;
begin
Component := Ptr;
Component.Connected := False;
I get an undeclared identifier error on the line:
Component.Connected := False;
How would I be able to access the component that the pointer points to in the procedure DestroyLink?
Sorry if I'm not making much sense :S
Your variable Component is a pointer to TObject. And since TObject does not have a member named Connected, that is why the compiler objects.
What's more, you have one level of indirection too many. A variable of type TObject, or indeed any Delphi class is already a reference. It is already a pointer. Which is why your assignment to ComponentPtr does not use the # operator. It doesn't need to take the address since the reference already is an address.
You need to change DestroyLink to match. You need a variable that is not a pointer to a reference, but a variable of whatever the actual type of the object is. For example, suppose the type that defined the Connected property was TMyComponent then your code should be:
var
Component: TMyComponent;
....
Component := TMyComponent(Ptr);
Component.Connected := False;
Or even simpler would be to change the type of the variable from Pointer to TObject. And then pass around TObject instead of Pointer. Then your code could read:
Procedure DestroyConnection(Component,ID,Connections:Integer);
Var
Obj: TObject;
begin
case Component of
1:
Obj := Cell;
2:
Obj := Bulb;
....
And then:
procedure DoSomethingWithObject(Obj: TObject);
begin
if Obj is TCell then
TCell(Obj).Connected := False;
if Obj is TBulb then
TBulb(Obj).SomeOtherProperty := SomeValue;
end;
If you had a common base class for all of these objects then you could declare your variable to be of that type. And you could then use virtual functions and polymorphism which I think would lead to much simpler and clearer code.
Related
In my program I do:
var aObj: Tobject;
var aObjClassType: Tclass;
....
aObjClassType := aObj.ClassType;
....
aObj.free;
aObj := nil;
....
showmessage(aObjClassType.Classname);
this work but I m not quite sure If this is correct, especially when i read the function TObject.ClassType
function TObject.ClassType: TClass;
begin
Pointer(Result) := PPointer(Self)^;
end;
So does freeing aObj will not also free the aObjClassType ?
A TClass is a class. A TObject is an instance. So obj.ClassType returns the class, that is the type, of the instance obj.
Note that this is the runtime type of the instance rather than the type of the obj reference variable. This is relevant when using polymorphism. So if you write
var
shape: TShape;
....
shape := TSquare.Create;
Then shape.ClassType returns TSquare even though the shape variable is TShape.
So does freeing aObj will not also free the aObjClassType?
No. Classes are static and created when the module loads and destroyed when the module unloads.
For more detail read the documentation: http://docwiki.embarcadero.com/RADStudio/en/Classes_and_Objects_(Delphi)#TObject_and_TClass
There is method:
function Test.get_Param(out a : BOOL): HRESULT; stdcall;
begin
a := b;
Result := T_Result;
end;
Now the exception happening on a := b; , happening Access violation Exception.
Ofcourse I can try and catch it. but I don't want to do that....
So Is there any way can determine use some way and skip the assignment. like:
if (! now I know it will happening that Exception){
a := b; // so I can skip
}
Result := T_Result;
Maybe it's very easy, but because I don't know use delphi, So hope your guys can help me. thanks.
Update1:
b: Boolean;//Some friend need to know what is the b param type.
Update2:
I'm try to use :
if b<> nil then Enabled := b;
but I can't build it , it will display: E2008 Incompatible types
Update3:
I'm trying to debug it, and when I'm debug, on the Local variables panel display:
a Inaccessible value
I'm use .NET called it. there is metadata:
bool get_Param{ [param: In, MarshalAs(UnmanagedType.Bool)] [PreserveSig] set; }
actually I'm not use .NET access it. I'm use .NET access a DirectShow filter, and the directshow filter is current method(write by delphi)
Update4:
this is partial C# code
[ComImport, InterfaceType(ComInterfaceType.InterfaceIsIUnknown), SuppressUnmanagedCodeSecurity, Guid("hidden")]
public interface IDCDSPFilterInterface{
bool get_Param{ [param: In, MarshalAs(UnmanagedType.Bool)] [PreserveSig] set; }
.. hidden other ..
}}
I'm try to use :
if b<> nil then Enabled := b;
but I can't build it , it will display: E2008 Incompatible types
Pointer variables are ABC of Pascal. http://en.wikipedia.org/wiki/Pascal_(programming_language)#Pointer_types
So the proper way to write that check would be
function Test.get_Param(out a : BOOL): HRESULT; stdcall;
var ptr: ^BOOL;
begin
ptr := #a;
if nil = ptr then ....
a := b;
Result := T_Result;
end;
That is the basic question to you explicit questions.
Now, in reality that check does not help. It would only protect your from nil/NULL pointers, but that is not what probably happens. What happens is probably a random garbage pointer instead of nil. Due to error in the calling code.
Again, you can check that via var ptr: Pointer {untyped}; ptr := #Self; if ptr = nil then ... or just if nil <> Self or just if Assigned(Self) - but that would only protect you from NIL pointers, not from RANDOM GARBAGE pointers.
More so, i think that actual garbage is not in pointer to the variable a, but to the pointer to Self and b being a member of TEST classm, thus the real statement is a := Self.b;.
Since you use stdcall i think you're trying to make a DLL for using from an EXE made in a in non-Delphi language. Most probably you either made a wrong definition for function in that client app code. Actually, you just can make a proper declaration is you Test is a class. You only can make a proper if get_Param is a method of RECORD Test or perhaps if it is STATIC CLASS method of Test class. So the proper way to write your function would be like following
function Test.get_Param(out a : BOOL): HRESULT;
begin
a := b;
Result := T_Result;
end;
function DLL_get_Param(const TestObject: pointer; out a : BOOL): HRESULT; stdcall;
var MyTest: Test;
begin
pointer(MyTest) := TestObject;
Result := MyTest.DLL_get_Param(a);
end;
export DLL_get_Param;
Read Delphi documentation what you can get/put to/from DLL functions.
Integers, floats, pointers, IInterface. You cannot pass into DLL complex and behaving objects like stings, dynamic arrays, object instances. And since you cannot pass an object instance, you cannot pass a Self variable and you cannot call a method.
One very expensive way to catch it would be like
{global} var TestInstances: TList;
type
TEST = class...
procedure AfterConstructon; override;
procedure BeforeConstructon; override;
....
procedure Test.AfterConstructon;
begin
inherited;
TestInstances.Add(Self); // single-thread assumption here
end;
procedure Test.BeforeConstructon;
begin
TestInstances.Remove(Self); // single-thread assumption here
inherited;
end;
function Test.get_Param(out a : BOOL): HRESULT; stdcall;
begin
if not ( TestInstances.IndexOf(Self) >= 0 {found!} ) // single-thread assumption here
then ... WTF ???
...
....
initialization
TestInstances := TList.Create;
finalization
TestInstances.Free;
end;
If your DLL can be used by multi-threaded application you should also wrap the marked calls into http://docwiki.embarcadero.com/Libraries/XE2/en/System.SyncObjs.TCriticalSection
There is a gross mismatch across the two sides of your interop boundary. Your Delphi function does not match the C# declaration.
The solution is not to test for parameter validity. Your Delphi code, given the declaration of the function in the question, is correct. The solution is to make both sides of the interop boundary match. I cannot tell you more than that until you show both sides of the interop boundary.
Since I can't see where you've decalred b, I'm going to assume it's a member of Test.
So one strong possibility is that you have an invalid instance of Test, and you get an Access Violation trying to read b in order to assign it to a. As an example the following use of get_Param would raise an exception.
var
LTest: Test;
LA: Boolean;
begin
LTest := nil;
LTest.get_Param(LA);
end;
The point is that you need a valid instance of Test in order to use it. E.g.
var
LTest: Test;
LA: Boolean;
begin
LTest := Test.Create;
try
LTest.get_Param(LA);
finally
LTest.Free;
end;
end;
I have a record that looks like:
TBigint = record
PtrDigits: Pointer; <-- The data is somewhere else.
Size: Byte;
MSB: Byte;
Sign: Shortint;
...
class operator Implicit(a: TBigint): TBigint; <<-- is this allowed?
....
The code is pre-class operator legacy code, but I want to add operators.
I know the data should really be stored in a dynamic array of byte, but I do not want to change the code, because all the meat is in x86-assembly.
I want to following code to trigger the class operator at the bottom:
procedure test(a: TBignum);
var b: TBignum;
begin
b:= a; <<-- naive copy will tangle up the `PtrDigit` pointers.
....
If I add the implicit typecast to itself, will the following code be executed?
class operator TBigint.Implicit(a: TBigint): TBigint;
begin
sdpBigint.CreateBigint(Result, a.Size);
sdpBigint.CopyBigint(a, Result);
end;
(Will test and add the answer if it works as I expect).
My first answer attempts to dissuade against the idea of overriding the assignment operator. I still stand by that answer, because many of the problems to be encountered are better solved with objects.
However, David quite rightly pointed out that TBigInt is implemented as a record to leverage operator overloads. I.e. a := b + c;. This is a very good reason to stick with a record based implementation.
Hence, I propose this alternative solution that kills two birds with one stone:
It removes the memory management risks explained in my other answer.
And provides a simple mechanism to implement Copy-on-Write semantics.
(I do still recommend that unless there's a very good reason to retain a record based solution, consider switching to an object based solution.)
The general idea is as follows:
Define an interface to represent the BigInt data. (This can initially be minimalist and support only control of the pointer - as in my example. This would make the initial conversion of existing code easier.)
Define an implementation of the above interface which will be used by the TBigInt record.
The interface solves the first problem, because interfaces are a managed type; and Delphi will dereference the interface when a record goes out of scope. Hence, the underlying object will destroy itself when no longer needed.
The interface also provides the opportunity to solve the second problem, because we can check the RefCount to know whether we should Copy-On-Write.
Note that long term it might prove beneficial to move some of the BigInt implementation from the record to the class & interface.
The following code is trimmed-down "big int" implementation purely to illustrate the concepts. (I.e. The "big" integer is limited to a regular 32-bit number, and only addition has been implemented.)
type
IBigInt = interface
['{1628BA6F-FA21-41B5-81C7-71C336B80A6B}']
function GetData: Pointer;
function GetSize: Integer;
procedure Realloc(ASize: Integer);
function RefCount: Integer;
end;
type
TBigIntImpl = class(TInterfacedObject, IBigInt)
private
FData: Pointer;
FSize: Integer;
protected
{IBigInt}
function GetData: Pointer;
function GetSize: Integer;
procedure Realloc(ASize: Integer);
function RefCount: Integer;
public
constructor CreateCopy(ASource: IBigInt);
destructor Destroy; override;
end;
type
TBigInt = record
PtrDigits: IBigInt;
constructor CreateFromInt(AValue: Integer);
class operator Implicit(AValue: TBigInt): Integer;
class operator Add(AValue1, AValue2: TBigInt): TBigInt;
procedure Add(AValue: Integer);
strict private
procedure CopyOnWriteSharedData;
end;
{ TBigIntImpl }
constructor TBigIntImpl.CreateCopy(ASource: IBigInt);
begin
Realloc(ASource.GetSize);
Move(ASource.GetData^, FData^, FSize);
end;
destructor TBigIntImpl.Destroy;
begin
FreeMem(FData);
inherited;
end;
function TBigIntImpl.GetData: Pointer;
begin
Result := FData;
end;
function TBigIntImpl.GetSize: Integer;
begin
Result := FSize;
end;
procedure TBigIntImpl.Realloc(ASize: Integer);
begin
ReallocMem(FData, ASize);
FSize := ASize;
end;
function TBigIntImpl.RefCount: Integer;
begin
Result := FRefCount;
end;
{ TBigInt }
class operator TBigInt.Add(AValue1, AValue2: TBigInt): TBigInt;
var
LSum: Integer;
begin
LSum := Integer(AValue1) + Integer(AValue2);
Result.CreateFromInt(LSum);
end;
procedure TBigInt.Add(AValue: Integer);
begin
CopyOnWriteSharedData;
PInteger(PtrDigits.GetData)^ := PInteger(PtrDigits.GetData)^ + AValue;
end;
procedure TBigInt.CopyOnWriteSharedData;
begin
if PtrDigits.RefCount > 1 then
begin
PtrDigits := TBigIntImpl.CreateCopy(PtrDigits);
end;
end;
constructor TBigInt.CreateFromInt(AValue: Integer);
begin
PtrDigits := TBigIntImpl.Create;
PtrDigits.Realloc(SizeOf(Integer));
PInteger(PtrDigits.GetData)^ := AValue;
end;
class operator TBigInt.Implicit(AValue: TBigInt): Integer;
begin
Result := PInteger(AValue.PtrDigits.GetData)^;
end;
The following tests were written as I built up the proposed solution. They prove: some basic functionality, that the copy-on-write works as expected, and that there are no memory leaks.
procedure TTestCopyOnWrite.TestCreateFromInt;
var
LBigInt: TBigInt;
begin
LBigInt.CreateFromInt(123);
CheckEquals(123, LBigInt);
//Dispose(PInteger(LBigInt.PtrDigits)); //I only needed this until I
//started using the interface
end;
procedure TTestCopyOnWrite.TestAssignment;
var
LValue1: TBigInt;
LValue2: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue2 := LValue1;
CheckEquals(123, LValue2);
end;
procedure TTestCopyOnWrite.TestAddMethod;
var
LValue1: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue1.Add(111);
CheckEquals(234, LValue1);
end;
procedure TTestCopyOnWrite.TestOperatorAdd;
var
LValue1: TBigInt;
LValue2: TBigInt;
LActualResult: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue2.CreateFromInt(111);
LActualResult := LValue1 + LValue2;
CheckEquals(234, LActualResult);
end;
procedure TTestCopyOnWrite.TestCopyOnWrite;
var
LValue1: TBigInt;
LValue2: TBigInt;
begin
LValue1.CreateFromInt(123);
LValue2 := LValue1;
LValue1.Add(111); { If CopyOnWrite, then LValue2 should not change }
CheckEquals(234, LValue1);
CheckEquals(123, LValue2);
end;
Edit
Added a test demonstrating use of TBigInt as value parameter to a procedure.
procedure TTestCopyOnWrite.TestValueParameter;
procedure CheckValueParameter(ABigInt: TBigInt);
begin
CheckEquals(2, ABigInt.PtrDigits.RefCount);
CheckEquals(123, ABigInt);
ABigInt.Add(111);
CheckEquals(234, ABigInt);
CheckEquals(1, ABigInt.PtrDigits.RefCount);
end;
var
LValue: TBigInt;
begin
LValue.CreateFromInt(123);
CheckValueParameter(LValue);
end;
There is nothing in Delphi that allows you to hook into the assignment process. Delphi has nothing like C++ copy constructors.
Your requirements, are that:
You need a reference to the data, since it is of variable length.
You also have a need for value semantics.
The only types that meet both of those requirements are the native Delphi string types. They are implemented as a reference. But the copy-on-write behaviour that they have gives them value semantics. Since you want an array of bytes, AnsiString is the string type that meets your needs.
Another option would be to simply make your type be immutable. That would let you stop worrying about copying references since the referenced data could never be modified.
It seems to me your TBigInt should be a class rather than a record. Because you're concerned about PtrDigits being tangled up, it sounds like you're needing extra memory management for what the pointer references. Since records don't support destructors there's no automatic management of that memory. Also if you simply declare a variable of TBigInt, but don't call the CreatBigInt constructor, the memory is not correctly initialised. Again, this is because you cannot override a record's default parameterless constructor.
Basically you have to always remember what has been allocated for the record and remember to manually deallocate. Sure you can have a deallocate procedure on the record to help in this regard, but you still have to remember to call it in the correct places.
However that said, you could implement an explicit Copy function, and add an item to your code-review checklist that TBitInt has been copied correctly. Unfortunately you'll have to be very careful with the implied copies such as passing the record via a value parameter to another routine.
The following code illustrates an example conceptually similar to your needs and demonstrates how the CreateCopy function "untangles" the pointer. It also highlights some of the memory management problems that crop up, which is why records are probably not a good way to go.
type
TMyRec = record
A: PInteger;
function CreateCopy: TMyRec;
end;
function TMyRec.CreateCopy: TMyRec;
begin
New(Result.A);
Result.A^ := A^;
end;
var
R1, R2: TMyRec;
begin
New(R1.A); { I have to manually allocate memory for the pointer
before I can use the reocrd properly.
Even if I implement a record constructor to assist, I
still have to remember to call it. }
R1.A^ := 1;
R2 := R1;
R2.A^ := 2; //also changes R1.A^ because pointer is the same (or "tangled")
Writeln(R1.A^);
R2 := R1.CreateCopy;
R2.A^ := 3; //Now R1.A is different pointer so R1.A^ is unchanged
Writeln(R1.A^);
Dispose(R1.A);
Dispose(R2.A); { <-- Note that I have to remember to Dispose the additional
pointer that was allocated in CreateCopy }
end;
In a nutshell, it seems you're trying to sledgehammer records into doing things they're not really suited to doing.
They are great at making exact copies. They have simple memory management: Declare a record variable, and all memory is allocated. Variable goes out of scope and all memory is deallocated.
Edit
An example of how overriding the assignment operator can cause a memory leak.
var
LBigInt: TBigInt;
begin
LBigInt.SetValue(123);
WriteBigInt(LBigInt); { Passing the value by reference or by value depends
on how WriteBigInt is declared. }
end;
procedure WriteBigInt(ABigInt: TBigInt);
//ABigInt is a value parameter.
//This means it will be copied.
//It must use the overridden assignment operator,
// otherwise the point of the override is defeated.
begin
Writeln('The value is: ', ABigInt.ToString);
end;
//If the assignment overload allocated memory, this is the only place where an
//appropriate reference exists to deallocate.
//However, the very last thing you want to do is have method like this calling
//a cleanup routine to deallocate the memory....
//Not only would this litter your code with extra calls to accommodate a
//problematic design, would also create a risk that a simple change to taking
//ABigInt as a const parameter could suddenly lead to Access Violations.
What is the difference between
TFuncOfIntToString = reference to function(x: Integer): string;
and
TFuncOfIntToString = function(x: Integer): string of object;
I use the of object
Let us consider the following three type declarations:
TProcedure = procedure;
TMethod = procedure of object;
TAnonMethod = reference to procedure;
These are all very similar to each other. In terms of calling instances of each of these three types, the calling code is identical. The differences arise in what can be assigned to variables of these types.
Procedural types
TProcedure is a procedural type. You can assign to a variable of type TProcedure something of this form:
procedure MyProcedure;
begin
end;
This is a non object-oriented procedure. You cannot assign an instance or class method to a TProcedure variable. However, you can assign a static class method to a TProcedure variable.
Method pointers
TMethod is a method pointer. This is indicated by the presence of of object. When you have a variable of type TMethod you must assign either:
A instance method of an instantiated object, or
A class method.
So you can assign either of these:
procedure TMyClass.MyMethod;
begin
end;
class procedure TMyClass.MyClassMethod;
begin
end;
The big difference between a procedural type and a method pointer is that the latter contains a reference to both code and data. A method pointer is often known as a two-pointer procedural type. A variable that contains a method pointer contains references to the code and the instance/class to call it on.
Consider the following code:
var
instance1, instance2: TMyClass;
method1, method2: TMethod;
....
method1 := instance1.MyMethod;
method2 := instance2.MyMethod;
Now, although method1 and method2 refer to the same piece of code, they are associated with different object instances. So, if we call
method1();
method2();
We are invoking MyMethod on the two distinct instances. That code is equivalent to:
instance1.MyMethod();
instance2.MyMethod();
Anonymous methods
Finally we come to anonymous methods. These are even more general purpose than procedural types and method pointers. You can assign any of the following to a variable defined using the reference to syntax:
A plain non object-oriented procedure.
An instance method of an instantiated class.
A class method.
An anonymous method.
For example:
var
AnonMethod: TAnonMethod;
....
AnonMethod := MyProcedure; // item 1 above
AnonMethod := instance1.MyMethod; // item 2
AnonMethod := TMyClass.MyClassMethod; // item 3
Anonymous methods, item 4 above, are those declared in-line in your code. For example:
var
AnonMethod: TAnonMethod;
....
AnonMethod := procedure
begin
DoSomething;
end;
The biggest benefit of anonymous methods when compared to the procedural types and method pointers is that they allow for variable capture. For example consider the following short program to illustrate:
{$APPTYPE CONSOLE}
program VariableCapture;
type
TMyFunc = reference to function(X: Integer): Integer;
function MakeFunc(Y: Integer): TMyFunc;
begin
Result := function(X: Integer): Integer
begin
Result := X*Y;
end;
end;
var
func1, func2: TMyFunc;
begin
func1 := MakeFunc(3);
func2 := MakeFunc(-42);
Writeln(func1(4));
Writeln(func2(2));
Readln;
end.
This has the following output:
12
-84
The first is anonymous method, the second is ordinary method.
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.