unit testunit;
{$mode delphi}
interface
uses
fgl;
type
TTestPropertyList = TFPGList<String>;
TTestStringsList = TFPGList<String>;
//forward
ITestCompoundObj = interface;
TTestCompoundObjs = TFPGInterfacedObjectList<ITestCompoundObj>;
ITestObj = interface
[{C961603D-2E3C-4EE6-B2A7-35C308842A2A}]
//property methods
function GetTestProperty:TTestPropertyList;
function GetTestStrings:TTestStringsList;
//properties
property TestProperty : TTestPropertyList read GetTestProperty write SetTestProperty;
property TestStrings : TTestStringsList read GetTestStrings write SetTestStrings;
//methods
function ToJSON:String;
function FromJSON:String;
end;
ITestCompoundObj = interface
[{601C0A11-3708-4B27-9265-AC2DC3664543}]
//property methods
function GetTestObj:ITestObj;
procedure SetTestObj(Const ATestObj:ITestObj);
//properties
property TestObj : ITestObj read GetTestObj write SetTestObj;
//methods
function ToJSON:String;
function FromJSON:String;
end;
ITestArrayObject = interface
[{39DABB47-5F26-4351-A6AB-E95E7EB417FB}]
//property methods
function GetTestArrayOfObjectsProperty:TTestCompoundObjs;
//properties
property TestArrayOfObjectsProperty : TTestCompoundObjs read GetTestArrayOfObjectsProperty;
//methods
function ToJSON:String;
function FromJSON:String;
end;
TTestObjImpl = class(TInterfacedObject,ITestObj)
public
const
PROP_TEST_PROPERTY = 'test_property';
PROP_TEST_STRINGS = 'test_strings';
strict private
FTestProperty: TTestPropertyList;
FTestStrings: TTestStringsList;
function GetTestProperty:TTestPropertyList;
function GetTestStrings:TTestStringsList;
strict protected
function DoToJSON:String;virtual;
function FromJSON:String;virtual;
public
property TestProperty : TTestPropertyList read GetTestProperty write SetTestProperty;
property TestStrings : TTestStringsList read GetTestStrings write SetTestStrings;
function ToJSON:String;
function FromJSON:String;
constructor Create;virtual;
destructor Destroy;override;
end;
TTestCompoundObjImpl = class(TInterfacedObject,ITestCompoundObj)
public
const
PROP_TEST_OBJ = 'test_object_property';
strict private
FTestObj: ITestObj;
function GetTestObj:ITestObj;
procedure SetTestObj(Const ATestObj:ITestObj);
strict protected
function DoToJSON:String;virtual;
function FromJSON:String;virtual;
public
property TestObj : ITestObj read GetTestObj write SetTestObj;
function ToJSON:String;
function FromJSON:String;
constructor Create;virtual;
destructor Destroy;override;
end;
TTestArrayObjectImpl = class(TInterfacedObject,ITestArrayObject)
public
const
PROP_TEST_COMPOUND_OBJ = 'test_array_of_objects_property';
strict private
FTestArrayOfObjectsProperty: TTestCompoundObjs;
function GetTestArrayOfObjectsProperty:TTestCompoundObjs;
strict protected
function DoToJSON:String;virtual;
function FromJSON:String;virtual;
public
property TestArrayOfObjectsProperty : TTestCompoundObjs read GetTestArrayOfObjectsProperty;
function ToJSON:String;
function FromJSON:String;
constructor Create;virtual;
destructor Destroy;override;
end;
implementation
uses
fpjson,jsonparser;
function TTestObjImpl.DoFromJSON(Const AJSON:String;Out Error:String):Boolean;virtual;
var
LData : TJSONData;
LObj : TJSONObject;
LArray : TJSONArray;
I : Integer;
begin
//init result
Result:=False;
try
//attempt to parse JSON object
LData:=GetJSON(AJSON);
if not Assigned(LData) or (LData.JsonType <> jtObject) then
raise Exception.Create('DoFromJSON::invalid JSON object in ' + Self.Classname);
//cast TJSONData -> TJSONObject
LObj:=TJSONObject(LData);
//assign our array to local variable
LArray:=LObj.Arrays[PROP_TEST_PROPERTY];
//iterate and add basic type to collection
for I:=0 to Pred(LArray.Count) do
FTestProperty.Add(LArray.Items[I].Value);
//assign our array to local variable
LArray:=LObj.Arrays[PROP_TEST_STRINGS];
//iterate and add basic type to collection
for I:=0 to Pred(LArray.Count) do
FTestStrings.Add(LArray.Items[I].Value);
//success
Result:=True;
except on E:Exception do
Error:=E.Message;
end;
end;
function TTestObjImpl.DoToJSON(Out JSON,Error:String):Boolean;virtual;
var
LObj : TJSONObject;
LArray : TJSONArray;
I : Integer;
begin
//init result
Result:=False;
try
LObj:=TJSONObject.Create;
try
//assign new array to local var
LArray:=TJSONArray.Create
for I:=0 to Pred(FTestProperty.Count) do
begin
//add basic type for private var to local array
LArray.Add(FTestProperty[I]);
end;
//add the array to result object (will free)
LObj.Add(PROP_TEST_PROPERTY,LArray)
//assign new array to local var
LArray:=TJSONArray.Create
for I:=0 to Pred(FTestStrings.Count) do
begin
//add basic type for private var to local array
LArray.Add(FTestStrings[I]);
end;
//add the array to result object (will free)
LObj.Add(PROP_TEST_STRINGS,LArray)
//set output
JSON:=LObj.ToJSON;
finally
LObj.Free
end;
//success
Result:=True;
except on E:Exception do
Error:=E.Message;
end;
end;
function TTestCompoundObjImpl.DoFromJSON(Const AJSON:String;Out Error:String):Boolean;virtual;
var
LData : TJSONData;
LObj : TJSONObject;
begin
//init result
Result:=False;
try
//attempt to parse JSON object
LData:=GetJSON(AJSON);
if not Assigned(LData) or (LData.JsonType <> jtObject) then
raise Exception.Create('DoFromJSON::invalid JSON object in ' + Self.Classname);
//cast TJSONData -> TJSONObject
LObj:=TJSONObject(LData);
FTestObj.FromJSON(LObj.Get(PROP_TEST_OBJ,'{}'));
//success
Result:=True;
except on E:Exception do
Error:=E.Message;
end;
end;
function TTestCompoundObjImpl.DoToJSON(Out JSON,Error:String):Boolean;virtual;
var
LObj : TJSONObject;
begin
//init result
Result:=False;
try
LObj:=TJSONObject.Create;
try
LObj.Add(PROP_TEST_OBJ,GetJSON(FTestObj.ToJSON));
//set output
JSON:=LObj.ToJSON;
finally
LObj.Free
end;
//success
Result:=True;
except on E:Exception do
Error:=E.Message;
end;
end;
function TTestArrayObjectImpl.DoFromJSON(Const AJSON:String;Out Error:String):Boolean;virtual;
var
LData : TJSONData;
LObj : TJSONObject;
LTestCompoundObj : ITestCompoundObj
begin
//init result
Result:=False;
try
//attempt to parse JSON object
LData:=GetJSON(AJSON);
if not Assigned(LData) or (LData.JsonType <> jtObject) then
raise Exception.Create('DoFromJSON::invalid JSON object in ' + Self.Classname);
//cast TJSONData -> TJSONObject
LObj:=TJSONObject(LData);
//assign our array to local variable
LArray:=LObj.Arrays[PROP_TEST_COMPOUND_OBJ];
//iterate and add object type to collection
for I:=0 to Pred(LArray.Count) do
begin
//first get a local reference
LTestCompoundObj:=TTestCompoundObjImpl.Create;
//attempt to deserialize with json at index
if not FTestArrayOfObjectsProperty.FromJSON(LArray.Items[I].Value,Error)) then
Exit;
//add to collection
FTestArrayOfObjectsProperty.Add(LTestCompoundObj);
//nil local reference before iterating again
LTestCompoundObj:=nil;
end;
//success
Result:=True;
except on E:Exception do
Error:=E.Message;
end;
end;
function TTestArrayObjectImpl.DoToJSON(Out JSON,Error:String):Boolean;virtual;
var
LObj : TJSONObject;
LArray : TJSONArray;
I : Integer;
begin
//init result
Result:=False;
try
LObj:=TJSONObject.Create;
try
//assign new array to local var
LArray:=TJSONArray.Create
for I:=0 to Pred(FTestArrayOfObjectsProperty.Count) do
begin
//add object type for private var to local array
LArray.Add(GetJSON(FTestArrayOfObjectsProperty[I].ToJSON));
end;
//add the array to result object (will free)
LObj.Add(PROP_TEST_COMPOUND_OBJ,LArray)
//set output
JSON:=LObj.ToJSON;
finally
LObj.Free
end;
//success
Result:=True;
except on E:Exception do
Error:=E.Message;
end;
end;
end.
WIKI Timeout issues
