In many of my applications I have some data-objects which look something like this:
type
TMyObject = class
private
fInt: integer;
fDouble: double;
fBool: boolean;
public
property IntegerProp : integer read fInt write fInt;
property DoubleProp : double read fDouble write fDouble;
property BoolProp : boolean read fBool write fBool;
end;
Writing a SaveToFile and LoadFromFile for each is tedious work and if I change the object I have to change the two procedures as well. With Delphis support for RTTI and class helpers we can get rid of the tedious work.
I am using a class helper for TObject, so technically its possible to do this with every object.
TSerialHelper = class helper for TObject
private
function isPublicProperty(aProperty : TRttiProperty): boolean;
public
function Serialize(aHumanreadable : boolean = true) : string;
procedure Deserialize(const text : string);
end;
And here is the implementation:
function TSerialHelper.Serialize(aHumanreadable : boolean = true): string;
var
context : TRttiContext;
typ : TRttiType;
prop : TRttiProperty;
soJSON : ISuperObject;
value : TValue;
begin
context := TRttiContext.Create;
try
typ := context.GetType(self.ClassType);
soJSON := SO; // Get Superobject Interface
for prop in typ.GetProperties do
begin
if isPublicProperty(prop) and prop.IsWritable then
begin
value := prop.GetValue(self);
case value.Kind of
tkInteger, tkInt64 :
soJSON.I[prop.Name] := value.AsInteger;
tkEnumeration:
if value.IsType<boolean> then
soJSON.B[prop.Name] := value.AsBoolean;
tkFloat:
soJSON.D[prop.Name] := value.AsExtended;
tkChar, tkString, tkWChar, tkLString, tkWString, tkUString:
soJSON.S[prop.Name] := value.AsString;
end;
end;
end;
result := soJSON.AsJSon(aHumanreadable);
finally
context.Free;
end;
end;
procedure TSerialHelper.Deserialize(const text: string);
var
context : TRttiContext;
typ : TRttiType;
prop : TRttiProperty;
soJSON : ISuperObject;
begin
context := TRttiContext.Create;
try
soJSON := SO(text); // Init the Superobject Interface
typ := context.GetType(self.ClassType);
for prop in typ.GetProperties do
begin
if isPublicProperty(prop) and prop.IsWritable then
begin
case prop.PropertyType.TypeKind of
tkInteger, tkInt64 :
prop.SetValue(self, TValue.From<int64>(soJSON.I[prop.Name]));
tkEnumeration:
if prop.GetValue(self).IsType<boolean> then
prop.SetValue(self, TValue.From<boolean>(soJSON.B[prop.Name]));
tkFloat:
prop.SetValue(self, TValue.From<double>(soJSON.D[prop.Name]));
tkChar, tkString, tkWChar, tkLString, tkWString, tkUString:
prop.SetValue(self, TValue.From<string>(soJSON.S[prop.Name]));
end;
end;
end;
finally
context.Free;
end;
end;
function TSerialHelper.isPublicProperty(aProperty: TRttiProperty): boolean;
begin
result := aProperty.Visibility in [mvPublic, mvPublished];
end;
It is not finished, since it can't serialize sets, arrays or childobjects, but so far it works for simple objects.
You can download the unit
here.
This unit uses the
SuperObject by Henri Gourvest
