unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, fpjson, fpjsonrtti;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
function PersistentToJSONStr(const TheObj: TPersistent; const SingleLine: Boolean = FALSE; const IndentSize: Integer = 3): TJSONStringType;
implementation
{$R *.lfm}
type
{ TBasicWork }
TBasicWork = Class(TPersistent)
private
FWorkName_1: string;
public
constructor Create;
published
property WorkName_1: string read FWorkName_1 write FWorkName_1;
end;
TBasicWorkClass = class of TBasicWork;
{ TMyWork }
TMyWork = class(TBasicWork)
public
constructor Create;
end;
{ TBasicWork2 }
TBasicWork2 = Class(TPersistent)
private
FWorkName_2: string;
public
constructor Create;
published
property WorkName_2: string read FWorkName_2 write FWorkName_2;
end;
TBasicWork2Class = class of TBasicWork2;
{ TMyWork2 }
TMyWork2 = class(TBasicWork2)
public
constructor Create;
end;
{ TBasicWork3 }
TBasicWork3 = Class(TPersistent)
private
FWorkName_3: string;
public
constructor Create; virtual;
published
property WorkName_3: string read FWorkName_3 write FWorkName_3;
end;
TBasicWork3Class = class of TBasicWork3;
{ TMyWork3 }
TMyWork3 = class(TBasicWork3)
public
constructor Create; override;
end;
{ TBasicWork }
constructor TBasicWork.Create;
begin
WorkName_1 := '';
end;
{ TMyWork }
constructor TMyWork.Create;
begin
WorkName_1 := 'MyWork';
end;
{ TBasicWork2 }
constructor TBasicWork2.Create;
begin
inherited Create;
WorkName_2 := '';
end;
{ TMyWork2 }
constructor TMyWork2.Create;
begin
inherited Create;
WorkName_2 := 'MyWork2';
end;
{ TBasicWork3 }
constructor TBasicWork3.Create;
begin
inherited Create;
WorkName_3 := '';
end;
{ TMyWork3 }
constructor TMyWork3.Create;
begin
inherited Create;
WorkName_3 := 'MyWork3';
end;
function PersistentToJSONStr(const TheObj: TPersistent; const SingleLine: Boolean; const IndentSize: Integer): TJSONStringType;
var
JObj: TJSONObject;
FJStreamer: TJSONStreamer;
begin
Result := '';
FJStreamer := nil;
JObj := nil;
FJStreamer := TJSONStreamer.Create(nil);
try
// CONFIGURACIONES PARA EL STREAMER DE JSON //
//FJStreamer.ComponentStyle := [
// csInheritable
// //,csCheckPropAvail
// ,csSubComponent
// //,csTransient
// ];
//FJsonFormatOptions := [foSingleLineArray // Array without CR/LF : all on one line
// ,foSingleLineObject // Object without CR/LF : all on one line
// ,foDoNotQuoteMembers // Do not quote object member names.
// ,foUseTabchar // Use tab characters instead of spaces.
// ,foSkipWhiteSpace // Do not use whitespace at all
// ];
FJStreamer.DateTimeFormat := 'YYYY-MM-DDTHH:NN:SS.ZZZ';
FJStreamer.Options := FJStreamer.Options + [jsoComponentsInline // Always stream components inline. Default is to stream name, unless csSubcomponent in ComponentStyle
,jsoDateTimeAsString // Format a TDateTime value as a string
];
//FJStreamer.Options := [
// jsoStreamChildren // If set, children will be streamed in 'Children' Property
// //,jsoEnumeratedAsInteger // Write enumerated as Integer. Default is string.
// ,jsoSetAsString // Write Set as a string. Default is an array.
// //,jsoSetEnumeratedAsInteger // Write enumerateds in set array as integers.
// ,jsoSetBrackets // Use brackets when creating set as array
// ,jsoComponentsInline // Always stream components inline. Default is to stream name, unless csSubcomponent in ComponentStyle
// ,jsoTStringsAsArray // Stream TStrings as an array of strings. Associated objects are not streamed.
// //,jsoTStringsAsObject // Stream TStrings as an object : string = { object }
// ,jsoDateTimeAsString // Format a TDateTime value as a string
// ,jsoUseFormatString // Use FormatString when creating JSON strings.
// ,jsoCheckEmptyDateTime // If TDateTime value is empty and jsoDateTimeAsString is used, 0 date returns empty string
// ];
if SingleLine then begin
Result := FJStreamer.ObjectToJSONString(TheObj);
end
else begin
JObj := FJStreamer.ObjectToJSON(TheObj);
Result := JObj.FormatJSON(DefaultFormat, IndentSize);
end;
finally
FreeAndNil(JObj );
FreeAndNil(FJStreamer);
end;
end; {<--- PersistentToJSONStr }
function GetBasicWorkJsonStr(const AClass: TBasicWorkClass): string;
var
AnObj: TBasicWork;
begin
Result := '';
AnObj := AClass.Create;
try
Result := PersistentToJSONStr(AnObj, TRUE);
finally
FreeAndNil(AnObj);
end;
end;
function GetBasicWork2JsonStr(const AClass: TBasicWork2Class): string;
var
AnObj: TBasicWork2;
begin
Result := '';
AnObj := AClass.Create;
try
Result := PersistentToJSONStr(AnObj, TRUE);
finally
FreeAndNil(AnObj);
end;
end;
function GetBasicWork3JsonStr(const AClass: TBasicWork3Class): string;
var
AnObj: TBasicWork3;
begin
Result := '';
AnObj := AClass.Create;
try
Result := PersistentToJSONStr(AnObj, TRUE);
finally
FreeAndNil(AnObj);
end;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
AnObj: TMyWork;
AnObj2: TMyWork2;
AnObj3: TMyWork3;
begin
AnObj := TMyWork.Create;
AnObj2 := TMyWork2.Create;
AnObj3 := TMyWork3.Create;
try
Memo1.Lines.Add(PersistentToJSONStr(AnObj, TRUE));
Memo1.Lines.Add(PersistentToJSONStr(AnObj2, TRUE));
Memo1.Lines.Add(PersistentToJSONStr(AnObj3, TRUE));
finally
FreeAndNil(AnObj);
FreeAndNil(AnObj2);
FreeAndNil(AnObj3);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Lines.Add(GetBasicWorkJsonStr(TMyWork));
Memo1.Lines.Add(GetBasicWork2JsonStr(TMyWork2));
Memo1.Lines.Add(GetBasicWork3JsonStr(TMyWork3));
end;
end.