23.10.2011

Delphi and RTTI / Class Helper

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

3 Kommentare:

Lars Fosdal hat gesagt…

You might want to check that the property is not read-only.

Unknown hat gesagt…

Thanks! I have updated the code.

Lars Fosdal hat gesagt…

And perhaps not a class property?