我需要使用一种REST API，该API返回类似于以下内容的JSON：
[
{
"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": ""
}
}
]
我可以使用TJSONObject.ParseJSONValue轻松地将此JSON格式转换为类。问题是我需要使用此json的数据打印报告。因此，将JSON转换为DataSet更加有趣。
在JSON存在之前，XML被大量使用。在对象拥有另一个对象的XML中，数据集必须具有一个数据集类型的字段，该字段将由另一个数据集引用。这样就可以将所有XML转换为DataSet。
我正在尝试使用本机组件TRESTResponseDataSetAdapter对JSON进行同样的操作。我已经看到可以为ResponseDataSetAdapter指定字段，并且每个字段都可以具有“子字段”。
因此，我将“ deliveryAddress”定义为DataSet类型并指定其“子字段”。但是，当我运行请求时，出现“ Invalid Argument”错误，然后出现另一个“ Invalid value for field“ deliveryAddress”错误。
是否可以使用TRESTResponseDataSetAdapter将JSON格式转换为DataSet？如果是，怎么办？还是有另一种方法？我不想转换为类，然后手动填充每个数据集。
示例项目：
服务器（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
客户
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