mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 15:55:54 +01:00
Improved JSON-RPC support
Improved JSON-RPC sample
This commit is contained in:
Daniele Teti
parent
ac654658f1
commit
84ccc385c1
@ -2,8 +2,8 @@ object Form10: TForm10
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = 'Form10'
|
||||
ClientHeight = 544
|
||||
ClientWidth = 508
|
||||
ClientHeight = 448
|
||||
ClientWidth = 831
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
@ -11,116 +11,153 @@ object Form10: TForm10
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
OnCreate = FormCreate
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object edtValue1: TEdit
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 8
|
||||
Top = 8
|
||||
Width = 89
|
||||
Top = 16
|
||||
Width = 815
|
||||
Height = 124
|
||||
Caption = 'Simple Types'
|
||||
TabOrder = 0
|
||||
object edtValue1: TEdit
|
||||
Left = 17
|
||||
Top = 32
|
||||
Width = 70
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
Text = '42'
|
||||
end
|
||||
object edtValue2: TEdit
|
||||
Left = 103
|
||||
Top = 8
|
||||
Width = 89
|
||||
Left = 93
|
||||
Top = 32
|
||||
Width = 70
|
||||
Height = 21
|
||||
TabOrder = 1
|
||||
Text = '10'
|
||||
end
|
||||
object btnSubstract: TButton
|
||||
Left = 198
|
||||
Top = 6
|
||||
Width = 91
|
||||
Left = 169
|
||||
Top = 30
|
||||
Width = 100
|
||||
Height = 25
|
||||
Caption = 'Subtract'
|
||||
TabOrder = 2
|
||||
OnClick = btnSubstractClick
|
||||
end
|
||||
object edtResult: TEdit
|
||||
Left = 295
|
||||
Top = 8
|
||||
Width = 74
|
||||
Left = 273
|
||||
Top = 32
|
||||
Width = 70
|
||||
Height = 21
|
||||
ReadOnly = True
|
||||
TabOrder = 3
|
||||
end
|
||||
object edtReverseString: TEdit
|
||||
Left = 8
|
||||
Top = 56
|
||||
Width = 184
|
||||
Left = 17
|
||||
Top = 80
|
||||
Width = 144
|
||||
Height = 21
|
||||
TabOrder = 4
|
||||
Text = 'Daniele Teti'
|
||||
end
|
||||
object btnReverseString: TButton
|
||||
Left = 198
|
||||
Top = 54
|
||||
Width = 91
|
||||
Left = 167
|
||||
Top = 78
|
||||
Width = 100
|
||||
Height = 25
|
||||
Caption = 'Reverse String'
|
||||
TabOrder = 5
|
||||
OnClick = btnReverseStringClick
|
||||
end
|
||||
object edtReversedString: TEdit
|
||||
Left = 295
|
||||
Top = 56
|
||||
Width = 202
|
||||
Left = 273
|
||||
Top = 80
|
||||
Width = 178
|
||||
Height = 21
|
||||
ReadOnly = True
|
||||
TabOrder = 6
|
||||
end
|
||||
object edtFilter: TEdit
|
||||
Left = 8
|
||||
Top = 245
|
||||
Width = 184
|
||||
object dtNextMonday: TDateTimePicker
|
||||
Left = 501
|
||||
Top = 30
|
||||
Width = 102
|
||||
Height = 21
|
||||
Date = 43018.469176562500000000
|
||||
Time = 43018.469176562500000000
|
||||
TabOrder = 7
|
||||
end
|
||||
object edtGetCustomers: TButton
|
||||
Left = 198
|
||||
Top = 243
|
||||
Width = 91
|
||||
object btnAddDay: TButton
|
||||
Left = 609
|
||||
Top = 30
|
||||
Width = 128
|
||||
Height = 25
|
||||
Caption = 'Get Customers'
|
||||
Caption = 'Get Next Monday'
|
||||
TabOrder = 8
|
||||
OnClick = edtGetCustomersClick
|
||||
OnClick = btnAddDayClick
|
||||
end
|
||||
object DBGrid1: TDBGrid
|
||||
Left = 8
|
||||
Top = 272
|
||||
Width = 489
|
||||
Height = 264
|
||||
DataSource = DataSource1
|
||||
object btnInvalid1: TButton
|
||||
Left = 582
|
||||
Top = 78
|
||||
Width = 112
|
||||
Height = 43
|
||||
Caption = 'Passing VAR parameters'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clScrollBar
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 9
|
||||
TitleFont.Charset = DEFAULT_CHARSET
|
||||
TitleFont.Color = clWindowText
|
||||
TitleFont.Height = -11
|
||||
TitleFont.Name = 'Tahoma'
|
||||
TitleFont.Style = []
|
||||
WordWrap = True
|
||||
OnClick = btnInvalid1Click
|
||||
end
|
||||
object edtUserName: TEdit
|
||||
object btnInvalid2: TButton
|
||||
Left = 700
|
||||
Top = 78
|
||||
Width = 112
|
||||
Height = 43
|
||||
Caption = 'Passing OUT parameters'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clScrollBar
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 10
|
||||
WordWrap = True
|
||||
OnClick = btnInvalid2Click
|
||||
end
|
||||
end
|
||||
object GroupBox2: TGroupBox
|
||||
Left = 8
|
||||
Top = 104
|
||||
Top = 146
|
||||
Width = 489
|
||||
Height = 159
|
||||
Caption = 'Returning Objects'
|
||||
TabOrder = 1
|
||||
object edtUserName: TEdit
|
||||
Left = 16
|
||||
Top = 24
|
||||
Width = 184
|
||||
Height = 21
|
||||
TabOrder = 10
|
||||
TabOrder = 0
|
||||
Text = 'dteti'
|
||||
end
|
||||
object btnGetUser: TButton
|
||||
Left = 198
|
||||
Top = 102
|
||||
Left = 206
|
||||
Top = 22
|
||||
Width = 91
|
||||
Height = 25
|
||||
Caption = 'Get User'
|
||||
TabOrder = 11
|
||||
TabOrder = 1
|
||||
OnClick = btnGetUserClick
|
||||
end
|
||||
object lbPerson: TListBox
|
||||
Left = 8
|
||||
Top = 133
|
||||
Width = 489
|
||||
Left = 16
|
||||
Top = 53
|
||||
Width = 435
|
||||
Height = 82
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
@ -128,12 +165,108 @@ object Form10: TForm10
|
||||
Font.Name = 'Courier New'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 12
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
object GroupBox3: TGroupBox
|
||||
Left = 509
|
||||
Top = 146
|
||||
Width = 314
|
||||
Height = 294
|
||||
Caption = 'Returning Datasets'
|
||||
TabOrder = 2
|
||||
object edtFilter: TEdit
|
||||
Left = 18
|
||||
Top = 32
|
||||
Width = 184
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
end
|
||||
object edtGetCustomers: TButton
|
||||
Left = 208
|
||||
Top = 30
|
||||
Width = 91
|
||||
Height = 25
|
||||
Caption = 'Get Customers'
|
||||
TabOrder = 1
|
||||
OnClick = edtGetCustomersClick
|
||||
end
|
||||
object DBGrid1: TDBGrid
|
||||
Left = 18
|
||||
Top = 61
|
||||
Width = 279
|
||||
Height = 204
|
||||
DataSource = DataSource1
|
||||
TabOrder = 2
|
||||
TitleFont.Charset = DEFAULT_CHARSET
|
||||
TitleFont.Color = clWindowText
|
||||
TitleFont.Height = -11
|
||||
TitleFont.Name = 'Tahoma'
|
||||
TitleFont.Style = []
|
||||
end
|
||||
end
|
||||
object GroupBox4: TGroupBox
|
||||
Left = 8
|
||||
Top = 311
|
||||
Width = 489
|
||||
Height = 129
|
||||
Caption = 'Passing Objects as parameters'
|
||||
TabOrder = 3
|
||||
object edtFirstName: TLabeledEdit
|
||||
Left = 16
|
||||
Top = 40
|
||||
Width = 121
|
||||
Height = 21
|
||||
EditLabel.Width = 51
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'First Name'
|
||||
TabOrder = 0
|
||||
Text = 'Daniele'
|
||||
end
|
||||
object edtLastName: TLabeledEdit
|
||||
Left = 16
|
||||
Top = 88
|
||||
Width = 121
|
||||
Height = 21
|
||||
EditLabel.Width = 50
|
||||
EditLabel.Height = 13
|
||||
EditLabel.Caption = 'Last Name'
|
||||
TabOrder = 1
|
||||
Text = 'Teti'
|
||||
end
|
||||
object chkMarried: TCheckBox
|
||||
Left = 172
|
||||
Top = 40
|
||||
Width = 97
|
||||
Height = 17
|
||||
Caption = 'Married'
|
||||
Checked = True
|
||||
State = cbChecked
|
||||
TabOrder = 2
|
||||
end
|
||||
object dtDOB: TDateTimePicker
|
||||
Left = 169
|
||||
Top = 88
|
||||
Width = 102
|
||||
Height = 21
|
||||
Date = 29163.469176562500000000
|
||||
Time = 29163.469176562500000000
|
||||
TabOrder = 3
|
||||
end
|
||||
object btnSave: TButton
|
||||
Left = 376
|
||||
Top = 88
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = 'Save'
|
||||
TabOrder = 4
|
||||
OnClick = btnSaveClick
|
||||
end
|
||||
end
|
||||
object DataSource1: TDataSource
|
||||
DataSet = FDMemTable1
|
||||
Left = 256
|
||||
Top = 280
|
||||
Left = 767
|
||||
Top = 184
|
||||
end
|
||||
object FDMemTable1: TFDMemTable
|
||||
FetchOptions.AssignedValues = [evMode]
|
||||
@ -143,8 +276,8 @@ object Form10: TForm10
|
||||
UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
|
||||
UpdateOptions.CheckRequired = False
|
||||
UpdateOptions.AutoCommitUpdates = True
|
||||
Left = 256
|
||||
Top = 344
|
||||
Left = 767
|
||||
Top = 248
|
||||
object FDMemTable1Code: TIntegerField
|
||||
FieldName = 'Code'
|
||||
end
|
||||
|
||||
@ -8,10 +8,15 @@ uses
|
||||
System.Net.URLClient, System.Net.HttpClient, Data.DB, Vcl.Grids, Vcl.DBGrids,
|
||||
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;
|
||||
FireDAC.Comp.DataSet, FireDAC.Comp.Client, Vcl.ComCtrls, Vcl.ExtCtrls;
|
||||
|
||||
type
|
||||
TForm10 = class(TForm)
|
||||
DataSource1: TDataSource;
|
||||
FDMemTable1: TFDMemTable;
|
||||
FDMemTable1Code: TIntegerField;
|
||||
FDMemTable1Name: TStringField;
|
||||
GroupBox1: TGroupBox;
|
||||
edtValue1: TEdit;
|
||||
edtValue2: TEdit;
|
||||
btnSubstract: TButton;
|
||||
@ -19,20 +24,33 @@ type
|
||||
edtReverseString: TEdit;
|
||||
btnReverseString: TButton;
|
||||
edtReversedString: TEdit;
|
||||
edtFilter: TEdit;
|
||||
edtGetCustomers: TButton;
|
||||
DBGrid1: TDBGrid;
|
||||
DataSource1: TDataSource;
|
||||
FDMemTable1: TFDMemTable;
|
||||
FDMemTable1Code: TIntegerField;
|
||||
FDMemTable1Name: TStringField;
|
||||
GroupBox2: TGroupBox;
|
||||
edtUserName: TEdit;
|
||||
btnGetUser: TButton;
|
||||
lbPerson: TListBox;
|
||||
GroupBox3: TGroupBox;
|
||||
edtFilter: TEdit;
|
||||
edtGetCustomers: TButton;
|
||||
DBGrid1: TDBGrid;
|
||||
GroupBox4: TGroupBox;
|
||||
edtFirstName: TLabeledEdit;
|
||||
edtLastName: TLabeledEdit;
|
||||
chkMarried: TCheckBox;
|
||||
dtDOB: TDateTimePicker;
|
||||
btnSave: TButton;
|
||||
dtNextMonday: TDateTimePicker;
|
||||
btnAddDay: TButton;
|
||||
btnInvalid1: TButton;
|
||||
btnInvalid2: TButton;
|
||||
procedure btnSubstractClick(Sender: TObject);
|
||||
procedure btnReverseStringClick(Sender: TObject);
|
||||
procedure edtGetCustomersClick(Sender: TObject);
|
||||
procedure btnGetUserClick(Sender: TObject);
|
||||
procedure btnSaveClick(Sender: TObject);
|
||||
procedure btnAddDayClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure btnInvalid1Click(Sender: TObject);
|
||||
procedure btnInvalid2Click(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
public
|
||||
@ -46,7 +64,8 @@ implementation
|
||||
|
||||
uses
|
||||
MVCFramework.JSONRPC, MVCFramework.Serializer.JsonDataObjects,
|
||||
JsonDataObjects, MVCFramework.Serializer.Commons, MVCFramework.DataSet.Utils;
|
||||
JsonDataObjects, MVCFramework.Serializer.Commons, MVCFramework.DataSet.Utils,
|
||||
BusinessObjectsU;
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
@ -86,6 +105,27 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm10.btnAddDayClick(Sender: TObject);
|
||||
var
|
||||
lReq: TJSONRPCRequest;
|
||||
lResp: TJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
try
|
||||
lReq.Method := 'getnextmonday';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add(dtNextMonday.Date);
|
||||
JSONRPCExec('http://localhost:8080/jsonrpc', lReq, lResp);
|
||||
try
|
||||
dtNextMonday.Date := ISOTimeStampToDateTime(lResp.Result.AsString);
|
||||
finally
|
||||
lResp.Free;
|
||||
end;
|
||||
finally
|
||||
lReq.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm10.btnGetUserClick(Sender: TObject);
|
||||
var
|
||||
lReq: TJSONRPCRequest;
|
||||
@ -96,7 +136,7 @@ begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
try
|
||||
lReq.Method := 'getuser';
|
||||
lReq.ID := Random(1000);
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add(edtUserName.Text);
|
||||
JSONRPCExec('http://localhost:8080/jsonrpc', lReq, lResp);
|
||||
try
|
||||
@ -118,6 +158,47 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm10.btnInvalid1Click(Sender: TObject);
|
||||
var
|
||||
lReq: TJSONRPCRequest;
|
||||
lResp: TJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
try
|
||||
lReq.Method := 'invalidmethod1';
|
||||
lReq.Params.Add(1);
|
||||
JSONRPCExec('http://localhost:8080/jsonrpc', lReq, lResp);
|
||||
try
|
||||
ShowMessage(lResp.Error.ErrMessage);
|
||||
finally
|
||||
lResp.Free;
|
||||
end;
|
||||
finally
|
||||
lReq.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm10.btnInvalid2Click(Sender: TObject);
|
||||
var
|
||||
lReq: TJSONRPCRequest;
|
||||
lResp: TJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
try
|
||||
lReq.Method := 'invalidmethod2';
|
||||
lReq.Params.Add(1);
|
||||
JSONRPCExec('http://localhost:8080/jsonrpc', lReq, lResp);
|
||||
try
|
||||
ShowMessage(lResp.Error.ErrMessage);
|
||||
finally
|
||||
lResp.Free;
|
||||
end;
|
||||
finally
|
||||
lReq.Free;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TForm10.btnReverseStringClick(Sender: TObject);
|
||||
var
|
||||
lReq: TJSONRPCRequest;
|
||||
@ -126,7 +207,7 @@ begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
try
|
||||
lReq.Method := 'reversestring';
|
||||
lReq.ID := Random(1000);
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add(edtReverseString.Text);
|
||||
JSONRPCExec('http://localhost:8080/jsonrpc', lReq, lResp);
|
||||
try
|
||||
@ -139,6 +220,33 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm10.btnSaveClick(Sender: TObject);
|
||||
var
|
||||
lPerson: TPerson;
|
||||
lReq: TJSONRPCRequest;
|
||||
lResp: TJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
try
|
||||
lReq.Method := 'saveperson';
|
||||
lReq.RequestID := Random(1000);
|
||||
lPerson := TPerson.Create;
|
||||
lReq.Params.Add(lperson);
|
||||
lPerson.FirstName := edtFirstName.Text;
|
||||
lPerson.LastName := edtLastName.Text;
|
||||
lPerson.Married := chkMarried.Checked;
|
||||
lPerson.DOB := dtDOB.Date;
|
||||
JSONRPCExec('http://localhost:8080/jsonrpc', lReq, lResp);
|
||||
try
|
||||
ShowMessage('Person saved with ID = ' + lResp.Result.AsInteger.ToString);
|
||||
finally
|
||||
lResp.Free;
|
||||
end;
|
||||
finally
|
||||
lReq.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm10.btnSubstractClick(Sender: TObject);
|
||||
var
|
||||
lReq: TJSONRPCRequest;
|
||||
@ -147,7 +255,7 @@ begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
try
|
||||
lReq.Method := 'subtract';
|
||||
lReq.ID := Random(1000);
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add(StrToInt(edtValue1.Text));
|
||||
lReq.Params.Add(StrToInt(edtValue2.Text));
|
||||
|
||||
@ -171,7 +279,7 @@ begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
try
|
||||
lReq.Method := 'getcustomers';
|
||||
lReq.ID := Random(1000);
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add(edtFilter.Text);
|
||||
JSONRPCExec('http://localhost:8080/jsonrpc', lReq, lResp);
|
||||
try
|
||||
@ -185,4 +293,9 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm10.FormCreate(Sender: TObject);
|
||||
begin
|
||||
dtNextMonday.Date := Date;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -11,16 +11,21 @@ type
|
||||
public
|
||||
function Subtract(aValue1, aValue2: Integer): Integer;
|
||||
function ReverseString(aString: string): string;
|
||||
function GetNextMonday(const aDate: TDate): TDate;
|
||||
function GetCustomers(aString: string): TDataSet;
|
||||
function GetUser(aUserName: string): TPerson;
|
||||
function SavePerson(const aPerson: TJsonObject): Integer;
|
||||
procedure DoSomething;
|
||||
// invalid parameters modifiers
|
||||
procedure InvalidMethod1(var MyVarParam: Integer);
|
||||
procedure InvalidMethod2(out MyOutParam: Integer);
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, MVCFramework.Logger, System.StrUtils, FireDAC.Comp.Client;
|
||||
System.SysUtils, MVCFramework.Logger, System.StrUtils, FireDAC.Comp.Client, System.DateUtils;
|
||||
|
||||
{ TMyDerivedController }
|
||||
|
||||
@ -66,6 +71,18 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMyJSONRPCController.GetNextMonday(const aDate: TDate): TDate;
|
||||
var
|
||||
lDate: TDate;
|
||||
begin
|
||||
lDate := aDate + 1;
|
||||
while DayOfTheWeek(lDate) <> 1 do
|
||||
begin
|
||||
lDate := lDate + 1;
|
||||
end;
|
||||
Result := lDate;
|
||||
end;
|
||||
|
||||
function TMyJSONRPCController.GetUser(aUserName: string): TPerson;
|
||||
begin
|
||||
Result := TPerson.Create;
|
||||
@ -75,11 +92,36 @@ begin
|
||||
Result.Married := True;
|
||||
end;
|
||||
|
||||
procedure TMyJSONRPCController.InvalidMethod1(var MyVarParam: Integer);
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
procedure TMyJSONRPCController.InvalidMethod2(out MyOutParam: Integer);
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
function TMyJSONRPCController.ReverseString(aString: string): string;
|
||||
begin
|
||||
Result := System.StrUtils.ReverseString(aString);
|
||||
end;
|
||||
|
||||
function TMyJSONRPCController.SavePerson(const aPerson: TJsonObject): Integer;
|
||||
var
|
||||
lPerson: TPerson;
|
||||
begin
|
||||
lPerson := JSONObjectAs<TPerson>(aPerson);
|
||||
try
|
||||
// do something with lPerson
|
||||
finally
|
||||
lPerson.Free;
|
||||
end;
|
||||
|
||||
// this maybe the id of the newly created person
|
||||
Result := Random(1000);
|
||||
end;
|
||||
|
||||
function TMyJSONRPCController.Subtract(aValue1, aValue2: Integer): Integer;
|
||||
begin
|
||||
Result := aValue1 - aValue2;
|
||||
|
||||
@ -2,7 +2,8 @@ program jsonrpcclient;
|
||||
|
||||
uses
|
||||
Vcl.Forms,
|
||||
MainClientFormU in 'MainClientFormU.pas' {Form10};
|
||||
MainClientFormU in 'MainClientFormU.pas' {Form10},
|
||||
BusinessObjectsU in '..\commons\BusinessObjectsU.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
|
||||
@ -103,6 +103,7 @@
|
||||
<Form>Form10</Form>
|
||||
<FormType>dfm</FormType>
|
||||
</DCCReference>
|
||||
<DCCReference Include="..\commons\BusinessObjectsU.pas"/>
|
||||
<BuildConfiguration Include="Release">
|
||||
<Key>Cfg_2</Key>
|
||||
<CfgParent>Base</CfgParent>
|
||||
|
||||
@ -5,7 +5,8 @@ interface
|
||||
uses
|
||||
System.Classes, Data.DB, System.SysUtils,
|
||||
jsondataobjects, MVCFramework, MVCFramework.Commons, System.Rtti,
|
||||
System.Generics.Collections, MVCFramework.Serializer.Commons;
|
||||
System.Generics.Collections, MVCFramework.Serializer.Commons,
|
||||
MVCFramework.Serializer.JsonDataObjects;
|
||||
|
||||
const
|
||||
JSONRPC_VERSION = '2.0';
|
||||
@ -53,7 +54,7 @@ type
|
||||
constructor Create; virtual;
|
||||
property AsJSON: TJsonObject read GetJSON write SetJSON;
|
||||
property AsJSONString: string read GetJSONString write SetJsonString;
|
||||
property ID: TValue read FID write SetID;
|
||||
property RequestID: TValue read FID write SetID;
|
||||
end;
|
||||
|
||||
{$SCOPEDENUMS ON}
|
||||
@ -158,23 +159,28 @@ type
|
||||
TMVCJSONArray = TJDOJsonArray;
|
||||
|
||||
TMVCJSONRPCController = class(TMVCController)
|
||||
private
|
||||
fSerializer: TMVCJsonDataObjectsSerializer;
|
||||
function GetSerializer: TMVCJsonDataObjectsSerializer;
|
||||
protected
|
||||
function CreateError(const RequestID: TValue; const ErrorCode: Integer;
|
||||
const message: string): TJsonObject;
|
||||
function CreateResponse(const RequestID: TValue; const Value: TValue): TJSONRPCResponse;
|
||||
function CreateRequest(const JSON: TJsonObject): TJSONRPCRequest;
|
||||
function JSONObjectAs<T: class, constructor>(const JSON: TJsonObject): T;
|
||||
public
|
||||
[MVCPath]
|
||||
[MVCHTTPMethods([httpPOST])]
|
||||
[MVCConsumes(TMVCMediaType.APPLICATION_JSON)]
|
||||
[MVCProduces(TMVCMediaType.APPLICATION_JSON)]
|
||||
procedure index; virtual;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
MVCFramework.Serializer.Intf, MVCFramework.Serializer.JsonDataObjects;
|
||||
MVCFramework.Serializer.Intf, System.TypInfo;
|
||||
|
||||
function JSONDataValueToTValue(const JSONDataValue: TJsonDataValueHelper): TValue;
|
||||
begin
|
||||
@ -419,7 +425,7 @@ var
|
||||
begin
|
||||
lErrResp := TJSONRPCResponse.Create;
|
||||
try
|
||||
lErrResp.ID := RequestID;
|
||||
lErrResp.RequestID := RequestID;
|
||||
lErrResp.Error := TJSONRPCResponse.TJSONRPCResponseError.Create;
|
||||
lErrResp.Error.Code := ErrorCode;
|
||||
lErrResp.Error.ErrMessage := message;
|
||||
@ -438,15 +444,15 @@ begin
|
||||
try
|
||||
Result := TJSONRPCRequest.Create;
|
||||
if JSON.Types[JSONRPC_ID] = jdtString then
|
||||
Result.ID := JSON.S[JSONRPC_ID]
|
||||
Result.RequestID := JSON.S[JSONRPC_ID]
|
||||
else if JSON.Types[JSONRPC_ID] = jdtInt then
|
||||
Result.ID := JSON.I[JSONRPC_ID]
|
||||
Result.RequestID := JSON.I[JSONRPC_ID]
|
||||
else if JSON.Types[JSONRPC_ID] = jdtLong then
|
||||
Result.ID := JSON.L[JSONRPC_ID]
|
||||
Result.RequestID := JSON.L[JSONRPC_ID]
|
||||
else if JSON.Types[JSONRPC_ID] = jdtULong then
|
||||
Result.ID := JSON.U[JSONRPC_ID]
|
||||
Result.RequestID := JSON.U[JSONRPC_ID]
|
||||
else
|
||||
Result.ID := TValue.Empty;
|
||||
Result.RequestID := TValue.Empty;
|
||||
|
||||
Result.Method := JSON.S[JSONRPC_METHOD];
|
||||
|
||||
@ -470,10 +476,23 @@ end;
|
||||
function TMVCJSONRPCController.CreateResponse(const RequestID: TValue; const Value: TValue): TJSONRPCResponse;
|
||||
begin
|
||||
Result := TJSONRPCResponse.Create;
|
||||
Result.ID := RequestID;
|
||||
Result.RequestID := RequestID;
|
||||
Result.Result := Value;
|
||||
end;
|
||||
|
||||
destructor TMVCJSONRPCController.Destroy;
|
||||
begin
|
||||
fSerializer.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMVCJSONRPCController.GetSerializer: TMVCJsonDataObjectsSerializer;
|
||||
begin
|
||||
if not Assigned(fSerializer) then
|
||||
fSerializer := TMVCJsonDataObjectsSerializer.Create;
|
||||
Result := fSerializer;
|
||||
end;
|
||||
|
||||
procedure TMVCJSONRPCController.Index;
|
||||
var
|
||||
lJSONRPCReq: TJSONRPCRequest;
|
||||
@ -486,6 +505,7 @@ var
|
||||
lJSONRPCResponse: TJSONRPCResponse;
|
||||
lParamsToInject: TArray<TValue>;
|
||||
lReqID: TValue;
|
||||
lRTTIMethodParam: TRttiParameter;
|
||||
begin
|
||||
lReqID := TValue.Empty;
|
||||
SetLength(lParamsToInject, 0);
|
||||
@ -503,6 +523,12 @@ begin
|
||||
if (Length(lRTTIMethodParams) <> lJSONRPCReq.Params.Count) then
|
||||
raise EMVCJSONRPCInvalidParams.Create('Wrong parameters count');
|
||||
|
||||
for lRTTIMethodParam in lRTTIMethodParams do
|
||||
begin
|
||||
if lRTTIMethodParam.Flags * [pfVar, pfOut, pfArray, pfReference] <> [] then
|
||||
raise EMVCJSONRPCInvalidParams.CreateFmt('Parameter modifier not supported for formal parameter [%s]. Only const and value modifiers are allowed.', [lRTTIMethodParam.Name])
|
||||
end;
|
||||
|
||||
try
|
||||
try
|
||||
lRes := lRTTIMethod.Invoke(Self, lJSONRPCReq.Params.ToArray);
|
||||
@ -520,7 +546,7 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
lJSONRPCResponse := CreateResponse(lJSONRPCReq.ID, lRes);
|
||||
lJSONRPCResponse := CreateResponse(lJSONRPCReq.RequestID, lRes);
|
||||
try
|
||||
ResponseStatus(200);
|
||||
Render(lJSONRPCResponse.AsJSON);
|
||||
@ -571,6 +597,17 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMVCJSONRPCController.JSONObjectAs<T>(const JSON: TJsonObject): T;
|
||||
begin
|
||||
Result := T.Create;
|
||||
try
|
||||
GetSerializer.JsonObjectToObject(JSON, Result, TMVCSerializationType.stProperties, []);
|
||||
except
|
||||
Result.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ EMVCJSONRPCParseError }
|
||||
|
||||
constructor EMVCJSONRPCParseError.Create;
|
||||
@ -620,8 +657,6 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
{ TMVCJSONRCPResponse }
|
||||
|
||||
{ TJSONRPCRequest }
|
||||
|
||||
constructor TJSONRPCRequest.Create;
|
||||
@ -674,15 +709,15 @@ var
|
||||
lParams: TJsonArray;
|
||||
begin
|
||||
if JSON.Types[JSONRPC_ID] = jdtString then
|
||||
ID := JSON.S[JSONRPC_ID]
|
||||
RequestID := JSON.S[JSONRPC_ID]
|
||||
else if JSON.Types[JSONRPC_ID] = jdtInt then
|
||||
ID := JSON.I[JSONRPC_ID]
|
||||
RequestID := JSON.I[JSONRPC_ID]
|
||||
else if JSON.Types[JSONRPC_ID] = jdtLong then
|
||||
ID := JSON.L[JSONRPC_ID]
|
||||
RequestID := JSON.L[JSONRPC_ID]
|
||||
else if JSON.Types[JSONRPC_ID] = jdtULong then
|
||||
ID := JSON.U[JSONRPC_ID]
|
||||
RequestID := JSON.U[JSONRPC_ID]
|
||||
else
|
||||
ID := TValue.Empty;
|
||||
RequestID := TValue.Empty;
|
||||
|
||||
Method := JSON.S[JSONRPC_METHOD];
|
||||
Params.Clear;
|
||||
@ -750,15 +785,15 @@ end;
|
||||
procedure TJSONRPCResponse.SetJSON(const JSON: TJsonObject);
|
||||
begin
|
||||
if JSON.Types[JSONRPC_ID] = jdtString then
|
||||
ID := JSON.S[JSONRPC_ID]
|
||||
RequestID := JSON.S[JSONRPC_ID]
|
||||
else if JSON.Types[JSONRPC_ID] = jdtInt then
|
||||
ID := JSON.I[JSONRPC_ID]
|
||||
RequestID := JSON.I[JSONRPC_ID]
|
||||
else if JSON.Types[JSONRPC_ID] = jdtLong then
|
||||
ID := JSON.L[JSONRPC_ID]
|
||||
RequestID := JSON.L[JSONRPC_ID]
|
||||
else if JSON.Types[JSONRPC_ID] = jdtULong then
|
||||
ID := JSON.U[JSONRPC_ID]
|
||||
RequestID := JSON.U[JSONRPC_ID]
|
||||
else
|
||||
ID := TValue.Empty;
|
||||
RequestID := TValue.Empty;
|
||||
|
||||
if JSON.Contains(JSONRPC_RESULT) then
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user