TDictionary : SaveToFile / LoadFromFile
What an elegant solution!
To begin with, everything runs as expected.
The content is saved to a file in a JSON format that looks right.
But after reloading the file, there is a problem:
Type
TEnumCategTypes = ( e_SQL1, e_VBA, e_Text );
TCategParams = class
fontStyles : TFontStyles;
rgbColor : COLORREF;
end;
TdictCategory = class ( TDictionary<TEnumCategTypes, TCategParams> )
public
public class function LoadFromFile( const AFileName: string ): TdictCategory;
public class procedure SaveToFile( const AFileName: string; dict: TdictCategory );
end;
implementation
class procedure TdictCategory.SaveToFile( const AFileName: string; dict: TdictCategory );
var
stream : TStringStream;
begin
try
stream := TStringStream.Create( TJson.ObjectToJsonString( dict ) ) ;
stream.SaveToFile( AFileName )
finally
stream.Free;
end;
end;
//---
class function TdictCategory.LoadFromFile( const AFileName: string ): TdictCategory;
var
stream: TStringStream;
begin
stream := TStringStream.Create;
try
stream.LoadFromFile( AFileName );
result := TJson.JsonToObject<TdictCategory>( stream.DataString );
finally
stream.Free;
end;
end;
The test follows. And all the glory ends.
Here is the code, including the comment:
..
var
cc: Colorref;
begin
.. // fill values
cc := DictCategory.Items[ e_SQL1 ].rgbColor; // Okay, it works
TdictCategory.SaveToFile( 'category.json', DictCategory ); // Even the contents of the file, looks good
DictCategory.Clear;
DictCategory.Free;
DictCategory := nil;
DictCategory := TdictCategory.LoadFromFile( 'category.json' ); // DictCategory is no longer NIL, and it looks optically well..
cc := DictCategory.Items[ e2_sql_aggregate ].rgbColor; // C R A S H !!! with AV
It seems that Delphi (Berlin 10.1), can not serialize the Dictionary! If that's true, it really hurts me. I believe there are many others. Or is there any error in the attached code?
TJson.JsonToObject ultimately will instantiate objects using their default constructor (see REST.JsonReflect.TJSONUnMarshal.ObjectInstance).
Now look into System.Generics.Collections and you will see that TDictionary<TKey,TValue> does not have a default constructor (no, RTTI has no information about default values for parameters so the constructor with Capacity: Integer = 0 will not be considered).
This means that RTTI will look further and find TObject.Create and calls that on the dictionary class which will leave you with a half initialized object (without having run your code I guess its FComparer not being assigned which the constructor of TDictionary<TKey,TValue> would have done).
Long story short: add a parameterless constructor to your TdictCategory and just call inherited Create; there. Then TJSONUnMarshal.ObjectInstance will find the parameterless constructor and calls all the code necessary to have a properly initialized instance.
Anyway you probably won't be satisfied with the result as REST.JsonReflect simply serializes all the internal states of instances (unless explicitly excluded via attributes which is not being done in the RTL classes) and thus also deserializes them which means that such JSON is only Delphi-to-Delphi compatible.
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;
Im trying to write some code which will read/write a dynamic array of objects to a file. The objects represent the structure of the java source code. I need to be able to scan the whole source code and gather information on Fields, Methods and Classes. I have an algorithm which does this and the result is kept in a structure of TFieldStruc, TMethodStruc and TClassStruc, all descendants of the TCoreStruc (a descendant of TObject). The java source code takes a couple of minutes to be scanned and have the virtual structure generated. Because of this my application scans all the source code once and saves it into a much more accessible format which is loaded when ever the IDE launches.
Is there a way (other than exporting the objects 'to string' and then re-creating them again when they are loaded) to stream the entire three arrays of TFieldStruc, TMethodStruc and TClassStruc, to a file so they can be read later?
I have tried reading and writing to a 'File of TFieldStruc..' and the TFileStream to save the objects to a file and read them back, but in both cases I get 'inaccessible value' in the debugger followed by an 'Access Violation' error as soon as the object is accessed again. If anyone has ideas on how to solve this problem it would be appreciated. Below is the code to TCodeStruc if any of its fields/methods may be causing issues:
type
TCoreStruc = class(TObject)
public
LowerPointer : integer;
HigherPointer : integer;
Line : integer;
Word : integer;
Char : integer;
CoreType : ansistring;
IsPublic : boolean;
IsPrivate : boolean;
IsStatic : boolean;
IsFinal : boolean;
Name : ansistring;
NestedStruc : TCoreStruc;
constructor Create(Name, CoreType : ansistring; NestedStruc : TCoreStruc; IsPublic, IsPrivate, IsStatic, IsFinal : boolean);
procedure UpdateValues(NestedStruc : TCoreStruc; IsPublic, IsPrivate, IsStatic, IsFinal : boolean);
procedure SetPosition(Line, Word, Char : integer);
end;
Here is an example using your structure.
A few notes about this:
There are lots of different ways to go about this. Take David Heffernan's advice and do some searches for serialization. I use the approach include below in one of my applications but other include using RTTI/Persistent objects to iterate the published properties of an object. There are libraries that will iterate object for you and do all the work.
You need to actually write out to the string the sizes of dynamic objects. That includes things like arrays and strings.
In my example each object knows how to read and write itself to the stream.
I use a struct for the fixed length parts of the object. That saves me from needing to write each data element individually.
Strings need to be written on their own to include their size (you could used a fixed length buffer like Delphi short strings but it is not that much work to write out a regular string. You need to decide what type of format you want string data written in. I picked UTF8 for my application.
For your other arrays you can write their data (including length) after the first array is written out. Sometime there will be a header section that includes the lengths for all the dynamic sections at the top, others will write the length write before the structure starts. The key part is to always write things in the same order and included somewhere it can be re-read how many there are.
There is no error checking or verification in the file structure below. If anything is different between the read and write it will blow up - probably with a stream read error.
Any change to the structures will cause old files to not be read properly. There are a number of ways to version a file to ensure you can still read old formats. Not included here.
In your application you would pass a TFileStream to the read and write function. I like to write the actual read/write functions with just a TStream. Then the object does not care where the data is coming from. It could be file, or it could already be in memory.
If you drop the following unit into a console application you should be able to add a call to Main and step through the example.
unit CoreStruct;
interface
uses Classes, Types;
type
TCoreStructData = packed record
LowerPointer : integer;
HigherPointer : integer;
Line : integer;
Word : integer;
Char : integer;
IsPublic : boolean;
IsPrivate : boolean;
IsStatic : boolean;
IsFinal : boolean;
HasNested: boolean;
end;
TCoreStruc = class(TObject)
private
FCoreData: TCoreStructData;
FNestedStruc : TCoreStruc;
procedure SetNestedStruc(AValue: TCoreStruc);
public
CoreType : String;
Name : String;
constructor Create(); overload;
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
//constructor Create(Name, CoreType : ansistring; NestedStruc : TCoreStruc; IsPublic, IsPrivate, IsStatic, IsFinal : boolean); overload;
//procedure UpdateValues(NestedStruc : TCoreStruc; IsPublic, IsPrivate, IsStatic, IsFinal : boolean);
//procedure SetPosition(Line, Word, Char : integer);
property LowerPointer: integer read FCoreData.LowerPointer write FCoreData.LowerPointer;
property HigherPointer: integer read FCoreData.HigherPointer write FCoreData.HigherPointer;
property Line: integer read FCoreData.Line write FCoreData.Line;
property Word: integer read FCoreData.Word write FCoreData.Word;
property Char: integer read FCoreData.Char write FCoreData.Char;
property NestedStruc: TCoreStruc read FNestedStruc write SetNestedStruc;
end;
procedure Main();
implementation
function ReadUTF8StringFromStream(const Stream: TStream): String;
var
n: Integer;
Buffer8: Utf8String;
begin
Result := '';
Stream.ReadBuffer(n, SizeOf(n));
if n = 0 then
Exit;
SetLength(Buffer8, n);
Stream.ReadBuffer(Pointer(Buffer8)^, n);
Result := String(Buffer8);
end;
procedure WriteUtf8StringToStream(const Data: String; Stream: TStream);
var
Buffer8: Utf8String;
n: Integer;
begin
// When writing strings we need to make sure the length of the
// string is written out to the stream. That goes first so the
// reader knows how long the buffer is.
//
// You could you different formats to write to the file depending on
// needs. I like using UTF8 when writing out to file, but it does
// require an extra buffer copy when turning it back into a native
// Delphi unicode string.
Buffer8 := Utf8String(Data);
n := Length(Buffer8);
Stream.WriteBuffer(n, SizeOf(n));
Stream.WriteBuffer(Pointer(Buffer8)^, n);
end;
procedure Main();
var
Structs: array of TCoreStruc;
ArraySize: integer;
DataStream: TMemoryStream;
ArraySize_A: integer;
Structs_A: array of TCoreStruc;
i: integer;
begin
// Create and write some data
SetLength(Structs, 3);
Structs[0] := TCoreStruc.Create();
Structs[0].HigherPointer := 1;
Structs[0].Name := 'Testing';
Structs[0].NestedStruc := TCoreStruc.Create();
Structs[0].NestedStruc.HigherPointer := 100;
Structs[1] := TCoreStruc.Create();
Structs[1].HigherPointer := 2;
Structs[2] := TCoreStruc.Create();
Structs[2].HigherPointer := 3;
DataStream := TMemoryStream.Create();
// We need to start with the count we are writing out so
// the reader knows how many times to loop.
ArraySize := Length(Structs);
DataStream.WriteBuffer(ArraySize, SizeOf(integer));
for i := 0 to ArraySize - 1 do
begin
Structs[i].WriteToStream(DataStream);
end;
// Read the data into a new set of objects
DataStream.Position := 0;
DataStream.ReadBuffer(ArraySize_A, SizeOf(integer));
SetLength(Structs_A, ArraySize_A);
for i := 0 to ArraySize_A - 1 do
begin
Structs_A[i] := TCoreStruc.Create();
Structs_A[i].ReadFromStream(DataStream);
end;
end;
{ TCoreStruc }
constructor TCoreStruc.Create;
begin
Self.LowerPointer := 0;
Self.HigherPointer := 0;
Self.Line := 0;
Self.Word := 0;
Self.Char := 0;
Self.NestedStruc := nil;
end;
procedure TCoreStruc.WriteToStream(Stream: TStream);
begin
Stream.WriteBuffer(FCoreData, SizeOf(TCoreStructData));
WriteUtf8StringToStream(Name, Stream);
WriteUtf8StringToStream(CoreType, Stream);
if FCoreData.HasNested = true then
begin
FNestedStruc.WriteToStream(Stream)
end;
end;
procedure TCoreStruc.ReadFromStream(Stream: TStream);
begin
Stream.ReadBuffer(FCoreData, SizeOf(TCoreStructData));
Name := ReadUtf8StringFromStream(Stream);
Name := ReadUtf8StringFromStream(Stream);
if FCoreData.HasNested = true then
begin
FNestedStruc := TCoreStruc.Create();
FNestedStruc.ReadFromStream(Stream);
end;
end;
procedure TCoreStruc.SetNestedStruc(AValue: TCoreStruc);
begin
FNestedStruc := AValue;
if AValue = nil then
FCoreData.HasNested := false
else
FCoreData.HasNested := true;
end;
end.
Of course, this piece of code will not compile. First I need to cast a TObject value to Integer. Then, read it as a string. What function should I use?
for i := 1 to 9 do begin
cmbLanguage.Items.AddObject(Format('Item %d', [i]), TObject(i));
end;
cmbLanguage.ItemIndex := 2;
ShowMessage(cmbLanguage.Items.Objects[cmbLanguage.ItemIndex]);
Or maybe it's possible to use String instead of Integer in the first place?
cmbLanguage.Items.AddObject(Format('Item %d', [i]), TObject(i));
Here you are adding an item with an "object" which is actually an integer (i) casted to a TObject.
Since you are actually storing an int in the object field, you can just cast it back to Integer, then convert that to a string:
ShowMessage(IntToStr(Integer(cmbLanguage.Items.Objects[cmbLanguage.ItemIndex])));
Note that you are not really converting anything here, you're just pretending that your integer is a TObject so the compiler doesn't complain.
If delphi xe or higher is used, I would use a generic class based on #Jerry answer.
Preparation:
unit CoreClasses;
interface
type
IPrimitiveBox<T> = interface
procedure setValue(value : T);
function getValue(): T;
end;
TPrimitiveBox<T> = class(TInterfacedObject, IPrimitiveBox<T>)
private
value : T;
public
constructor create(value : T);
// IPrimtiveBox<T>
procedure setValue(value : T);
function getValue(): T;
end;
implementation
{ TPrimitiveBox<T> }
constructor TPrimitiveBox<T>.create(value: T);
begin
self.value := value;
end;
function TPrimitiveBox<T>.getValue: T;
begin
Result := value;
end;
procedure TPrimitiveBox<T>.setValue(value: T);
begin
self.value := value;
end;
Usage (based on #Jerry example)
var
io: IPrimitive<Integer>;
sl := TStringList.create(true);
io := TPrimitive<Integer>.create(123);
sl.addObjects(io)
io := IPrimitive<Integer>(sl.objects[4]);
ShowMessage('Integer value: '+ IntToStr(io.getValue()));
If you know you will be using Delphi-7 for the rest of your life stick with the TObject(i) cast. Otherwise start using proper objects, this will save you headaches when upgrading to 64 bit.
Unit uSimpleObjects;
Interface
type
TIntObj = class
private
FI: Integer;
public
property I: Integer Read FI;
constructor Create(IValue: Integer);
end;
type
TDateTimeObject = class(TObject)
private
FDT: TDateTime;
public
property DT: TDateTime Read FDT;
constructor Create(DTValue: TDateTime);
end;
Implementation
{ TIntObj }
constructor TIntObj.Create(IValue: Integer);
begin
Inherited Create;
FI := IValue;
end;
{ TDateTimeObject }
constructor TDateTimeObject.Create(DTValue: TDateTime);
begin
Inherited Create;
FDT := DTValue;
end;
end.
Usage:
var
IO: TIntObj;
SL: TStringList;
Storage:
SL := TStringList.Create(true); // 'OwnsObjects' for recent Delphi versions
IO := TIntObj.Create(123);
SL.AddObjects(IO);
Retrieval:
IO := TIntObj(SL.Objects[4]);
ShowMessage('Integer value: '+ IntToStr(IO.I));
For Delphi-7
TIntObj := TStringList.Create;
and you have to free the objects yourself:
for i := 0 to Sl.Count-1 do
begin
IO := TIntObj(SL.Objects[i]);
IO.Free;
end;
SL.Free;
You cannot simply convert an object to a string. This is something you will have to do by yourself using a method of your choice, depending on the reasoning behind it. For example, you could concatenate a string in XML format representing the data in your object. However, Delphi has absolutely no way of concatenating this data for you.
As others have pointed out, you are actually trying to cast a TObject as an Integer. This means that if you stored an integer in a TObject field, then you need to cast it back, for example Integer(MyIntObject)
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 :-)
Data.XX.NewValue := Data.XX.SavedValue;
Data.XX.OldValue := Data.XX.SavedValue;
I need to do the above a large number of times, where XX represents the value in the class. Pretending there were 3 items in the list: Tim, Bob, Steve. Is there any way to do the above for all three people without typing out the above code three times?
(Data is a class containing a number of Objects, each type TList, which contain OldValue, NewValue and SavedValue)
What I'd do if I had to do something like this is put one more TList on Data, which holds a list of all the Objects on it. Fill it in the constructor, and then when you have to do something like this, use a loop to apply the same basic operation to each item in the list.
Maybe I'm not understanding it ok but...
Here is where Object Oriented shines. You define a procedure for the class and then apply for any instance you create.
TMyPropValue = class(TObject)
private
FNewValue: double;
FOldValue: double;
procedure SetValue(AValue: double);
public
procedure RestoreOldValue;
propety NewValue: double read FNewValue write SetValue; // Raed/write property (write using a procedure)
property OldValue: double read FOldValue; // Read only property
end;
TMyClass = class(TObject)
private
FProp1: TMyPropValue;
FProp2: TMyPropValue;
public
procedure RestoreValues;
end;
//....
var
MyObj1: TMyClass;
MyObj2: TMyclass;
procedure TMyPropValue.SetValue(AValue: double);
begin
FOldValue := FNewValue;
FNewValue := AValue;
end;
// Restore the Old value of this Prop
procedure TMyPropValue.RestoreOldValue;
begin
FNewValue := FOldValue;
end;
// Restore ald the Values of the class
procedure TMyClass.RestoreValues;
begin
FProp1.RestoreOldValue;
FProp2.RestoreOldValue;
end;
// -----------
// Creating and populating a couple of objects (instances)
procedure XXX;
begin
MyObj1 := TMyClass.Create;
MyObj1.Prop1.NewValue := 10.25:
MyObj1.Prop2.NewValue := 99.10:
MyObj2 := TMyClass.Create;
MyObj2.Prop1.NewValue := 75.25:
MyObj2.Prop2.NewValue := 60.30:
end;
// Changing values, the class internaly will save the OldValue
procedure yyyy;
begin
MyObj1.Prop1.NewValue := 85.26:
MyObj1.Prop2.NewValue := 61.20:
MyObj2.Prop1.NewValue := 99.20:
MyObj2.Prop2.NewValue := 55.23:
end;
// Using a procedure from the class
procedure zzzz;
begin
MyObj1.RestoreValues;
MyObj2.RestoreValues;
end;
Hope this help
Daniel
Judging from this post and this post, I would suggest the following :
unit MyAssignment;
interface
type
TValueKind = ( EconomicGrowth,
Inflation,
Unemployment,
CurrentAccountPosition,
AggregateSupply,
AggregateDemand,
ADGovernmentSpending,
ADConsumption,
ADInvestment,
ADNetExports,
OverallTaxation,
GovernmentSpending,
InterestRates,
IncomeTax,
Benefits,
TrainingEducationSpending );
TValue = record
NewValue,
OldValue,
SavedValue : Double;
procedure SetValue( aVal : Double );
procedure SaveValue();
procedure RestoreValue();
end;
TDataArray = array [TValueKind] of TValue;
var
Data : TDataArray;
implementation
{TValue}
procedure TValue.SetValue( aVal : Double );
begin
OldValue := NewValue;
NewValue := aVal;
end;
procedure TValue.SaveValue;
begin
SavedValue := NewValue;
end;
procedure TValue.RestoreValue;
begin
NewValue := SavedValue;
OldValue := SavedValue;
end;
end.
Now you can write this kind of code :
//accessing the values :
// Data[XX] instead of Data.XX
//examples :
ShowMessage(FloatToStr(Data[Inflation].SavedValue));
Data[AgregateSupply].SetValue( 10.0 );
Data[Benefits].SaveValue;
//writing loops :
procedure RestoreValues( var aData : TDataArray ); //the "var" keyword is important here : google "arguments by value" "arguments by reference"
var
lKind : TValueKind;
begin
for lKind := Low(TValueKind) to High(TValueKind) do
aData[lKind].RestoreValue;
end;
procedure SaveValues( var aData : TDataArray );
var
lKind : TValueKind;
begin
for lKind := Low(TValueKind) to High(TValueKind) do
aData[lKind].RestoreValue;
end;
//calling these functions :
SaveValues( Data );
RestoreValues( Data );
If you need more complex manipulations on the array, it would be a good idea to put it into a class - replace the fields you wrote with only on efield of type TDataArray - and write the functions to manipulate the data as methods of this class.
I would be careful here. I know the temptation is going to be to use a common interface and reflection, or some other automation that is more flexible and, frankly, more fun to write. Avoid this temptation. There is nothing wrong with listing every item in the list out according to your pattern. Patterns are good, and the code will be readable, easy to execute, and easy to modify any individual property that does not fit the pattern.
The low tech way to avoid typing everything out is to use our old friend Excel. Put all your properties in Column A, and then use this formula in column B:
= CONCATENATE("Data.", A1, ".NewValue := Data.", A1, ".SavedValue;", CHAR(10), "Data.", A1, ".OldValue := Data.", A1, ".SavedValue;", CHAR(10))