program AttributeSerializerDemo;
{$ifdef fpc}{$mode delphi}{$H+}{$endif}
{$apptype console}
uses
SysUtils, TypInfo, Rtti;
// ---------------------------------------------------------------------------
// Custom attributes
// ---------------------------------------------------------------------------
type
{$ifndef fpc for Delphi compatibility}
TCustomAttributeArray = Tarray<TCustomAttribute>;
TStringArray = TArray<string>;
const
LineEnding = {$ifdef mswindows}#13#10{$else}#10{$endif};
type
{$endif}
{ Maps a property to a specific JSON key name }
JsonNameAttribute = class(TCustomAttribute)
private
FName: string;
public
constructor Create(const AName: string);virtual;
property Name: string read FName;
end;
{ Marks a property to be excluded from serialization }
JsonIgnoreAttribute = class(TCustomAttribute)
constructor create;
end;
constructor JsonNameAttribute.Create(const AName: string);
begin
FName := AName;
end;
constructor JsonIgnoreAttribute.Create;
begin
inherited create;
end;
// ---------------------------------------------------------------------------
// A realistic model class using the attributes
// ---------------------------------------------------------------------------
type
[JsonName('user')]
TUserProfile = class
private
FFirstName: string;
FLastName: string;
FEmail: string;
FAge: Integer;
FPassword: string;
published
[JsonName('first_name')]
property FirstName: string read FFirstName write FFirstName;
[JsonName('last_name')]
property LastName: string read FLastName write FLastName;
{ No attribute → property name used as-is, lowercased }
property Email: string read FEmail write FEmail;
property Age: Integer read FAge write FAge;
[JsonIgnore]
property Password: string read FPassword write FPassword;
end;
// ---------------------------------------------------------------------------
// The serializer — reads attributes via RTTI at runtime
// ---------------------------------------------------------------------------
type
TJsonSerializer = class
public
class function Serialize(AObject: TObject): string;
end;
class function TJsonSerializer.Serialize(AObject: TObject): string;
var
Ctx : TRttiContext;
RttiType : TRttiType;
Prop : TRttiProperty;
Attrs : TCustomAttributeArray;
Attr : TCustomAttribute;
JsonKey : string;
Skip : Boolean;
Value : TValue;
Parts : TStringArray;
I : Integer;
begin
Ctx := TRttiContext.Create;
try
RttiType := Ctx.GetType(AObject.ClassType);
Parts := Default(TStringArray);
for Prop in RttiType.GetProperties do
begin
if Prop.Visibility <> mvPublished then
Continue;
// Scan this property's attributes
JsonKey := LowerCase(Prop.Name); // default key
Skip := False;
Attrs := Prop.GetAttributes;
for Attr in Attrs do
begin
if Attr is JsonIgnoreAttribute then
Skip := True
else if Attr is JsonNameAttribute then
JsonKey := JsonNameAttribute(Attr).Name;
end;
if Skip then
Continue;
Value := Prop.GetValue(AObject);
// Build a simple "key": value pair
SetLength(Parts, Length(Parts) + 1);
case Prop.PropertyType.TypeKind of
tkInteger, tkInt64:
Parts[High(Parts)] := Format(' "%s": %s', [JsonKey, Value.ToString]);
else
Parts[High(Parts)] := Format(' "%s": "%s"', [JsonKey, Value.AsString]);
end;
end;
// Assemble the JSON object
Result := '{' + LineEnding;
for I := 0 to High(Parts) do
begin
Result := Result + Parts[I];
if I < High(Parts) then
Result := Result + ',';
Result := Result + LineEnding;
end;
Result := Result + '}';
finally
Ctx.Free;
end;
end;
// ---------------------------------------------------------------------------
// Demo
// ---------------------------------------------------------------------------
var
User: TUserProfile;
begin
User := TUserProfile.Create;
User.FirstName := 'Ada';
User.LastName := 'Lovelace';
User.Email := 'ada@babbage.io';
User.Age := 36;
User.Password := 's3cr3t!'; // should NOT appear in output
WriteLn(TJsonSerializer.Serialize(User));
User.Free;
end.