Preface, it seems i failed to say it clear. I want to enumerate, read and set, all the class var or class properties of a given TClass variable.
There is no problem in finding TClass - it is passed.
There is no problem in filtering by presence of given attribute.
There problem is that RTTI just misses the way to enumerate class fields rather than instance fields.
I wanted to make a declarative DLL Loader. Since the DLLs are process-global in windows (you cannot load the same DLL twice) it corresponds to class-level fields or properties rather than to instant-level ones.
So i thought something like LoadDLL(filename:string; funtions: TClass) and use attributes to specify which entry points to fetch.
Then i run into the wall: while there is TRttiClassRefType in Delphi - one just cannot get it by given instance or whatever: TRTTIContext.GetType(Class) returns context for instances, rather than for metatypes.
Enumerating all the metatypes until the needed one got by name is... ugly. And fragile. And slow. Though it seems to be the only real code snippet containing TRttiClassRefType that i can find.
So - is there a way i can get and set class-level variables or properties, finding them, by some custom attribute attached ?
The following test program only finds IV and IP, and skips CV and CP...
program Project19;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, RTTI;
type
DLL_Info = class (TCustomAttribute) end;
{$M+} {$RTTI EXPLICIT FIELDS ([vcPublic]) PROPERTIES ([vcPublic])}
DLL_Functions = class
public
[DLL_Info] var IV: pointer; // type is just stub
[DLL_Info] class var CV: pointer;
[DLL_Info] property IP: pointer read IV;
[DLL_Info] class property CP: pointer read CV;
end;
{$M-}
var df: DLL_Functions;
procedure SetDLLFunctions;
var
LContext: TRttiContext;
LType: TRttiType;
LVar: TRttiField;
LProp: TRttiProperty;
LAttr: TCustomAttribute;
DLL_fn_Entry, DLL_fn_Optional: boolean;
DLL_fn_Name: string;
fn_ptr: Pointer;
begin
LContext := TRttiContext.Create;
try
LType := LContext.GetType(DLL_Functions);
for LVar in LType.GetFields do begin
Writeln(Lvar.Name);
end;
for LProp in LType.GetProperties do begin
Writeln(LProp.Name);
end;
finally
LContext.Free;
end;
end;
begin
try
df := DLL_Functions.Create;
df.IV := #SetDLLFunctions; // imitating DLL quering by GetProcAddress
df.CV := #SetDLLFunctions;
SetDLLFunctions;
df.Destroy;
ReadLn;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Some possible workarounds:
Using record to enlist entrypoints would require passing TWO pointers: the record itself and TypeInfo. Which is redundant and can potentially get incoherent.
Creating class instances just to hold static pointers would be one extra level of indirection when calling, and would be a redundant entity to keep track of.
Related
I have a class defined which contains only strings as properties, and I need to get the property name based on its value as in the example below. In the example there are only 3 properties, in the real life class there are almost 1000. The problem is that this class is heavily used, and I want to know if I can get the property name by its value in a faster way.
unit Unit5;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,RTTI, StdCtrls, Diagnostics;
type
TConstDBElem = class
public
CCFN_1 : String;
CCFN_2 : String;
CCFN_3 : String;
constructor Create;
end;
TForm5 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;
var
Form5: TForm5;
Obj: TConstDBElem;
implementation
{$R *.dfm}
procedure TForm5.Button1Click(Sender: TObject);
var iPos:Integer;
timer:TStopwatch;
Function GetName(const DBElemInstance : TConstDBElem; valueName: string) : string;
var
vrttiContext: TRttiContext;
vrttiField : TRttiField;
vType : TRttiType;
begin
vType := vrttiContext.GetType(TConstDBElem);
for vrttiField in vType.GetFields do
if (vrttiField.GetValue(DBElemInstance).ToString = valueName) then
begin
result := vrttiField.Name;
end;
end;
begin
timer := TStopwatch.Create;
timer.Start;
Memo1.Lines.Clear;
for iPos := 0 to 100000 do
GetName(Obj,'TEST3');
timer.Stop;
Memo1.Lines.Add(FloatToStr(timer.Elapsed.TotalSeconds));
end;
constructor TConstDBElem.Create;
begin
CCFN_1 := 'TEST1';
CCFN_2 := 'TEST2';
CCFN_3 := 'TEST3' ;
end;
initialization
Obj := TConstDBElem.Create;
finalization
Obj.Free;
end.
Yes,I know this is a very bad design, and this should not be done like this. Is there any option to make this search faster?
When GetName() finds a match, it is not stopping its loop, so it keeps searching for more matches. Assigning a function's Result does not exit the function, like you clearly think it does. As such, GetName() ends up returning the last match, not the first match. The loop should be calling Exit when it finds the first match:
Function GetName(const DBElemInstance : TConstDBElem; valueName: string) : string;
var
vrttiContext: TRttiContext;
vrttiField : TRttiField;
vType : TRttiType;
begin
vType := vrttiContext.GetType(TConstDBElem);
for vrttiField in vType.GetFields do
if (vrttiField.GetValue(DBElemInstance).ToString = valueName) then
begin
result := vrttiField.Name;
Exit; // <-- add this
end;
end;
Alternatively, use the version of Exit() that takes a parameter:
Function GetName(const DBElemInstance : TConstDBElem; valueName: string) : string;
var
vrttiContext: TRttiContext;
vrttiField : TRttiField;
vType : TRttiType;
begin
vType := vrttiContext.GetType(TConstDBElem);
for vrttiField in vType.GetFields do
if (vrttiField.GetValue(DBElemInstance).ToString = valueName) then
begin
Exit(vrttiField.Name); // <-- assigns Result and exits at the same time
end;
end;
In your simple example, the time wasted to search 3 fields is hardly noticeable, but when searching 1000 fields, it makes a difference.
You state in a comment that the values never change at runtime. In which case you can simply build a single dictionary at startup that has the property values as the dictionary key, and the property name as the dictionary value.
I'm assuming that all instances of the class have the same property values. If that's not the case then you'll need one dictionary per instance.
It's a "bad design" because someone wrote a class that they're treating like a C-style Struct. As has been said already, there are NO PROPERTIES defined in the class, just a bunch of PUBLIC DATA MEMBERS, aka, "fields".
There's no encapsulation, so anything you do to change the structure could have far-reaching implications on any unit that uses this. I agree that replacing the IMPLEMENTATION with a TStringList or a TDictionary would be smart, but ... there are no interfaces to adhere to! You have 1000-odd hard-wired references to public data members.
(The last time I saw something like this was some code written by a bunch of VB programmers who wrote classes as if they were C-style structs containing public data members, and then they wrote external functions to access the data, just as you'd do in C. Only they buried business logic inside of the accessor methods as well, which causes random pieces of the code to make direct references to the data members of the class.)
Off-hand, I'd say you're totally mis-using the RTTI code. Sure, the optimizations above will improve performance, but so what? It's the wrong solution!
If you really want to refactor this (and you certainly should!), first I'd look to see how widespread the use of this poor class is by changing the public to private and see how many errors you get.
Then I'd derive it from TStringList, delete all of the local fields, and move the GetName function inside of the class:
type
TConstDBElem = class( TStringList )
public
constructor Create;
function GetName( aName : string ) : string;
end;
Now, if I'm interpreting your example correctly, you want to do this to initialize the object:
constructor TConstDBElem.Create;
begin
Add( 'TEST1=CCFN_1' );
Add( 'TEST2=CCFN_2' );
Add( 'TEST3=CCFN_3' );
end;
Then replace all of the references in other units with a call to obj.GetName():
function TConstDBElem.GetName( aName : string ) : string;
begin
Result := Values[aName];
end;
You're replacing a reference to obj.CCFN_1 (?) or GetName(obj,'TEST1') with obj.GetName('TEST1').
(Maybe I'm totally off-base at this point. Sorry, but I just don't get how you're using this class from the example, and it doesn't make a whole lot of sense to me anyway. It would make more sense if you said what you're mapping between. I mean ... who needs to look up a local field name from a value associated with it? And what do you do with it once you've found it? Whomever wrote this had to go through some incredible contortions to make the code work because s/he sure didn't understand OOP when this was designed!)
At this point, you will have succeeded in decoupling the clients of this class (other units) from its internal implementation, and replacing those references with calls to an interface (a method) defined in the class instead.
Then you can do some testing to see what happens if you change the implementation, like from a TStringList to a TDictionary. But no matter how you slice it, I cannot imagine that either the TStringList or TDictionary will be slower than how you're abusing the RTTI system in your example. :)
I got strings in database like 'TGroupBox' or 'TEdit' ... now I need to check element against them... how do I enumerate string to type?
I mean something like this:
mystr := 'TGroupBox';
If (page.Controls[0] is mystr) then ...
Of course it won't work, as error appears:
E2015 Operator not applicable to this operand type
How do I do that correctly?
You can verify that
page.Controls[0].ClassName = mystr
using the ClassName property.
But notice that this doesn't do exactly the same thing as the is operator. To see the difference, suppose you have a class TFruit and a subclass TApple. If myFruit is an instance of a TApple, then both myFruit is TApple and myFruit is TFruit will yield true. But of course, the ClassName will still only be TApple.
If you need the full functionality of the is operator, you can make use of the ClassParent property, as suggested by hvd:
function IsDerivedFrom(AClass: TClass; const AClassName: string): boolean;
begin
if not Assigned(AClass) then Exit(false);
result := SameText(AClass.ClassName, AClassName) or
IsDerivedFrom(AClass.ClassParent, AClassName);
end;
To get the class of an object, use the ClassType property:
IsDerivedFrom(page.Controls[0].ClassType, mystr);
The function you are looking for is GetClass located in System.Classes. Be aware that the class has to be registered.
System.Classes.GetClass
For the specific scenario in the question body the answer by Andreas Rejbrand (with assistance from hvd) is a good one. However, for the broader problem implied by the question title - how to I convert a string containing a class name to a class reference? - you can utilise extended RTTI in a new(ish) version of Delphi:
unit ClassLookupUtils;
interface
uses
System.SysUtils, System.Generics.Collections, System.Rtti;
type
RttiClassLookup = record
strict private
class var FMap: TDictionary<string, TClass>;
class destructor Destroy;
public
class function Find(const ClassName: string): TClass; static;
end;
implementation
class destructor RttiClassLookup.Destroy;
begin
FMap.Free;
end;
class function RttiClassLookup.Find(const ClassName: string): TClass;
var
RttiType: TRttiType;
RttiContext: TRttiContext;
begin
if FMap = nil then
begin
FMap := TDictionary<string, TClass>.Create;
for RttiType in RttiContext.GetTypes do
if RttiType is TRttiInstanceType then
FMap.AddOrSetValue(RttiType.Name.ToLowerInvariant, (RttiType as TRttiInstanceType).MetaclassType);
end;
if not FMap.TryGetValue(ClassName.ToLowerInvariant, Result) then
Result := nil;
end;
end.
In use:
var
MyStr: string;
MyStrClass: TClass;
begin
//...
MyStrClass := RttiClassLookup.Find(MyStr);
if MyStrClass <> nil then
for I := 0 to Page.ControlCount - 1 do
if Page.Controls[I].InheritsFrom(MyStrClass) then
begin
//...
end;
The background here is that SomeObj is SomeClass is implemented as (SomeObj <> nil) and SomeObj.InheritsFrom(SomeClass).
You have a good answer from #UweRaabe usingRTTIto getClassName.
A simple (and not very robust) hack without using RTTI would be to use the TComponent.Name property, which is a string, like this - without the is operator:
If (pos('GroupBox', page.Controls[0].name)>0 ) then ...
By default, a control gets the same name as the instance variable, so GroupBox1.name='GroupBox1'. You can either change your database entries to use the substr 'groupbox' or extract 'groupbox' from the type name string in your database.
That being said, if you've inherited this design approach of persisting type names as strings in a database and then using them at runtime to check the types of different components, then you're stuck with it, and so be it. But Delphi is a strongly typed, compiled language, so persisting type names as strings in a database and reading them at runtime and decoding them into Delphi types just doesn't "smell right" IMO. I would re-think this design if possible. Consider doing it all in Delphi using classOf type, enumerations, etc.
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.
I've recently posted a question in this forum asking for any advice regarding missing RTTI information in a DXE2 executable.
That post was a stripped down version of my actual case. RRUZ came to the rescue, and so the stripped down version was quickly resolved. The original problem, though, is still standing, and so I'm posting it in full now. "Main":
program MissingRTTI;
{$APPTYPE CONSOLE}
uses
System.SysUtils, RTTI, MyUnit in 'MyUnit.pas', RTTIUtil in 'RTTIUtil.pas';
var
RHelp: TRttiHelper;
begin
RHelp := TRttiHelper.Create();
if (RHelp.IsTypeFound('MyUnit.TMyClass')) then WriteLn('TMyClass was found.')
else WriteLn('TMyClass was not found.');
ReadLn;
RHelp.Free();
end.
RTTIUtil.pas:
unit RTTIUtil;
interface
uses
MyUnit;
type
TRttiHelper = class(TObject)
public
function IsTypeFound(TypeName: string) : boolean;
end;
implementation
uses
RTTI;
function TRttiHelper.IsTypeFound(TypeName: string): boolean;
var
rCtx: TRttiContext;
rType: TRttiType;
begin
Result := false;
rCtx := TRttiContext.Create();
rType := rCtx.FindType(TypeName);
if (rType <> nil) then
Result := true;
rCtx.Free();
end;
end.
and finally MyUnit.pas:
unit MyUnit;
interface
type
TMyClass = class(TObject)
end;
implementation
end.
The desired type is not found. However, if I change TRttiHelper.IsTypeFound so that it instantiates (and immediately frees) an instance of TMyClass, the type is found. Like so:
function TRttiHelper.IsTypeFound(TypeName: string): boolean;
var
rCtx: TRttiContext;
rType: TRttiType;
MyObj: TMyClass;
begin
Result := false;
MyObj:= TMyClass.Create();
MyObj.Free();
rCtx := TRttiContext.Create();
...
So I'm wondering, is there any way I can force RTTI to be emitted for TMyClass without actually instantiating it?
Update:
On a side not, I might mention that if I try to fetch the TRttiType using TRttiContext.GetType, the desired type is found. So there is some RTTI emitted. Checking the TRttiType.IsPublic property as retrieved by TRttiContext.GetType yields a true value, i.e. the retrieved type is public (and hence should be possible to locate using TRttiContext.FindType).
Add a reference to the class and make sure that the compiler/linker cannot strip it from the executable.
unit MyUnit;
interface
type
TMyClass = class(TObject)
end;
implementation
procedure ForceReferenceToClass(C: TClass);
begin
end;
initialization
ForceReferenceToClass(TMyClass);
end.
In production code you would want to place ForceReferenceToClass in a base unit so that it could be shared. The initialization section of the unit that declares the class is the most natural place for the calls to ForceReferenceToClass since the unit is then self-contained.
Regarding your observation that GetType can locate the type, the very act of calling GetType(TMyClass) adds a reference to the type to the program. It's not that the RTTI is present and FindType cannot find it. Rather, the inclusion of GetType(TMyClass) adds the RTTI to the resulting program.
I used {$STRONGLINKTYPES ON} and worked very well. Put it on main unit.
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.