Convert JSON to DataSet with TRESTResponseDataSetAdapter - json

Question

I need to consume a REST API that returns a JSON that resembles the following:
[
{
"purchaseCode": 1,
"totalItems": 5,
"totalPrice": 5102.04,
"deliveryAddress": {
"name": "Michael Jennette",
"country": "Brazil",
"state": "São Paulo",
"postCode": "16",
"landmark": ""
}
},
{
"purchaseCode": 2,
"totalItems": 3,
"totalPrice": 4312.65,
"deliveryAddress": {
"name": "David Samuel",
"country": "Brazil",
"state": "São Paulo",
"postCode": "40",
"landmark": ""
}
}
]
I can easily convert this JSON format to a class using TJSONObject.ParseJSONValue. The problem is that I need to print reports with this json's data. So it's more interesting to convert JSON to DataSet.
Before JSON existed, XML was heavily used. In XMLs that an object owned another object, the DataSet had to have a field of type DataSet that would be referenced by another DataSet. This way it is possible to convert all XML to DataSet.
I'm trying to do the same with JSON using the native component TRESTResponseDataSetAdapter. I have seen that I can specify the fields for ResponseDataSetAdapter and that each field can have "child fields".
Therefore, I defined "deliveryAddress" as the DataSet type and specified its "child fields". But when I run the request, I get an "Invalid Argument" error and then another "Invalid value for field "deliveryAddress" error.
Is it possible to convert this JSON format to DataSet using TRESTResponseDataSetAdapter? If yes, how? Or is there another way? I did not want to have to convert to classes and then manually fill each DataSet.
Sample project:
Server (WebBroker)
Project1.dpr
program Project1;
{$APPTYPE CONSOLE}
uses
System.SysUtils,
System.Types,
IPPeerServer,
IPPeerAPI,
IdHTTPWebBrokerBridge,
Web.WebReq,
Web.WebBroker,
WebModuleUnit1 in 'WebModuleUnit1.pas' {WebModule1: TWebModule},
ServerConst1 in 'ServerConst1.pas';
{$R *.res}
function BindPort(Aport: Integer): Boolean;
var
LTestServer: IIPTestServer;
begin
Result := True;
try
LTestServer := PeerFactory.CreatePeer('', IIPTestServer) as IIPTestServer;
LTestServer.TestOpenPort(APort, nil);
except
Result := False;
end;
end;
function CheckPort(Aport: Integer): Integer;
begin
if BindPort(Aport) then
Result := Aport
else
Result := 0;
end;
procedure SetPort(const Aserver: TIdHTTPWebBrokerBridge; APort: String);
begin
if not (Aserver.Active) then
begin
APort := APort.Replace(cCommandSetPort, '').Trim;
if CheckPort(APort.ToInteger) > 0 then
begin
Aserver.DefaultPort := APort.ToInteger;
Writeln(Format(sPortSet, [APort]));
end
else
Writeln(Format(sPortInUse, [Aport]));
end
else
Writeln(sServerRunning);
Write(cArrow);
end;
procedure StartServer(const Aserver: TIdHTTPWebBrokerBridge);
begin
if not (Aserver.Active) then
begin
if CheckPort(Aserver.DefaultPort) > 0 then
begin
Writeln(Format(sStartingServer, [Aserver.DefaultPort]));
Aserver.Bindings.Clear;
Aserver.Active := True;
end
else
Writeln(Format(sPortInUse, [Aserver.DefaultPort.ToString]));
end
else
Writeln(sServerRunning);
Write(cArrow);
end;
procedure StopServer(const Aserver: TIdHTTPWebBrokerBridge);
begin
if Aserver.Active then
begin
Writeln(sStoppingServer);
Aserver.Active := False;
Aserver.Bindings.Clear;
Writeln(sServerStopped);
end
else
Writeln(sServerNotRunning);
Write(cArrow);
end;
procedure WriteCommands;
begin
Writeln(sCommands);
Write(cArrow);
end;
procedure WriteStatus(const Aserver: TIdHTTPWebBrokerBridge);
begin
Writeln(sIndyVersion + Aserver.SessionList.Version);
Writeln(sActive + Aserver.Active.ToString(TUseBoolStrs.True));
Writeln(sPort + Aserver.DefaultPort.ToString);
Writeln(sSessionID + Aserver.SessionIDCookieName);
Write(cArrow);
end;
procedure RunServer(APort: Integer);
var
LServer: TIdHTTPWebBrokerBridge;
LResponse: string;
begin
WriteCommands;
LServer := TIdHTTPWebBrokerBridge.Create(nil);
try
LServer.DefaultPort := APort;
while True do
begin
Readln(LResponse);
LResponse := LowerCase(LResponse);
if LResponse.StartsWith(cCommandSetPort) then
SetPort(LServer, LResponse)
else if sametext(LResponse, cCommandStart) then
StartServer(LServer)
else if sametext(LResponse, cCommandStatus) then
WriteStatus(LServer)
else if sametext(LResponse, cCommandStop) then
StopServer(LServer)
else if sametext(LResponse, cCommandHelp) then
WriteCommands
else if sametext(LResponse, cCommandExit) then
if LServer.Active then
begin
StopServer(LServer);
break
end
else
break
else
begin
Writeln(sInvalidCommand);
Write(cArrow);
end;
end;
finally
LServer.Free;
end;
end;
begin
try
if WebRequestHandler <> nil then
WebRequestHandler.WebModuleClass := WebModuleClass;
RunServer(8080);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end
end.
ServerConst1.pas
unit ServerConst1;
interface
resourcestring
sPortInUse = '- Error: Port %s already in use';
sPortSet = '- Port set to %s';
sServerRunning = '- The Server is already running';
sStartingServer = '- Starting HTTP Server on port %d';
sStoppingServer = '- Stopping Server';
sServerStopped = '- Server Stopped';
sServerNotRunning = '- The Server is not running';
sInvalidCommand = '- Error: Invalid Command';
sIndyVersion = '- Indy Version: ';
sActive = '- Active: ';
sPort = '- Port: ';
sSessionID = '- Session ID CookieName: ';
sCommands = 'Enter a Command: ' + slineBreak +
' - "start" to start the server'+ slineBreak +
' - "stop" to stop the server'+ slineBreak +
' - "set port" to change the default port'+ slineBreak +
' - "status" for Server status'+ slineBreak +
' - "help" to show commands'+ slineBreak +
' - "exit" to close the application';
const
cArrow = '->';
cCommandStart = 'start';
cCommandStop = 'stop';
cCommandStatus = 'status';
cCommandHelp = 'help';
cCommandSetPort = 'set port';
cCommandExit = 'exit';
implementation
end.
WebModuleUnit1.pas
unit WebModuleUnit1;
interface
uses System.SysUtils, System.Classes, Web.HTTPApp;
type
TWebModule1 = class(TWebModule)
procedure WebModule1jsonAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
WebModuleClass: TComponentClass = TWebModule1;
implementation
{%CLASSGROUP 'System.Classes.TPersistent'}
{$R *.dfm}
procedure TWebModule1.WebModule1jsonAction(Sender: TObject; Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Response.ContentType := 'application/json; charset=utf-8';
Response.Content :=
'[{"purchaseCode":1,"totalItems":5,"totalPrice":5102.04,"deliveryAddress":{"name":"Michael Jennette","country":"Brazil","state":"S\u00E3o Paulo","postCode":"16","landmark":""}},' +
'{"purchaseCode":2,"totalItems":3,"totalPrice":4312.65,"deliveryAddress":{"name":"David Samuel","country":"Brazil","state":"S\u00E3o Paulo","postCode":"40","landmark":""}}]';
end;
end.
WebModuleUnit1.dfm
object WebModule1: TWebModule1
OldCreateOrder = False
Actions = <
item
MethodType = mtGet
Name = 'json'
PathInfo = '/json'
OnAction = WebModule1jsonAction
end>
Height = 230
Width = 415
end
Client
Client1.dpr
program Client1;
uses
Vcl.Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Unit1.pas
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, IPPeerClient, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Comp.DataSet, FireDAC.Comp.Client,
REST.Response.Adapter, REST.Client, Data.Bind.Components, Data.Bind.ObjectScope, Vcl.Grids, Vcl.DBGrids, Vcl.StdCtrls;
type
TForm1 = class(TForm)
btnRequest: TButton;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
RESTClient1: TRESTClient;
RESTRequest1: TRESTRequest;
RESTResponse1: TRESTResponse;
RESTResponseDataSetAdapter1: TRESTResponseDataSetAdapter;
FDMemTable1: TFDMemTable;
FDMemTable2: TFDMemTable;
FDMemTable1purchaseCode: TIntegerField;
FDMemTable1totalItems: TIntegerField;
FDMemTable1totalPrice: TCurrencyField;
FDMemTable1deliveryAddress: TDataSetField;
FDMemTable2name: TStringField;
FDMemTable2country: TStringField;
FDMemTable2state: TStringField;
FDMemTable2postCode: TStringField;
FDMemTable2landmark: TStringField;
procedure btnRequestClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnRequestClick(Sender: TObject);
begin
RESTRequest1.Execute;
end;
end.
Unit1.dfm
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 362
ClientWidth = 724
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object btnRequest: TButton
Left = 24
Top = 24
Width = 75
Height = 25
Caption = 'Request'
TabOrder = 0
OnClick = btnRequestClick
end
object DBGrid1: TDBGrid
Left = 296
Top = 48
Width = 409
Height = 297
DataSource = DataSource1
TabOrder = 1
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
end
object DataSource1: TDataSource
DataSet = FDMemTable1
Left = 232
Top = 152
end
object RESTClient1: TRESTClient
Accept = 'application/json, text/plain; q=0.9, text/html;q=0.8,'
AcceptCharset = 'UTF-8, *;q=0.8'
BaseURL = 'http://localhost:8080/json'
Params = <>
HandleRedirects = True
RaiseExceptionOn500 = False
Left = 32
Top = 64
end
object RESTRequest1: TRESTRequest
Client = RESTClient1
Params = <>
Response = RESTResponse1
SynchronizedEvents = False
Left = 32
Top = 112
end
object RESTResponse1: TRESTResponse
ContentType = 'application/json'
Left = 32
Top = 160
end
object RESTResponseDataSetAdapter1: TRESTResponseDataSetAdapter
Dataset = FDMemTable1
FieldDefs = <
item
Name = 'purchaseCode'
DataType = ftInteger
end
item
Name = 'totalItems'
DataType = ftInteger
end
item
Name = 'totalPrice'
DataType = ftCurrency
end
item
Name = 'deliveryAddress'
ChildDefs = <
item
Name = 'name'
DataType = ftString
Size = 150
end
item
Name = 'country'
DataType = ftString
Size = 150
end
item
Name = 'state'
DataType = ftString
Size = 150
end
item
Name = 'postCode'
DataType = ftString
Size = 50
end
item
Name = 'landmark'
DataType = ftString
Size = 150
end>
DataType = ftDataSet
Size = 5
end>
Response = RESTResponse1
Left = 32
Top = 216
end
object FDMemTable1: TFDMemTable
FetchOptions.AssignedValues = [evMode]
FetchOptions.Mode = fmAll
ResourceOptions.AssignedValues = [rvSilentMode]
ResourceOptions.SilentMode = True
UpdateOptions.AssignedValues = [uvCheckRequired]
UpdateOptions.CheckRequired = False
Left = 168
Top = 152
object FDMemTable1purchaseCode: TIntegerField
FieldName = 'purchaseCode'
end
object FDMemTable1totalItems: TIntegerField
FieldName = 'totalItems'
end
object FDMemTable1totalPrice: TCurrencyField
FieldName = 'totalPrice'
end
object FDMemTable1deliveryAddress: TDataSetField
FieldName = 'deliveryAddress'
end
end
object FDMemTable2: TFDMemTable
FetchOptions.AssignedValues = [evMode]
FetchOptions.Mode = fmAll
ResourceOptions.AssignedValues = [rvSilentMode]
ResourceOptions.SilentMode = True
UpdateOptions.AssignedValues = [uvCheckRequired]
UpdateOptions.CheckRequired = False
Left = 168
Top = 224
object FDMemTable2name: TStringField
FieldName = 'name'
Size = 150
end
object FDMemTable2country: TStringField
FieldName = 'country'
Size = 150
end
object FDMemTable2state: TStringField
FieldName = 'state'
Size = 150
end
object FDMemTable2postCode: TStringField
FieldName = 'postCode'
Size = 50
end
object FDMemTable2landmark: TStringField
FieldName = 'landmark'
Size = 150
end
end
end