To initialize Delphi records I've always added a method (class or object) that would initialize to known good defaults. Delphi also allows for defining record "constructors" with parameters, but you cannot define your own parameter-less "constructor".
TSomeRecord = record
Value1: double;
Value2: double;
procedure Init;
end;
procedure TSomeRecord.Init;
begin
Value1 := MaxDouble;
Value2 := Pi;
end;
Given the record above there is no warning that a record has not been initialized. Developers may neglect to call Init on the record. Is there a way to automatically initialize records to my default, potentially more than just a simple FillChar;
For instance
var
LSomeRecord: TSomeRecord
begin
// someone forgot to call LSomeRecord.Init here
FunctionThatTakesDefaultSomeRecord(LSomeRecord);
end;
How can a record be initialized to my defaults automatically?
[Note]
I don't want to modify the problem after it has been answered. Any readers are directed to read the comments on best practices on using class methods for initialization instead of a mutating object method.
You can use a hidden string field (which is automatically initialized to an empty string) to implement 'on time' initialization and implicit operators to hide implementation details. The code below shows how to implement a 'double' field which is automatically initialized to Pi.
program Project44;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
TAutoDouble = record
private
FValue: double;
FInitialized: string;
procedure Initialize(const val: double = Pi);
public
class operator Implicit(const rec: TAutoDouble): double;
class operator Implicit(const val: double): TAutoDouble;
end;
TSomeRecord = record
Value1: TAutoDouble;
Value2: TAutoDouble;
end;
{ TAutoDouble }
procedure TAutoDouble.Initialize(const val: double);
begin
if FInitialized = '' then begin
FInitialized := '1';
FValue := val;
end;
end;
class operator TAutoDouble.Implicit(const rec: TAutoDouble): double;
begin
rec.Initialize;
Result := rec.FValue;
end;
class operator TAutoDouble.Implicit(const val: double): TAutoDouble;
begin
Result.Initialize(val);
end;
var
sr, sr1: TSomeRecord;
begin
try
Writeln(double(sr.Value1));
Writeln(double(sr.Value2));
sr.Value1 := 42;
Writeln(double(sr.Value1));
sr1 := sr;
Writeln(double(sr.Value1));
Writeln(double(sr.Value2));
Readln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
There's, however, no nice way to make this solution more generic regarding the default value -- if you need a different default value you have to clone TAutoDouble definition/implementation and change the default value.
Since Delphi 10.4, there are Custom Managed Records
TMyRecord = record
Value: Integer;
class operator Initialize (out Dest: TMyRecord);
class operator Finalize (var Dest: TMyRecord);
end;
The huge difference between this construction and what was previously available for records is the automatic invocation.
AFAIK you can't without resorting to tricks that aren't worth it (maybe using interface fields which are guaranteed to be initialized).
This would be a nice feature ... but I guess you can use a factory of some kind? or just a humble method returning a record...
Related
We can add strings along with some associated objects to a TStringList:
list: TStringList;
obj: MyObject;
obj := MyObject.Create();
list.AddObject("real object", obj);
In addition it can be very handy to simply connect a string with a Pointer, i.e., an integer value, like this:
list.AddObject("just an index", Pointer(7));
If I later access to an object in this list how to know if it is a MyObject or simply a Pointer? I want something like this:
for i := 0 to list.Count-1 do
if list.Objects[i] is MyObject then
begin
// ...
// Do something with list.Objects[i]
// ...
end;
but this obviously leads to access violation if list.Objects[i] is just a Pointer.
Thanks in advance!
If you want to safely store both integers and objects into one stringlist, define a variant container class to hold integers or objects.
Below is such a class roughly outlined including a test project.
unit VariantContainer;
interface
uses Variants,SysUtils;
Type
TVariantContainer = class
private
FVariant : Variant;
public
constructor Create(aValue: Integer); overload;
constructor Create(aValue: TObject); overload;
function IsInteger: Boolean;
function IsObject: Boolean;
function AsObject: TObject;
function AsInteger: Integer;
end;
implementation
function TVariantContainer.AsInteger: Integer;
begin
if not IsInteger then
raise Exception.Create('Variant is not Integer');
Result := FVariant;
end;
function TVariantContainer.AsObject: TObject;
begin
if not IsObject then
raise Exception.Create('Variant is not TObject');
Result := TVarData(FVariant).VPointer;
end;
function TVariantContainer.IsInteger: Boolean;
begin
Result := VarIsType( FVariant, varInteger);
end;
function TVariantContainer.IsObject: Boolean;
begin
Result := VarIsType(FVariant, varByRef);
end;
constructor TVariantContainer.Create(aValue: Integer);
begin
Inherited Create;
FVariant := aValue;
end;
constructor TVariantContainer.Create(aValue: TObject);
begin
Inherited Create;
TVarData(FVariant).VType:= VarByRef;
TVarData(FVariant).VPointer:= aValue;
end;
end.
program ProjectTestVariantContainer;
{$APPTYPE CONSOLE}
uses
Variants,SysUtils,Classes,VariantContainer;
Type
TMyObj = class
s:String;
end;
var
sList: TStringList;
o: TMyObj;
i: Integer;
begin
o := TMyObj.Create;
o.s := 'Hello';
sList := TStringList.Create;
sList.OwnsObjects := True; // List owns container objects
sList.AddObject('AnInteger',TVariantContainer.Create(3));
sList.AddObject('AnObject',TVariantContainer.Create(o));
for i := 0 to sList.Count-1 do
begin
if Assigned(sList.Objects[i]) then
begin
if TVariantContainer(sList.Objects[i]).IsInteger then
WriteLn( TVariantContainer(sList.Objects[i]).AsInteger)
else
if TVariantContainer(sList.Objects[i]).IsObject then
WriteLn( TMyObj(TVariantContainer(sList.Objects[i]).AsObject).s);
end;
end;
ReadLn;
o.Free;
sList.Free;
end.
It's perfectly possible to add an integer wich just happens to point
to an object. Likewise it's perfectly possible to have a pointer to an
object in your list where the object already has been freed.
Bottom line, you can start looking around in memory all you want, there is no bulletproof way to know if your stringlist contains integers or pointers.
As you shouldn't mix different types anyway, there's also no need to know. A better approach would be to create two classes containing a Stringlist and make the outer classes type safe to work with. Your problem then becomes a non-issue.
Example assuming your Delphi version doesn't support generics
TStringIntegerMap = class
private FStringIntegerList: TStringList;
public
procedure Add(const Key: string; Value: Integer);
... // Add the other required equivalent TStringlist methods
end;
TStringObjectMap = class
private FStringObjectList: TStringList;
public
procedure Add(const Key: string; Value: TObject);
... // Add the other required equivalent TStringlist methods
end;
Note that this is just to give you the gist of how you might implement such classes.
A TObject is in fact a pointer. So there is simply no way to distinguish between a pointer and a TObject considering that the latter is a former.
If you know something about an object, and you need to retrieve that knowledge at a later time, don't throw away that knowledge. If you need to know something later, remember it.
As #DavidHeffernan correctly pointed out, class types are pointers, so they are semantically equivalent and there is no way to distinguish them without having some type indication stored.
However, if you going to ask "How to find out if given arbitrary pointer points to the object instance?" there is a solution for that:
/// <summary>
/// Verifies that the argument points to valid object instance.
/// </summary>
/// <exception cref="EAccessViolation">
/// If segmentation fault occurs while reading VMT and/or its field from the
/// specified memory address.
/// </exception>
/// <remarks>
/// Delphi only, incompatible with FPC.
/// </remarks>
/// <example>
/// <code>
/// procedure TForm1.FormCreate(Sender: TObject);
/// begin
/// ShowMessage(BoolToStr(IsInstance(Self), True));
/// end;
/// </code>
/// </example>
function IsInstance(Data: Pointer): Boolean;
var
VMT: Pointer;
begin
VMT := PPointer(Data)^;
Result := PPointer(PByte(VMT) + vmtSelfPtr)^ = VMT;
end;
I've posted whole inline documentation, so I feel that more comments are unnecessary, but I want to recap what intentionally invalid pointers like Pointer(7) of your example will certainly cause an access violation fault. So you can perform a preliminary check if the higher Words of the pointer are zero (just the same logic as in Windows.IS_INTRESOURCE macro:
function Is_IntResource(lpszType: PChar): BOOL;
begin
Result := ULONG_PTR(lpszType) shr 16 = 0;
end;
program Project15;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.Rtti, System.TypInfo;
type
TRecord = record
public
AField: integer;
constructor Init(test: integer);
end;
TOldObject = object
public
AField: integer;
constructor Init(test: integer);
procedure Fancy; virtual; <<--- compiles
class operator Implicit(test: TRecord): TOldObject; <<-- does not compile.
end;
procedure IsObjectARecord;
var
ARecord: TRecord;
AObject: TOldObject;
v: TValue;
s: String;
begin
v:= TValue.From(ARecord);
case v.Kind of
tkRecord: WriteLn('it''s a Record');
end;
ARecord:= TRecord.Init(10);
AObject.Init(10);
v:= TValue.From(AObject);
case v.Kind of
tkRecord: begin
WriteLn('object is a record?');
if v.IsObject then s:= 'true'
else s:= 'false';
WriteLn('isObject = ' + s);
WriteLn('ToString says: '+v.ToString);
end;
end;
end;
{ TOldSkool }
constructor TOldObject.Init(test: integer);
begin
AField:= 10;
end;
constructor TRecord.Init(test: integer);
begin
AField:= 10;
end;
begin
IsObjectARecord;
Readln;
end.
The outcome of the test proc reads:
ARecord is a Record
AObject is a record?
isObject(AObject) = false
AObject.ToString says: (record)
However object <> record from a functionality point of view.
Object supports inheritance and virtual calls.
Record supports class operators.
Is there a way to tell TP5.5-objects and records apart using RTTI?
Is there even a need to tell them apart -ever-?
Note that I'm not planning to use object, I'm just enumerating types using RTTI so that my generic HashTable with pointers can clean up after itself properly.
Yes I know that object lives on the stack by default (or the heap with special effort) and do not normally need to be freed.
Bonus points if someone knows why virtual calls with TP5.5-objects no longer work, they used to work in Delphi 2007
To the very best of my knowledge, in the eyes of Delphi's RTTI framework, an old-style object cannot be distinguished from a record. This program
{$APPTYPE CONSOLE}
uses
System.Rtti;
type
TOldObject = object
end;
var
ctx: TRttiContext;
RttiType: TRttiType;
begin
RttiType := ctx.GetType(TypeInfo(TOldObject));
Writeln(TValue.From(RttiType.TypeKind).ToString);
Writeln(RttiType.IsRecord);
Readln;
end.
outputs
tkRecord
TRUE
Old object is deprecated.
So you should not use it in conjunction with the new rtti.
First step of deprecation was to disallow virtual methods. Due I suppose to compiler regressions.
This is the Embarcadero decision to mimic C# and his struct / class paradigm. Wrong decision imho.
Arrays can be indexed using user-defined enumerated types. For example:
type
TIndexValue = (ZERO = 0, ONE, TWO, THREE, FOUR);
var
MyArray: array[Low(TIndexValue) .. High(TIndexValue)] of String;
Elements from this array can then be referenced using TIndexValue values as an index:
MyArray[ZERO] := 'abc';
I am trying to obtain this same general functionality with a TStringList.
One simple solution is to cast every index value to an Integer type at the time of reference:
MyStringList[Integer(ZERO)] := 'abc';
Another solution (to hide all the casting) is to create a subclass of TStringList and defer all the casting to this subclass's subroutines that access the inherited Strings property:
type
TIndexValue = (ZERO = 0, ONE, TWO, THREE, FOUR);
type
TEIStringList = class(TStringList)
private
function GetString(ItemIndex: TIndexValue): String;
procedure SetString(ItemIndex: TIndexValue; ItemValue: String);
public
property Strings[ItemIndex: TIndexValue]: String
read GetString write SetString; default;
end;
function TEIStringList.GetString(ItemIndex: TIndexValue): String;
begin
Result := inherited Strings[Integer(ItemIndex)];
end;
procedure TEIStringList.SetString(ItemIndex: TIndexValue; ItemValue: String);
begin
inherited Strings[Integer(ItemIndex)] := ItemValue;
end;
This works fine for a single implementation that uses the enumerated type TIndexValue.
However, I would like to re-use this same logic or subclass for several different TStringList objects that are indexed by different enumerated types, without having to define TStringList subclasses for each possible enumerated type.
Is something like this possible? I suspect I may have to depend on Delphi's Generics, but I would be very interested to learn that there are simpler ways to achieve this.
I think that generics would be by far the most elegant solution. Using them would be as simple as rewriting your class above as:
TEIStringList<T> = class(TStringList)
and then replacing all TIndexValue references with T. Then you could create it just as any other generic:
var
SL: TEIStringList<TIndexValue>;
begin
SL:=TEIStringList<TIndexValue>.Create;
(...)
ShowMessage(SL[ZERO])
(...)
end;
If you insist on avoiding generics, maybe operator overloading would be of use. Something like the following should work:
type
TIndexValueHolder = record
Value : TIndexValue;
class operator Implicit(A: TMyRecord): integer;
end;
(...)
class operator TIndexValueHolder.Implicit(A: TMyRecord): integer;
begin
Result:=Integer(A);
end;
Then use with:
var
Inx : TIndexValueHolder;
begin
Inx.Value:=ZERO;
ShowMessage(SL[Inx]);
end
UPDATE:
You could adapt TIndexValueHolder for use in a for or while loop by adding Next, HasNext, etc. methods. This might end defeating the purpose, though. I'm still not sure what the purpose is, or why this would be useful, but here's some ideas for how to do it, anyways.
You probably can use a class helper and declare the default property index as Variant:
type
TEnum1 = (Zero = 0, One, Two, Three, Four);
TEnum2 = (Nul = 0, Een, Twee, Drie, Vier);
TEnum3 = (Gds = 0, Psajs, Oeroifd, Vsops, Wowid);
TStringListHelper = class helper for TStringList
private
function GetString(Index: Variant): String;
procedure SetString(Index: Variant; const Value: String);
public
property Strings[Index: Variant]: String read GetString write SetString;
default;
end;
function TStringListHelper.GetString(Index: Variant): String;
begin
Result := inherited Strings[Index];
end;
procedure TStringListHelper.SetString(Index: Variant; const Value: String);
begin
inherited Strings[Index] := Value;
end;
Testing code:
procedure TForm1.Button1Click(Sender: TObject);
var
Strings: TStringList;
begin
Strings := TStringList.Create;
try
Strings.Add('Line 1');
Strings.Add('Second line');
Strings[Zero] := 'First line';
Memo1.Lines.Assign(Strings);
Caption := Strings[Psajs];
finally
Strings.Free;
end;
end;
See edit history for a previous less successful attempt.
If I am trying to call a procedure which has a record type (not object) as a parameter, is it possible to somehow pass details of that parameter "inline" without having to declare a variable of that type first?
eg assume I have this simple record type:
type TMyRecord = record
AString: string;
AnInt: Integer;
end;
and this procedure declaration:
procedure MyProcedure(Rec: TMyRecord);
If I want to call MyProcedure do I have to declare a variable of type TMyRecord or can I do something like:
MyProcedure(TMyRecord("Test", 10));
That doesn't work (XE2) (get a compiler error about it expecting a ")").
So, can I do something like that? Or not possible.
Thanks
It is possible using the advanced record structure.
For more information about advanced records, see the Records (advanced) section in Delphi help.
This is a small prototype to see how it works in your case to preinitialize a record in a function/procedure call :
Type
TRecord = record
AString : String;
AnInt : Integer;
Constructor Create( Const s : String; i : Integer);
end;
constructor TRecord.Create(const s: String; i: Integer);
begin
AString := s;
AnInt := i;
end;
procedure DoSomething( theRec : TRecord);
begin
WriteLn(theRec.AString, ' ',theRec.AnInt);
end;
begin
DoSomeThing( TRecord.Create('S',1));
ReadLn;
end.
Looking at the Delphi RTL, see the definitions of the record types TPoint and TRect in unit system.types (XE2).
They define some overloaded Create constructors, which are used in lots of places to preinitialize the record structures in function/procedure calls.
The question you are asking relates to code readability and there is a solution that avoids having to create a variable. The VCL uses this solution with the records TPoint and TRect.
Consider the definition of TPoint:
type
TPoint = record
X,Y integer
end;
To pass a TPoint to a procedure you might do:
var
MyPoint : TPoint;
begin
MyPoint.X := 5;
MyPoint.Y := 7;
DoSomething( MyPoint );
end;
This is fine but takes 3 lines when one is also possible using the factory function Point:
begin
DoSomething( Point(5,7) );
end;
In Delphi, a function has been declared as follows:
function Point( X, Y : integer ) : TPoint;
begin
Result.X := X;
Result.Y := Y;
end;
You can then call this function 'inline' to create the record 'on the fly' to to quickly
You will see the same has been provided for TRect etc. I often put such a factory function together with the record declaration as follows, even if I don't plan to use them yet:
type
TMyRecord = record
A : integer;
B : string;
end;
function MyRecord( A : integer; const B : string ) : TMyRecord;
begin
Result.A := A;
Result.B := B;
end;
Use of this technique can improved the readability of code and also ensures that you don't accidently omit setting a record element.
Just having fun with John Easley's idea:
type TRec = record
X: string;
Y: Integer;
end;
procedure TestRec(const Rec: array of const);
var
R: TRec;
begin
R.X:= string(Rec[0].VUnicodeString);
R.Y:= Rec[1].VInteger;
ShowMessage(R.X + IntToStr(R.Y));
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
TestRec(['Test', 22]);
end;
It is possible to pass record fields as array of const parameters and assign these parameters to local record variable.
It would be nice! But, no.
If passing things inline is really your objective, then perhaps Open Array Parameters would suit you.
Procedure MyProcedure(const Vars: Array of Variant);
begin
ShowMessage(VarToStr(Vars[0])+' '+VarToStr(Vars[1]));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
MyProcedure(['Test', 12]);
end;
You could also pass an Array of Const, which is basically an array of TVarRec which is a variant record that also includes type information as VType. This is fun stuff..
An excellent article can be found on Rudy's Delphi Corner here:
Rudy's Delphi Corner, Open Array Parameters
Following up on my earlier question :
Generics and Marshal / UnMarshal. What am I missing here?
In "part #1" (the link above) TOndrej provided a nice solution - that failed on XE2.
Here I provide corrected source to correct that.
And I feel the need to expand this issue a bit more.
So I would like to hear you all how to do this :
First - To get the source running on XE2 and XE2 update 1 make these changes :
Marshal.RegisterConverter(TTestObject,
function (Data: TObject): String // <-- String here
begin
Result := T(Data).Marshal.ToString; // <-- ToString here
end
);
Why ??
The only reason I can see must be related to XE2 is having a lot more RTTI information available. And hence it will try and marshal the TObject returned.
Am I on the right track here? Please feel free to comment.
More important - the example does not implement an UnMarshal method.
If anyone can produce one and post it here I would love it :-)
I hope that you still have interest in this subject.
Kind Regards
Bjarne
In addition to the answer to this question, I've posted a workaround to your previous question here: Generics and Marshal / UnMarshal. What am I missing here?
For some reason, using the non-default constructor of the TJsonobject causes the issue in XE2 - using the default constructor "fixed" the problem.
First, you need to move your TTestobject to its own unit - otherwise, RTTI won't be able to find/create your object when trying to unmarshal.
unit uTestObject;
interface
uses
SysUtils, Classes, Contnrs, Generics.Defaults, Generics.Collections, DbxJson, DbxJsonReflect;
type
{$RTTI EXPLICIT METHODS([]) PROPERTIES([vcPublished]) FIELDS([vcPrivate])}
TTestObject=class(TObject)
private
aList:TStringList;
public
constructor Create; overload;
constructor Create(list: array of string); overload;
constructor Create(list:TStringList); overload;
destructor Destroy; override;
function Marshal:TJSonObject;
class function Unmarshal(value: TJSONObject): TTestObject;
published
property List: TStringList read aList write aList;
end;
implementation
{ TTestObject }
constructor TTestObject.Create;
begin
inherited Create;
aList:=TStringList.Create;
end;
constructor TTestObject.Create(list: array of string);
var
I:Integer;
begin
Create;
for I:=low(list) to high(list) do
begin
aList.Add(list[I]);
end;
end;
constructor TTestObject.Create(list:TStringList);
begin
Create;
aList.Assign(list);
end;
destructor TTestObject.Destroy;
begin
aList.Free;
inherited;
end;
function TTestObject.Marshal:TJSonObject;
var
Mar:TJSONMarshal;
begin
Mar:=TJSONMarshal.Create();
try
Mar.RegisterConverter(TStringList,
function(Data:TObject):TListOfStrings
var
I, Count:Integer;
begin
Count:=TStringList(Data).Count;
SetLength(Result, Count);
for I:=0 to Count-1 do
Result[I]:=TStringList(Data)[I];
end);
Result:=Mar.Marshal(Self) as TJSonObject;
finally
Mar.Free;
end;
end;
class function TTestObject.Unmarshal(value: TJSONObject): TTestObject;
var
Mar: TJSONUnMarshal;
L: TStringList;
begin
Mar := TJSONUnMarshal.Create();
try
Mar.RegisterReverter(TStringList,
function(Data: TListOfStrings): TObject
var
I, Count: Integer;
begin
Count := Length(Data);
Result:=TStringList.Create;
for I := 0 to Count - 1 do
TStringList(Result).Add(string(Data[I]));
end
);
//UnMarshal will attempt to create a TTestObject from the TJSONObject data
//using RTTI lookup - for that to function, the type MUST be defined in a unit
Result:=Mar.UnMarshal(Value) as TTestObject;
finally
Mar.Free;
end;
end;
end.
Also note that the constructor has been overloaded - this allows you to see that the code is functional without pre-pouplating the data in the object during creation.
Here is the implementation for the generic class list object
unit uTestObjectList;
interface
uses
SysUtils, Classes, Contnrs, Generics.Defaults, Generics.Collections,
DbxJson, DbxJsonReflect, uTestObject;
type
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
TTestObjectList<T:TTestObject,constructor> = class(TObjectList<T>)
public
function Marshal: TJSonObject;
constructor Create;
class function Unmarshal(value: TJSONObject): TTestObjectList<T>; static;
end;
//Note: this MUST be present and initialized/finalized so that
//delphi will keep the RTTI information for the generic class available
//also, it MUST be "project global" - not "module global"
var
X:TTestObjectList<TTestObject>;
implementation
{ TTestObjectList<T> }
constructor TTestObjectList<T>.Create;
begin
inherited Create;
//removed the add for test data - it corrupts unmarshaling because the data is already present at creation
end;
function TTestObjectList<T>.Marshal: TJSonObject;
var
Marshal: TJsonMarshal;
begin
Marshal := TJSONMarshal.Create;
try
Marshal.RegisterConverter(TTestObjectList<T>,
function(Data: TObject): TListOfObjects
var
I: integer;
begin
SetLength(Result,TTestObjectlist<T>(Data).Count);
for I:=0 to TTestObjectlist<T>(Data).Count-1 do
Result[I]:=TTestObjectlist<T>(Data)[I];
end
);
Result := Marshal.Marshal(Self) as TJSONObject;
finally
Marshal.Free;
end;
end;
class function TTestObjectList<T>.Unmarshal(value: TJSONObject): TTestObjectList<T>;
var
Mar: TJSONUnMarshal;
L: TStringList;
begin
Mar := TJSONUnMarshal.Create();
try
Mar.RegisterReverter(TTestObjectList<T>,
function(Data: TListOfObjects): TObject
var
I, Count: Integer;
begin
Count := Length(Data);
Result:=TTestObjectList<T>.Create;
for I := 0 to Count - 1 do
TTestObjectList<T>(Result).Unmarshal(TJSONObject(Data[I]));
end
);
//UnMarshal will attempt to create a TTestObjectList<TTestObject> from the TJSONObject data
//using RTTI lookup - for that to function, the type MUST be defined in a unit,
//and, because it is generic, there must be a GLOBAL VARIABLE instantiated
//so that Delphi keeps the RTTI information avaialble
Result:=Mar.UnMarshal(Value) as TTestObjectList<T>;
finally
Mar.Free;
end;
end;
initialization
//force delphi RTTI into maintaining the Generic class information in memory
x:=TTestObjectList<TTestObject>.Create;
finalization
X.Free;
end.
There are several things that are important to note:
If a generic class is created at runtime, RTTI information is NOT kept unless there is a globally accessible object reference to that class in memory. See here: Delphi: RTTI and TObjectList<TObject>
So, the above unit creates such a variable and leaves it instantiated as discussed in the linked article.
The main procedure has been updated that shows both marshaling and unmarshaling the data for both objects:
procedure Main;
var
aTestobj,
bTestObj,
cTestObj : TTestObject;
aList,
bList : TTestObjectList<TTestObject>;
aJsonObject,
bJsonObject,
cJsonObject : TJsonObject;
s: string;
begin
aTestObj := TTestObject.Create(['one','two','three','four']);
aJsonObject := aTestObj.Marshal;
s:=aJsonObject.ToString;
Writeln(s);
bJsonObject:=TJsonObject.Create;
bJsonObject.Parse(BytesOf(s),0,length(s));
bTestObj:=TTestObject.Unmarshal(bJsonObject) as TTestObject;
writeln(bTestObj.List.Text);
writeln('TTestObject marshaling complete.');
readln;
aList := TTestObjectList<TTestObject>.Create;
aList.Add(TTestObject.Create(['one','two']));
aList.Add(TTestObject.Create(['three']));
aJsonObject := aList.Marshal;
s:=aJsonObject.ToString;
Writeln(s);
cJSonObject:=TJsonObject.Create;
cJSonObject.Parse(BytesOf(s),0,length(s));
bList:=TTestObjectList<TTestObject>.Unmarshal(cJSonObject) as TTestObjectList<TTestObject>;
for cTestObj in bList do
begin
writeln(cTestObj.List.Text);
end;
writeln('TTestObjectList<TTestObject> marshaling complete.');
Readln;
end;
Here is my own solution.
As I am very fond of polymorphism, I actually also want a solution that can be built into an object hierarchy. Lets say TTestObject and TTestObjectList is our BASE object. And from that we descend to TMyObject and also TMyObjectList. And furthermore I've made changes to both Object and List - added properties for Marshaller/UnMarshaller
TMyObject = class(TTestObject) and TMyObjectList<T:TMyObject> = class(TTestObjectList)
With this we now introduce some new problems. Ie. how to handle marshalling of different types between lines in the hierarchy and how to handle TJsonMarshal and TJsonUnMarshal as properties on TTestObject and List.
This can be overcome by introducing two new methods on TTestObject level. Two class functions called RegisterConverters and RegisterReverters. Then we go about and change the marshal function of TTestObjectList into a more simpel marshalling.
Two class functions and properties for both object and List.
class procedure RegisterConverters(aClass: TClass; aMar: TJSONMarshal); virtual;
class procedure RegisterReverters(aClass: TClass; aUnMar: TJSONUnMarshal); virtual;
property Mar: TJSONMarshal read FMar write SetMar;
property UnMar: TJSONUnMarshal read FUnMar write SetUnMar;
The Marshal function of List can now be done like this:
function TObjectList<T>.Marshal: TJSONObject;
begin
if FMar = nil then
FMar := TJSONMarshal.Create(); // thx. to SilverKnight
try
RegisterConverters; // Virtual class method !!!!
try
Result := FMar.Marshal(Self) as TJSONObject;
except
on e: Exception do
raise Exception.Create('Marshal Error : ' + e.Message);
end;
finally
ClearMarshal; // FreeAndNil FMar and FUnMar if assigned.
end;
end;
Sure we can still have a marshaller for our TTestObject - but the Marshal function of TTestObjectList will NOT use it. This way only ONE Marshaller will get created when calling Marshal of TTestObjectList (or descendants). And this way we end up getting marshalled ONLY the information we need to recreate our structure when doing it all backwards - UnMarshalling :-)
Now this actually works - but I wonder if anyone has any comments on this ?
Lets add a property "TimeOfCreation" to TMyTestObject:
property TimeOfCreation : TDateTime read FTimeOfCreation write FTimeOfCreation;
And set the property in the constructor.
FTimeofCreation := now;
And then we need a Converter so we override the virtual RegisterConverters of TTestObject.
class procedure TMyTestObject.RegisterConverters(aClass: TClass; aMar: TJSONMarshal);
begin
inherited; // instanciate marshaller and register TTestObject converters
aMar.RegisterConverter(aClass, 'FTimeOfCreation',
function(Data: TObject; Field: String): string
var
ctx: TRttiContext;
date: TDateTime;
begin
date := ctx.GetType(Data.ClassType).GetField(Field).GetValue(Data).AsType<TDateTime>;
Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', date);
end);
end;
I end up with Very simple source like using TTestObject ie.
aList := TMyTestObjectList<TMyTestObject>.Create;
aList.Add(TMyTestObject.Create(['one','two']));
aList.Add(TMyTestObject.Create(['three']));
s := (aList.Marshal).ToString;
Writeln(s);
And now I have succeded in marshalling with polymorphism :-)
This also works with UnMarshalling btw. And Im in the process of rebuilding my FireBird ORM to produce source for all my objects like this.
The current OLD version can be found here :
http://code.google.com/p/objectgenerator/
Remember that it only works for FireBird :-)