mirror of
https://github.com/danieleteti/delphimvcframework.git
synced 2024-11-15 07:45:54 +01:00
Fixed some weird behaviour of the sample about JSONRPC
This commit is contained in:
Daniele Teti
parent
e2908e388d
commit
2758b2bbea
70
samples/jsonrpc/AuthenticationU.pas
Normal file
70
samples/jsonrpc/AuthenticationU.pas
Normal file
@ -0,0 +1,70 @@
|
||||
unit AuthenticationU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, MVCFramework.Commons, System.Generics.Collections,
|
||||
MVCFramework;
|
||||
|
||||
type
|
||||
TAuthenticationSample = class(TInterfacedObject, IMVCAuthenticationHandler)
|
||||
protected
|
||||
procedure OnRequest(const AContext: TWebContext; const ControllerQualifiedClassName: string;
|
||||
const ActionName: string; var AuthenticationRequired: Boolean);
|
||||
procedure OnAuthentication(const AContext: TWebContext; const UserName: string; const Password: string;
|
||||
UserRoles: System.Generics.Collections.TList<System.string>;
|
||||
var IsValid: Boolean; const SessionData: TSessionData);
|
||||
procedure OnAuthorization(const AContext: TWebContext; UserRoles
|
||||
: System.Generics.Collections.TList<System.string>;
|
||||
const ControllerQualifiedClassName: string; const ActionName: string;
|
||||
var IsAuthorized: Boolean);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TMVCAuthorization }
|
||||
|
||||
procedure TAuthenticationSample.OnAuthentication(const AContext: TWebContext; const UserName: string;
|
||||
const Password: string;
|
||||
UserRoles: System.Generics.Collections.TList<System.string>;
|
||||
var IsValid: Boolean; const SessionData: TSessionData);
|
||||
begin
|
||||
IsValid := UserName.Equals(Password); // hey!, this is just a demo!!!
|
||||
if IsValid then
|
||||
begin
|
||||
if UserName = 'user1' then
|
||||
begin
|
||||
UserRoles.Add('role1');
|
||||
end;
|
||||
if UserName = 'user2' then
|
||||
begin
|
||||
UserRoles.Add('role2');
|
||||
end;
|
||||
if UserName = 'user3' then // all the roles
|
||||
begin
|
||||
UserRoles.Add('role1');
|
||||
UserRoles.Add('role2');
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
UserRoles.Clear;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuthenticationSample.OnAuthorization
|
||||
(const AContext: TWebContext; UserRoles
|
||||
: System.Generics.Collections.TList<System.string>;
|
||||
const ControllerQualifiedClassName: string; const ActionName: string;
|
||||
var IsAuthorized: Boolean);
|
||||
begin
|
||||
IsAuthorized := True;
|
||||
end;
|
||||
|
||||
procedure TAuthenticationSample.OnRequest(const AContext: TWebContext; const ControllerQualifiedClassName: string;
|
||||
const ActionName: string; var AuthenticationRequired: Boolean);
|
||||
begin
|
||||
AuthenticationRequired := True;
|
||||
end;
|
||||
|
||||
end.
|
||||
272
samples/jsonrpc/CommonTypesU.pas
Normal file
272
samples/jsonrpc/CommonTypesU.pas
Normal file
@ -0,0 +1,272 @@
|
||||
unit CommonTypesU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
MVCFramework.Commons, MVCFramework.Serializer.Commons;
|
||||
|
||||
type
|
||||
TEnumTest = (ptEnumValue1, ptEnumValue2, ptEnumValue3, ptEnumValue4);
|
||||
TSetTest = set of TEnumTest;
|
||||
|
||||
[MVCNameCase(ncCamelCase)]
|
||||
TNestedRec = record
|
||||
StringProp: String;
|
||||
IntegerProp: Integer;
|
||||
BooleanProp: Boolean;
|
||||
EnumProp: TEnumTest;
|
||||
SetProp: TSetTest;
|
||||
ArrOfStringsProp: TArray<String>;
|
||||
ArrOfIntegersProp: TArray<Integer>;
|
||||
ArrOfBooleansProp: TArray<Boolean>;
|
||||
ArrOfDateProp: TArray<TDate>;
|
||||
ArrOfTimeProp: TArray<TTime>;
|
||||
ArrOfDateTimeProp: TArray<TDateTime>;
|
||||
constructor Create(Value: Integer);
|
||||
function ToString: String;
|
||||
end;
|
||||
|
||||
[MVCNameCase(ncCamelCase)]
|
||||
TTestRec = record
|
||||
StringProp: String;
|
||||
IntegerProp: Integer;
|
||||
BooleanProp: Boolean;
|
||||
EnumProp: TEnumTest;
|
||||
SetProp: TSetTest;
|
||||
ArrOfStringsProp: TArray<String>;
|
||||
ArrOfIntegersProp: TArray<Integer>;
|
||||
ArrOfBooleansProp: TArray<Boolean>;
|
||||
ArrOfDateProp: TArray<TDate>;
|
||||
ArrOfTimeProp: TArray<TTime>;
|
||||
ArrOfDateTimeProp: TArray<TDateTime>;
|
||||
NestedRecProp: TNestedRec;
|
||||
function ToString: String;
|
||||
constructor Create(Value: Integer);
|
||||
end;
|
||||
|
||||
TTestRecDynArray = TArray<TTestRec>;
|
||||
|
||||
TTestRecArray = array [0 .. 1] of TTestRec;
|
||||
|
||||
TNestedArraysRec = record
|
||||
TestRecProp: TTestRec;
|
||||
ArrayProp1: TArray<TTestRec>;
|
||||
ArrayProp2: TArray<TTestRec>;
|
||||
function ToString: String;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils, System.TypInfo;
|
||||
|
||||
{ TPersonRec }
|
||||
|
||||
constructor TTestRec.Create(Value: Integer) ;
|
||||
begin
|
||||
StringProp := 'StringProp' + Value.ToString;
|
||||
IntegerProp := Value;
|
||||
BooleanProp := True;
|
||||
EnumProp := TEnumTest(Value mod 3);
|
||||
SetProp := [TEnumTest(Value mod 3), TEnumTest((Value+1) mod 3)];
|
||||
ArrOfStringsProp := ['ArrOfStringsProp' + Value.ToString, 'ArrOfStringsProp' + Value.ToString];
|
||||
ArrOfIntegersProp := [Value mod 3, (Value + 1 ) mod 3, (Value + 2 ) mod 3];
|
||||
ArrOfBooleansProp := [((Value mod 3) = 1), ((Value + 1) mod 3 = 1), ((Value + 2) mod 3 = 1)];
|
||||
ArrOfDateProp := [
|
||||
EncodeDate(2022,(Value mod 11)+1, Value mod 28),
|
||||
EncodeDate(2022,((Value+1) mod 11)+1, (Value+1) mod 28),
|
||||
EncodeDate(2022,((Value+2) mod 11)+1, (Value+2) mod 28)
|
||||
];
|
||||
ArrOfTimeProp := [
|
||||
EncodeTime(Value mod 24, Value mod 60, Value mod 60, 0),
|
||||
EncodeTime((Value + 1) mod 24, (Value + 1) mod 60, (Value + 1) mod 60, 0),
|
||||
EncodeTime((Value + 2) mod 24, (Value + 2) mod 60, (Value + 2) mod 60, 0)
|
||||
];
|
||||
ArrOfDateTimeProp := [
|
||||
ArrOfDateProp[0] + ArrOfTimeProp[0],
|
||||
ArrOfDateProp[1] + ArrOfTimeProp[1],
|
||||
ArrOfDateProp[2] + ArrOfTimeProp[2]
|
||||
];
|
||||
NestedRecProp := TNestedRec.Create(Value + 1);
|
||||
end;
|
||||
|
||||
function TTestRec.ToString: String;
|
||||
function SetPropAsString: String;
|
||||
var
|
||||
lEl: TEnumTest;
|
||||
begin
|
||||
for lEl in SetProp do
|
||||
begin
|
||||
Result := Result + GetEnumName(TypeInfo(TEnumTest), Ord(lEl)) + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1);
|
||||
end;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
Result :=
|
||||
'StringProp = ' + self.StringProp + sLineBreak +
|
||||
'IntegerProp = ' + self.IntegerProp.ToString + sLineBreak +
|
||||
'BooleanProp = ' + self.BooleanProp.ToString(TUseBoolStrs.True) + sLineBreak +
|
||||
'EnumProp = ' + GetEnumName(TypeInfo(TEnumTest), Ord(EnumProp)) + sLineBreak +
|
||||
'SetProp = ' + SetPropAsString + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfStringsProp = ';
|
||||
for I := Low(ArrOfStringsProp) to High(ArrOfStringsProp) do
|
||||
begin
|
||||
Result := Result + ArrOfStringsProp[I] + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfIntegersProp = ';
|
||||
for I := Low(ArrOfIntegersProp) to High(ArrOfIntegersProp) do
|
||||
begin
|
||||
Result := Result + ArrOfIntegersProp[I].ToString() + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfBooleansProp = ';
|
||||
for I := Low(ArrOfBooleansProp) to High(ArrOfBooleansProp) do
|
||||
begin
|
||||
Result := Result + ArrOfBooleansProp[I].ToString(TUseBoolStrs.True) + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfDateProp = ';
|
||||
for I := Low(ArrOfDateProp) to High(ArrOfDateProp) do
|
||||
begin
|
||||
Result := Result + DateToStr(ArrOfDateProp[I]) + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfTimeProp = ';
|
||||
for I := Low(ArrOfTimeProp) to High(ArrOfTimeProp) do
|
||||
begin
|
||||
Result := Result + TimeToStr(ArrOfTimeProp[I]) + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfDateTimeProp = ';
|
||||
for I := Low(ArrOfDateTimeProp) to High(ArrOfDateTimeProp) do
|
||||
begin
|
||||
Result := Result + DateTimeToStr(ArrOfDateTimeProp[I]) + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
|
||||
Result := Result + 'NestedRecProp **> ' + sLineBreak;
|
||||
Result := Result + NestedRecProp.ToString();
|
||||
end;
|
||||
|
||||
{ TChildRec }
|
||||
|
||||
constructor TNestedRec.Create(Value: Integer);
|
||||
begin
|
||||
StringProp := 'StringProp' + Value.ToString;
|
||||
IntegerProp := Value;
|
||||
BooleanProp := True;
|
||||
EnumProp := TEnumTest(Value mod 3);
|
||||
SetProp := [TEnumTest(Value mod 3), TEnumTest((Value+1) mod 3)];
|
||||
ArrOfStringsProp := ['ArrOfStringsProp' + Value.ToString, 'ArrOfStringsProp' + Value.ToString];
|
||||
ArrOfIntegersProp := [Value mod 3, (Value + 1 ) mod 3, (Value + 2 ) mod 3];
|
||||
ArrOfBooleansProp := [((Value mod 3) = 1), ((Value + 1) mod 3 = 1), ((Value + 2) mod 3 = 1)];
|
||||
ArrOfDateProp := [
|
||||
EncodeDate(2022,(Value mod 11)+1, Value mod 28),
|
||||
EncodeDate(2022,((Value+1) mod 11)+1, (Value+1) mod 28),
|
||||
EncodeDate(2022,((Value+2) mod 11)+1, (Value+2) mod 28)
|
||||
];
|
||||
ArrOfTimeProp := [
|
||||
EncodeTime(Value mod 24, Value mod 60, Value mod 60, 0),
|
||||
EncodeTime((Value + 1) mod 24, (Value + 1) mod 60, (Value + 1) mod 60, 0),
|
||||
EncodeTime((Value + 2) mod 24, (Value + 2) mod 60, (Value + 2) mod 60, 0)
|
||||
];
|
||||
ArrOfDateTimeProp := [
|
||||
ArrOfDateProp[0] + ArrOfTimeProp[0],
|
||||
ArrOfDateProp[1] + ArrOfTimeProp[1],
|
||||
ArrOfDateProp[2] + ArrOfTimeProp[2]
|
||||
];
|
||||
end;
|
||||
|
||||
function TNestedRec.ToString: String;
|
||||
function SetPropAsString: String;
|
||||
var
|
||||
lEl: TEnumTest;
|
||||
begin
|
||||
for lEl in SetProp do
|
||||
begin
|
||||
Result := Result + GetEnumName(TypeInfo(TEnumTest), Ord(lEl)) + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1);
|
||||
end;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
Result :=
|
||||
'StringProp = ' + self.StringProp + sLineBreak +
|
||||
'IntegerProp = ' + self.IntegerProp.ToString + sLineBreak +
|
||||
'BooleanProp = ' + self.BooleanProp.ToString(TUseBoolStrs.True) + sLineBreak +
|
||||
'EnumProp = ' + GetEnumName(TypeInfo(TEnumTest), Ord(EnumProp)) + sLineBreak +
|
||||
'SetProp = ' + SetPropAsString + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfStringsProp = ';
|
||||
for I := Low(ArrOfStringsProp) to High(ArrOfStringsProp) do
|
||||
begin
|
||||
Result := Result + ArrOfStringsProp[I] + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfIntegersProp = ';
|
||||
for I := Low(ArrOfIntegersProp) to High(ArrOfIntegersProp) do
|
||||
begin
|
||||
Result := Result + ArrOfIntegersProp[I].ToString() + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfBooleansProp = ';
|
||||
for I := Low(ArrOfBooleansProp) to High(ArrOfBooleansProp) do
|
||||
begin
|
||||
Result := Result + ArrOfBooleansProp[I].ToString(TUseBoolStrs.True) + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfDateProp = ';
|
||||
for I := Low(ArrOfDateProp) to High(ArrOfDateProp) do
|
||||
begin
|
||||
Result := Result + DateToStr(ArrOfDateProp[I]) + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfTimeProp = ';
|
||||
for I := Low(ArrOfTimeProp) to High(ArrOfTimeProp) do
|
||||
begin
|
||||
Result := Result + TimeToStr(ArrOfTimeProp[I]) + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
|
||||
Result := Result + 'ArrOfDateTimeProp = ';
|
||||
for I := Low(ArrOfDateTimeProp) to High(ArrOfDateTimeProp) do
|
||||
begin
|
||||
Result := Result + DateTimeToStr(ArrOfDateTimeProp[I]) + ',';
|
||||
end;
|
||||
Result := Result.Remove(Result.Length - 1) + sLineBreak;
|
||||
end;
|
||||
|
||||
{ TNestedArraysRec }
|
||||
|
||||
function TNestedArraysRec.ToString: String;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
Result := '-- TestRecProp -- ' + sLineBreak + TestRecProp.ToString + sLineBreak;
|
||||
Result := Result + sLineBreak + '-- ArrayProp1 -- ' + sLineBreak;
|
||||
for I := Low(ArrayProp1) to High(ArrayProp1) do
|
||||
begin
|
||||
Result := Result + 'ITEM ' + I.ToString + sLineBreak + ArrayProp1[I].ToString + sLineBreak;
|
||||
end;
|
||||
Result := Result + sLineBreak + '-- ArrayProp2 -- ' + sLineBreak;
|
||||
for I := Low(ArrayProp2) to High(ArrayProp2) do
|
||||
begin
|
||||
Result := Result + 'ITEM ' + I.ToString + sLineBreak + ArrayProp2[I].ToString + sLineBreak;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
636
samples/jsonrpc/async_client/MainClientFormU.dfm
Normal file
636
samples/jsonrpc/async_client/MainClientFormU.dfm
Normal file
@ -0,0 +1,636 @@
|
||||
object MainForm: TMainForm
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = 'JSON-RPC 2.0 Async Client'
|
||||
ClientHeight = 603
|
||||
ClientWidth = 838
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OnCreate = FormCreate
|
||||
TextHeight = 13
|
||||
object PageControl1: TPageControl
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 838
|
||||
Height = 603
|
||||
ActivePage = TabSheet1
|
||||
Align = alClient
|
||||
TabOrder = 0
|
||||
object TabSheet1: TTabSheet
|
||||
Caption = 'Invoking Plain PODO'
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 3
|
||||
Top = 22
|
||||
Width = 815
|
||||
Height = 174
|
||||
Caption = 'Simple Types'
|
||||
TabOrder = 0
|
||||
object edtValue1: TEdit
|
||||
Left = 17
|
||||
Top = 32
|
||||
Width = 32
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
Text = '42'
|
||||
end
|
||||
object edtValue2: TEdit
|
||||
Left = 55
|
||||
Top = 32
|
||||
Width = 26
|
||||
Height = 21
|
||||
TabOrder = 1
|
||||
Text = '10'
|
||||
end
|
||||
object btnSubtract: TButton
|
||||
Left = 87
|
||||
Top = 30
|
||||
Width = 100
|
||||
Height = 25
|
||||
Caption = 'Subtract'
|
||||
TabOrder = 2
|
||||
OnClick = btnSubtractClick
|
||||
end
|
||||
object edtResult: TEdit
|
||||
Left = 193
|
||||
Top = 32
|
||||
Width = 27
|
||||
Height = 21
|
||||
ReadOnly = True
|
||||
TabOrder = 3
|
||||
end
|
||||
object edtReverseString: TEdit
|
||||
Left = 17
|
||||
Top = 80
|
||||
Width = 88
|
||||
Height = 21
|
||||
TabOrder = 4
|
||||
Text = 'Daniele Teti'
|
||||
end
|
||||
object btnReverseString: TButton
|
||||
Left = 111
|
||||
Top = 78
|
||||
Width = 109
|
||||
Height = 25
|
||||
Caption = 'Reverse String'
|
||||
TabOrder = 5
|
||||
OnClick = btnReverseStringClick
|
||||
end
|
||||
object edtReversedString: TEdit
|
||||
Left = 320
|
||||
Top = 80
|
||||
Width = 131
|
||||
Height = 21
|
||||
ReadOnly = True
|
||||
TabOrder = 6
|
||||
end
|
||||
object dtNextMonday: TDateTimePicker
|
||||
Left = 253
|
||||
Top = 32
|
||||
Width = 102
|
||||
Height = 21
|
||||
Date = 43018.000000000000000000
|
||||
Time = 0.469176562502980200
|
||||
TabOrder = 7
|
||||
end
|
||||
object btnAddDay: TButton
|
||||
Left = 361
|
||||
Top = 30
|
||||
Width = 104
|
||||
Height = 25
|
||||
Caption = 'Get Next Monday'
|
||||
TabOrder = 8
|
||||
OnClick = btnAddDayClick
|
||||
end
|
||||
object btnInvalid1: TButton
|
||||
Left = 626
|
||||
Top = 78
|
||||
Width = 84
|
||||
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
|
||||
WordWrap = True
|
||||
OnClick = btnInvalid1Click
|
||||
end
|
||||
object btnInvalid2: TButton
|
||||
Left = 716
|
||||
Top = 78
|
||||
Width = 84
|
||||
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
|
||||
object btnNotification: TButton
|
||||
Left = 464
|
||||
Top = 78
|
||||
Width = 75
|
||||
Height = 43
|
||||
Caption = 'Send Notification'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clScrollBar
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 11
|
||||
WordWrap = True
|
||||
OnClick = btnNotificationClick
|
||||
end
|
||||
object btnInvalidMethod: TButton
|
||||
Left = 545
|
||||
Top = 78
|
||||
Width = 75
|
||||
Height = 43
|
||||
Caption = 'Invalid Method'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clScrollBar
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 12
|
||||
WordWrap = True
|
||||
OnClick = btnInvalidMethodClick
|
||||
end
|
||||
object CheckBox1: TCheckBox
|
||||
Left = 226
|
||||
Top = 82
|
||||
Width = 88
|
||||
Height = 17
|
||||
Caption = 'As Uppercase'
|
||||
TabOrder = 13
|
||||
end
|
||||
object btnDates: TButton
|
||||
Left = 716
|
||||
Top = 30
|
||||
Width = 84
|
||||
Height = 25
|
||||
Caption = 'PlayWithDates'
|
||||
TabOrder = 14
|
||||
OnClick = btnDatesClick
|
||||
end
|
||||
object btnFloatsTests: TButton
|
||||
Left = 626
|
||||
Top = 30
|
||||
Width = 84
|
||||
Height = 25
|
||||
Caption = 'Floats'
|
||||
TabOrder = 15
|
||||
OnClick = btnFloatsTestsClick
|
||||
end
|
||||
object btnWithJSON: TButton
|
||||
Left = 545
|
||||
Top = 30
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = 'JSON Prop'
|
||||
TabOrder = 16
|
||||
OnClick = btnWithJSONClick
|
||||
end
|
||||
object Edit1: TEdit
|
||||
Left = 17
|
||||
Top = 136
|
||||
Width = 32
|
||||
Height = 21
|
||||
TabOrder = 17
|
||||
Text = '42'
|
||||
end
|
||||
object Edit2: TEdit
|
||||
Left = 55
|
||||
Top = 136
|
||||
Width = 26
|
||||
Height = 21
|
||||
TabOrder = 18
|
||||
Text = '10'
|
||||
end
|
||||
object btnSubtractWithNamedParams: TButton
|
||||
Left = 87
|
||||
Top = 134
|
||||
Width = 160
|
||||
Height = 25
|
||||
Caption = 'Subtract (named params)'
|
||||
TabOrder = 19
|
||||
OnClick = btnSubtractWithNamedParamsClick
|
||||
end
|
||||
object Edit3: TEdit
|
||||
Left = 253
|
||||
Top = 136
|
||||
Width = 27
|
||||
Height = 21
|
||||
ReadOnly = True
|
||||
TabOrder = 20
|
||||
end
|
||||
object btnGenericException: TButton
|
||||
Left = 464
|
||||
Top = 127
|
||||
Width = 156
|
||||
Height = 32
|
||||
Caption = 'Raise Generic Exception'
|
||||
TabOrder = 21
|
||||
OnClick = btnGenericExceptionClick
|
||||
end
|
||||
object btnException: TButton
|
||||
Left = 626
|
||||
Top = 127
|
||||
Width = 170
|
||||
Height = 32
|
||||
Caption = 'Raise Custom Exception'
|
||||
TabOrder = 22
|
||||
OnClick = btnExceptionClick
|
||||
end
|
||||
object btnParallel: TButton
|
||||
Left = 320
|
||||
Top = 134
|
||||
Width = 131
|
||||
Height = 25
|
||||
Caption = 'Parallel Calls'
|
||||
TabOrder = 23
|
||||
OnClick = btnParallelClick
|
||||
end
|
||||
end
|
||||
object GroupBox2: TGroupBox
|
||||
Left = 3
|
||||
Top = 202
|
||||
Width = 489
|
||||
Height = 159
|
||||
Caption = 'Returning Objects'
|
||||
TabOrder = 1
|
||||
object edtUserName: TEdit
|
||||
Left = 16
|
||||
Top = 24
|
||||
Width = 184
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
Text = 'dteti'
|
||||
end
|
||||
object btnGetUser: TButton
|
||||
Left = 206
|
||||
Top = 22
|
||||
Width = 91
|
||||
Height = 25
|
||||
Caption = 'Get User'
|
||||
TabOrder = 1
|
||||
OnClick = btnGetUserClick
|
||||
end
|
||||
object lbPerson: TListBox
|
||||
Left = 16
|
||||
Top = 53
|
||||
Width = 435
|
||||
Height = 82
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -13
|
||||
Font.Name = 'Courier New'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
object GroupBox4: TGroupBox
|
||||
Left = 3
|
||||
Top = 383
|
||||
Width = 489
|
||||
Height = 129
|
||||
Caption = 'Passing Objects as parameters'
|
||||
TabOrder = 2
|
||||
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.000000000000000000
|
||||
Time = 0.469176562499342300
|
||||
TabOrder = 3
|
||||
end
|
||||
object btnSave: TButton
|
||||
Left = 376
|
||||
Top = 88
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = 'Save'
|
||||
TabOrder = 4
|
||||
OnClick = btnSaveClick
|
||||
end
|
||||
end
|
||||
object PageControl2: TPageControl
|
||||
Left = 514
|
||||
Top = 202
|
||||
Width = 304
|
||||
Height = 367
|
||||
ActivePage = TabSheet3
|
||||
TabOrder = 3
|
||||
object TabSheet3: TTabSheet
|
||||
Caption = 'Get DataSet'
|
||||
object edtFilter: TEdit
|
||||
Left = 3
|
||||
Top = 5
|
||||
Width = 184
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
end
|
||||
object edtGetCustomers: TButton
|
||||
Left = 193
|
||||
Top = 3
|
||||
Width = 91
|
||||
Height = 25
|
||||
Caption = 'Get Customers'
|
||||
TabOrder = 1
|
||||
OnClick = edtGetCustomersClick
|
||||
end
|
||||
object DBGrid1: TDBGrid
|
||||
Left = 3
|
||||
Top = 34
|
||||
Width = 279
|
||||
Height = 302
|
||||
DataSource = DataSource1
|
||||
TabOrder = 2
|
||||
TitleFont.Charset = DEFAULT_CHARSET
|
||||
TitleFont.Color = clWindowText
|
||||
TitleFont.Height = -11
|
||||
TitleFont.Name = 'Tahoma'
|
||||
TitleFont.Style = []
|
||||
end
|
||||
end
|
||||
object TabSheet4: TTabSheet
|
||||
Caption = 'Get Multi Dataset'
|
||||
ImageIndex = 1
|
||||
object btnGetMulti: TButton
|
||||
Left = 13
|
||||
Top = 16
|
||||
Width = 268
|
||||
Height = 41
|
||||
Caption = 'Get Multiple Datasets'
|
||||
TabOrder = 0
|
||||
OnClick = btnGetMultiClick
|
||||
end
|
||||
object lbMulti: TListBox
|
||||
Left = 16
|
||||
Top = 63
|
||||
Width = 265
|
||||
Height = 266
|
||||
Font.Charset = ANSI_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Courier New'
|
||||
Font.Style = []
|
||||
ItemHeight = 14
|
||||
ParentFont = False
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
object TabSheet2: TTabSheet
|
||||
Caption = 'Invoking DataModule Methods'
|
||||
ImageIndex = 1
|
||||
object GroupBox5: TGroupBox
|
||||
Left = 11
|
||||
Top = 18
|
||||
Width = 489
|
||||
Height = 391
|
||||
Caption = 'Returning Objects'
|
||||
TabOrder = 0
|
||||
DesignSize = (
|
||||
489
|
||||
391)
|
||||
object edtSearchText: TEdit
|
||||
Left = 16
|
||||
Top = 24
|
||||
Width = 184
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
Text = 'pizz'
|
||||
end
|
||||
object btnSearch: TButton
|
||||
Left = 206
|
||||
Top = 22
|
||||
Width = 91
|
||||
Height = 25
|
||||
Caption = 'Search Article'
|
||||
TabOrder = 1
|
||||
OnClick = btnSearchClick
|
||||
end
|
||||
object ListBox1: TListBox
|
||||
Left = 16
|
||||
Top = 53
|
||||
Width = 435
|
||||
Height = 316
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -13
|
||||
Font.Name = 'Courier New'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
end
|
||||
object TabSheet5: TTabSheet
|
||||
Caption = 'Custom Exceptions Handling'
|
||||
ImageIndex = 2
|
||||
object Label1: TLabel
|
||||
AlignWithMargins = True
|
||||
Left = 3
|
||||
Top = 3
|
||||
Width = 824
|
||||
Height = 69
|
||||
Align = alTop
|
||||
Caption =
|
||||
'If an exception raised by the serve doesn'#39't inherith from EMVCJS' +
|
||||
'ONRPCErrorResponse can be handled by a custom global exception b' +
|
||||
'lock. This custom handling can modify error code, error message ' +
|
||||
'and can add a custom data property to the exception.'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -19
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
WordWrap = True
|
||||
ExplicitWidth = 808
|
||||
end
|
||||
object btnGenericExcWithCustomHandling: TButton
|
||||
Left = 0
|
||||
Top = 103
|
||||
Width = 217
|
||||
Height = 82
|
||||
Caption = 'Raise Generic Exception with custom handling (DATA is a String)'
|
||||
TabOrder = 0
|
||||
WordWrap = True
|
||||
OnClick = btnGenericExcWithCustomHandlingClick
|
||||
end
|
||||
object btnGenericExcWithCustomHAndling2: TButton
|
||||
Left = 223
|
||||
Top = 103
|
||||
Width = 217
|
||||
Height = 82
|
||||
Caption =
|
||||
'Raise Generic Exception with custom handling (DATA is a JSONObje' +
|
||||
'ct)'
|
||||
TabOrder = 1
|
||||
WordWrap = True
|
||||
OnClick = btnGenericExcWithCustomHAndling2Click
|
||||
end
|
||||
object btnGenericExcWithoutCustomHandling: TButton
|
||||
Left = 446
|
||||
Top = 103
|
||||
Width = 217
|
||||
Height = 82
|
||||
Caption = 'Raise Generic Exception without custom handling'
|
||||
TabOrder = 2
|
||||
WordWrap = True
|
||||
OnClick = btnGenericExcWithoutCustomHandlingClick
|
||||
end
|
||||
end
|
||||
object TabSheet6: TTabSheet
|
||||
Caption = 'Using record as parameters'
|
||||
ImageIndex = 3
|
||||
DesignSize = (
|
||||
830
|
||||
575)
|
||||
object btnSingleRec: TButton
|
||||
Left = 16
|
||||
Top = 16
|
||||
Width = 185
|
||||
Height = 41
|
||||
Caption = 'Returning Single Record'
|
||||
TabOrder = 0
|
||||
OnClick = btnSingleRecClick
|
||||
end
|
||||
object lbLogRec: TMemo
|
||||
Left = 216
|
||||
Top = 16
|
||||
Width = 585
|
||||
Height = 544
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
Font.Charset = ANSI_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -13
|
||||
Font.Name = 'Consolas'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
ReadOnly = True
|
||||
ScrollBars = ssBoth
|
||||
TabOrder = 1
|
||||
WordWrap = False
|
||||
end
|
||||
object btnGetArrayOfRecords: TButton
|
||||
Left = 16
|
||||
Top = 63
|
||||
Width = 185
|
||||
Height = 40
|
||||
Caption = 'Returning Array of Records'
|
||||
TabOrder = 2
|
||||
OnClick = btnGetArrayOfRecordsClick
|
||||
end
|
||||
object btnGetDynArray: TButton
|
||||
Left = 16
|
||||
Top = 109
|
||||
Width = 185
|
||||
Height = 40
|
||||
Caption = 'Returning DynArray of Records'
|
||||
TabOrder = 3
|
||||
OnClick = btnGetDynArrayClick
|
||||
end
|
||||
object btnPassAndGetRecord: TButton
|
||||
Left = 16
|
||||
Top = 155
|
||||
Width = 185
|
||||
Height = 40
|
||||
Caption = 'Using record parameters'
|
||||
TabOrder = 4
|
||||
OnClick = btnPassAndGetRecordClick
|
||||
end
|
||||
object btnEchoComplexArray: TButton
|
||||
Left = 16
|
||||
Top = 201
|
||||
Width = 185
|
||||
Height = 40
|
||||
Caption = 'Using Array as Parameter'
|
||||
TabOrder = 5
|
||||
OnClick = btnEchoComplexArrayClick
|
||||
end
|
||||
object btnComplex: TButton
|
||||
Left = 16
|
||||
Top = 247
|
||||
Width = 185
|
||||
Height = 40
|
||||
Caption = 'Using parameter with multiple arrays'
|
||||
TabOrder = 6
|
||||
OnClick = btnComplexClick
|
||||
end
|
||||
end
|
||||
end
|
||||
object DataSource1: TDataSource
|
||||
DataSet = FDMemTable1
|
||||
Left = 455
|
||||
Top = 216
|
||||
end
|
||||
object FDMemTable1: TFDMemTable
|
||||
FetchOptions.AssignedValues = [evMode]
|
||||
FetchOptions.Mode = fmAll
|
||||
ResourceOptions.AssignedValues = [rvSilentMode]
|
||||
ResourceOptions.SilentMode = True
|
||||
UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
|
||||
UpdateOptions.CheckRequired = False
|
||||
UpdateOptions.AutoCommitUpdates = True
|
||||
Left = 767
|
||||
Top = 328
|
||||
object FDMemTable1Code: TIntegerField
|
||||
FieldName = 'Code'
|
||||
end
|
||||
object FDMemTable1Name: TStringField
|
||||
FieldName = 'Name'
|
||||
end
|
||||
end
|
||||
end
|
||||
885
samples/jsonrpc/async_client/MainClientFormU.pas
Normal file
885
samples/jsonrpc/async_client/MainClientFormU.pas
Normal file
@ -0,0 +1,885 @@
|
||||
// ***************************************************************************
|
||||
//
|
||||
// Delphi MVC Framework
|
||||
//
|
||||
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
|
||||
//
|
||||
// https://github.com/danieleteti/delphimvcframework
|
||||
//
|
||||
// ***************************************************************************
|
||||
//
|
||||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||||
// you may not use this file except in compliance with the License.
|
||||
// You may obtain a copy of the License at
|
||||
//
|
||||
// http://www.apache.org/licenses/LICENSE-2.0
|
||||
//
|
||||
// Unless required by applicable law or agreed to in writing, software
|
||||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
// See the License for the specific language governing permissions and
|
||||
// limitations under the License.
|
||||
//
|
||||
// *************************************************************************** }
|
||||
|
||||
unit MainClientFormU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Winapi.Windows,
|
||||
Winapi.Messages,
|
||||
System.SysUtils,
|
||||
System.Variants,
|
||||
System.Classes,
|
||||
Vcl.Graphics,
|
||||
Vcl.Controls,
|
||||
Vcl.Forms,
|
||||
Vcl.Dialogs,
|
||||
System.Net.HttpClientComponent,
|
||||
Vcl.StdCtrls,
|
||||
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,
|
||||
Vcl.ComCtrls,
|
||||
Vcl.ExtCtrls,
|
||||
MVCFramework.JSONRPC.Client, Vcl.Mask, WaitingFormU;
|
||||
|
||||
type
|
||||
TMainForm = class(TForm)
|
||||
DataSource1: TDataSource;
|
||||
FDMemTable1: TFDMemTable;
|
||||
FDMemTable1Code: TIntegerField;
|
||||
FDMemTable1Name: TStringField;
|
||||
GroupBox1: TGroupBox;
|
||||
edtValue1: TEdit;
|
||||
edtValue2: TEdit;
|
||||
btnSubtract: TButton;
|
||||
edtResult: TEdit;
|
||||
edtReverseString: TEdit;
|
||||
btnReverseString: TButton;
|
||||
edtReversedString: TEdit;
|
||||
GroupBox2: TGroupBox;
|
||||
edtUserName: TEdit;
|
||||
btnGetUser: TButton;
|
||||
lbPerson: TListBox;
|
||||
GroupBox4: TGroupBox;
|
||||
edtFirstName: TLabeledEdit;
|
||||
edtLastName: TLabeledEdit;
|
||||
chkMarried: TCheckBox;
|
||||
dtDOB: TDateTimePicker;
|
||||
btnSave: TButton;
|
||||
dtNextMonday: TDateTimePicker;
|
||||
btnAddDay: TButton;
|
||||
btnInvalid1: TButton;
|
||||
btnInvalid2: TButton;
|
||||
btnNotification: TButton;
|
||||
btnInvalidMethod: TButton;
|
||||
PageControl1: TPageControl;
|
||||
TabSheet1: TTabSheet;
|
||||
TabSheet2: TTabSheet;
|
||||
GroupBox5: TGroupBox;
|
||||
edtSearchText: TEdit;
|
||||
btnSearch: TButton;
|
||||
ListBox1: TListBox;
|
||||
CheckBox1: TCheckBox;
|
||||
btnDates: TButton;
|
||||
btnFloatsTests: TButton;
|
||||
btnWithJSON: TButton;
|
||||
Edit1: TEdit;
|
||||
Edit2: TEdit;
|
||||
btnSubtractWithNamedParams: TButton;
|
||||
Edit3: TEdit;
|
||||
PageControl2: TPageControl;
|
||||
TabSheet3: TTabSheet;
|
||||
TabSheet4: TTabSheet;
|
||||
edtFilter: TEdit;
|
||||
edtGetCustomers: TButton;
|
||||
DBGrid1: TDBGrid;
|
||||
btnGetMulti: TButton;
|
||||
lbMulti: TListBox;
|
||||
btnGenericException: TButton;
|
||||
TabSheet5: TTabSheet;
|
||||
Label1: TLabel;
|
||||
btnException: TButton;
|
||||
btnGenericExcWithCustomHandling: TButton;
|
||||
btnGenericExcWithCustomHAndling2: TButton;
|
||||
btnGenericExcWithoutCustomHandling: TButton;
|
||||
TabSheet6: TTabSheet;
|
||||
btnSingleRec: TButton;
|
||||
lbLogRec: TMemo;
|
||||
btnGetArrayOfRecords: TButton;
|
||||
btnGetDynArray: TButton;
|
||||
btnPassAndGetRecord: TButton;
|
||||
btnEchoComplexArray: TButton;
|
||||
btnComplex: TButton;
|
||||
btnParallel: TButton;
|
||||
procedure btnSubtractClick(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);
|
||||
procedure btnNotificationClick(Sender: TObject);
|
||||
procedure btnInvalidMethodClick(Sender: TObject);
|
||||
procedure btnSearchClick(Sender: TObject);
|
||||
procedure btnDatesClick(Sender: TObject);
|
||||
procedure btnFloatsTestsClick(Sender: TObject);
|
||||
procedure btnWithJSONClick(Sender: TObject);
|
||||
procedure btnSubtractWithNamedParamsClick(Sender: TObject);
|
||||
procedure btnGetMultiClick(Sender: TObject);
|
||||
procedure btnGetListOfDatasetClick(Sender: TObject);
|
||||
procedure btnObjDictClick(Sender: TObject);
|
||||
procedure btnExceptionClick(Sender: TObject);
|
||||
procedure btnGenericExceptionClick(Sender: TObject);
|
||||
procedure btnGenericExcWithCustomHandlingClick(Sender: TObject);
|
||||
procedure btnGenericExcWithCustomHAndling2Click(Sender: TObject);
|
||||
procedure btnGenericExcWithoutCustomHandlingClick(Sender: TObject);
|
||||
procedure btnSingleRecClick(Sender: TObject);
|
||||
procedure btnGetArrayOfRecordsClick(Sender: TObject);
|
||||
procedure btnGetDynArrayClick(Sender: TObject);
|
||||
procedure btnPassAndGetRecordClick(Sender: TObject);
|
||||
procedure btnEchoComplexArrayClick(Sender: TObject);
|
||||
procedure btnComplexClick(Sender: TObject);
|
||||
procedure btnParallelClick(Sender: TObject);
|
||||
private
|
||||
fExecutor: IMVCJSONRPCExecutorAsync;
|
||||
fExecutorAsync: IMVCJSONRPCExecutorAsync;
|
||||
fGeneralErrorHandler : TJSONRPCErrorHandlerProc;
|
||||
fWaiting: TWaitingForm;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
MainForm: TMainForm;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Generics.Collections,
|
||||
MVCFramework.JSONRPC,
|
||||
MVCFramework.Serializer.JsonDataObjects,
|
||||
JsonDataObjects,
|
||||
System.UITypes,
|
||||
MVCFramework.Serializer.Commons,
|
||||
MVCFramework.Commons,
|
||||
MVCFramework.Logger,
|
||||
MVCFramework.Serializer.Defaults,
|
||||
MVCFramework.DataSet.Utils,
|
||||
SyncObjs,
|
||||
BusinessObjectsU,
|
||||
System.Math,
|
||||
System.Rtti, CommonTypesU, MVCFramework.AsyncTask;
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
procedure TMainForm.btnAddDayClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'getnextmonday';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add(dtNextMonday.Date);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
dtNextMonday.Date := ISODateToDate(Resp.Result.AsString);
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnComplexClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lComplex: TNestedArraysRec;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'EchoComplexArrayOfRecords2';
|
||||
lReq.RequestID := Random(1000);
|
||||
lComplex.TestRecProp := TTestRec.Create(10);
|
||||
SetLength(lComplex.ArrayProp1, 2);
|
||||
SetLength(lComplex.ArrayProp2, 2);
|
||||
lComplex.ArrayProp1[0] := TTestRec.Create(10);
|
||||
lComplex.ArrayProp1[1] := TTestRec.Create(10);
|
||||
lComplex.ArrayProp2[0] := TTestRec.Create(10);
|
||||
lComplex.ArrayProp2[1] := TTestRec.Create(10);
|
||||
lReq.Params.Add(TValue.From<TNestedArraysRec>(lComplex), pdtRecordOrArrayOfRecord);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
lComplex := TJSONUtils.JSONObjectToRecord<TNestedArraysRec>(Resp);
|
||||
lbLogRec.Lines.Clear;
|
||||
lbLogRec.Lines.Add(lComplex.ToString);
|
||||
end,
|
||||
procedure (Exc: Exception)
|
||||
begin
|
||||
ShowMessage(Exc.ClassName + ': ' + Exc.Message);
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnDatesClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create(1234, 'playwithdatesandtimes');
|
||||
lReq.Params.Add(1234.5678, pdtFloat);
|
||||
lReq.Params.Add(Time(), pdtTime);
|
||||
lReq.Params.Add(Date(), pdtDate);
|
||||
lReq.Params.Add(Now(), pdtDateTime);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
ShowMessage(Resp.Result.AsString);
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnEchoComplexArrayClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lPeople: TTestRecDynArray;
|
||||
I: Integer;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'EchoComplexArrayOfRecords';
|
||||
lReq.RequestID := Random(1000);
|
||||
SetLength(lPeople, 2);
|
||||
lPeople[0] := TTestRec.Create(1);
|
||||
lPeople[1] := TTestRec.Create(2);
|
||||
lReq.Params.Add(TValue.From<TTestRecDynArray>(lPeople), pdtRecordOrArrayOfRecord);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
lPeople := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(Resp);
|
||||
lbLogRec.Lines.Clear;
|
||||
lbLogRec.Lines.Add('--- array of record elements ---');
|
||||
I := 1;
|
||||
for var lPRec in lPeople do
|
||||
begin
|
||||
lbLogRec.Lines.Add('ITEM: ' + I.ToString);
|
||||
lbLogRec.Lines.Add(lPRec.ToString);
|
||||
Inc(I);
|
||||
end;
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnExceptionClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCNotification;
|
||||
begin
|
||||
ShowMessage('Now will be raised a custom exception on the server. This exception will be catched by the client');
|
||||
lReq := TJSONRPCNotification.Create('RaiseCustomException');
|
||||
FExecutor.ExecuteNotificationAsync('/jsonrpc', lReq, fGeneralErrorHandler);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnFloatsTestsClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lRes: Extended;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create(1234, 'floatstest');
|
||||
lReq.Params.Add(1234.5678, pdtFloat);
|
||||
lReq.Params.Add(2345.6789, pdtFloat);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
lRes := Resp.Result.AsType<Extended>;
|
||||
lRes := RoundTo(lRes, -4);
|
||||
Assert(SameValue(lRes, 3580.2467), 'Wrong result: ' + FloatToStrF(lRes, ffGeneral, 18, 9));
|
||||
|
||||
lReq := TJSONRPCRequest.Create(1234, 'floatstest');
|
||||
lReq.Params.Add(123);
|
||||
lReq.Params.Add(234);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
var
|
||||
lRes: Extended;
|
||||
begin
|
||||
lRes := Resp.Result.AsType<Extended>;
|
||||
lRes := RoundTo(lRes, -4);
|
||||
Assert(SameValue(lRes, 357), 'Wrong result: ' + FloatToStrF(lRes, ffGeneral, 18, 9));
|
||||
end);
|
||||
end);
|
||||
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGetUserClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
lbPerson.Clear;
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'getuser';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add(edtUserName.Text);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
var
|
||||
lJSON: TJsonObject;
|
||||
begin
|
||||
// Remember that TObject descendants (but TDataset, TJDOJSONObject and TJDOJSONArray)
|
||||
// are serialized as JSON objects
|
||||
lJSON := Resp.Result.AsObject as TJsonObject;
|
||||
lbPerson.Items.Add('First Name:'.PadRight(15) + lJSON.S['firstname']);
|
||||
lbPerson.Items.Add('Last Name:'.PadRight(15) + lJSON.S['lastname']);
|
||||
lbPerson.Items.Add('Married:'.PadRight(15) + lJSON.B['married'].ToString(TUseBoolStrs.True));
|
||||
lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lJSON.D['dob']));
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnInvalid1Click(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create(1234);
|
||||
lReq.Method := 'invalidmethod1';
|
||||
lReq.Params.Add(1);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
ShowMessage(Resp.Error.ErrMessage);
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnInvalid2Click(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create(1234);
|
||||
lReq.Method := 'invalidmethod2';
|
||||
lReq.Params.Add(1);
|
||||
FExecutor.ExecuteNotificationAsync(
|
||||
'/jsonrpc',
|
||||
lReq,
|
||||
procedure (Exc: Exception)
|
||||
begin
|
||||
ShowMessage(Exc.Message);
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnInvalidMethodClick(Sender: TObject);
|
||||
var
|
||||
lNotification: IJSONRPCNotification;
|
||||
begin
|
||||
lNotification := TJSONRPCNotification.Create;
|
||||
lNotification.Method := 'notexists';
|
||||
FExecutor.ExecuteNotificationAsync('/jsonrpc', lNotification);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnNotificationClick(Sender: TObject);
|
||||
var
|
||||
lNotification: IJSONRPCNotification;
|
||||
begin
|
||||
lNotification := TJSONRPCNotification.Create;
|
||||
lNotification.Method := 'dosomething';
|
||||
FExecutor.ExecuteNotificationAsync('/jsonrpc', lNotification);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnObjDictClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lMultiDS: TMultiDataset;
|
||||
begin
|
||||
FDMemTable1.Active := False;
|
||||
lReq := TJSONRPCRequest.Create(Random(1000), 'getobjdict');
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(JSONRPCResponse: IJSONRPCResponse)
|
||||
begin
|
||||
lMultiDS := TMultiDataset.Create;
|
||||
try
|
||||
JsonObjectToObject(lResp.ResultAsJSONObject, lMultiDS);
|
||||
lbMulti.Clear;
|
||||
|
||||
lMultiDS.Customers.First;
|
||||
lbMulti.Items.Add('** CUSTOMERS **');
|
||||
while not lMultiDS.Customers.Eof do
|
||||
begin
|
||||
lbMulti.Items.Add(Format('%-20s (Code %3s)', [lMultiDS.Customers.FieldByName('Name').AsString,
|
||||
lMultiDS.Customers.FieldByName('Code').AsString]));
|
||||
lMultiDS.Customers.Next;
|
||||
end;
|
||||
|
||||
lMultiDS.People.First;
|
||||
lbMulti.Items.Add('** PEOPLE **');
|
||||
while not lMultiDS.People.Eof do
|
||||
begin
|
||||
lbMulti.Items.Add(Format('%s %s', [lMultiDS.People.FieldByName('FirstName').AsString,
|
||||
lMultiDS.People.FieldByName('LastName').AsString]));
|
||||
lMultiDS.People.Next;
|
||||
end;
|
||||
|
||||
finally
|
||||
lMultiDS.Free;
|
||||
end;
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnReverseStringClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'reversestring';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.AddByName('aString', edtReverseString.Text);
|
||||
lReq.Params.AddByName('aUpperCase', CheckBox1.Checked);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure (Resp: IJSONRPCResponse)
|
||||
begin
|
||||
edtReversedString.Text := Resp.Result.AsString;
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnSaveClick(Sender: TObject);
|
||||
var
|
||||
lPerson: TPerson;
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'saveperson';
|
||||
lReq.RequestID := Random(1000);
|
||||
lPerson := TPerson.Create;
|
||||
lReq.Params.AddByName('Person', lPerson, pdtObject);
|
||||
lPerson.FirstName := edtFirstName.Text;
|
||||
lPerson.LastName := edtLastName.Text;
|
||||
lPerson.Married := chkMarried.Checked;
|
||||
lPerson.DOB := dtDOB.Date;
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
ShowMessage('Person saved with ID = ' + Resp.Result.AsInteger.ToString);
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnSearchClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lJSON: TJsonArray;
|
||||
lJObj: TJsonObject;
|
||||
begin
|
||||
ListBox1.Clear;
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'searchproducts';
|
||||
lReq.RequestID := 1234;
|
||||
lReq.Params.Add(edtSearchText.Text);
|
||||
FExecutor.ExecuteRequestAsync('/rpcdatamodule', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
// Remember that TObject descendants (but TDataset, TJDOJSONObject and TJDOJSONArray)
|
||||
// are serialized as JSON objects
|
||||
lJSON := Resp.Result.AsObject as TJsonArray;
|
||||
for I := 0 to lJSON.Count - 1 do
|
||||
begin
|
||||
lJObj := lJSON[I].ObjectValue;
|
||||
ListBox1.Items.Add(Format('%6s: %-34s € %5.2f', [lJObj.S['codice'], lJObj.S['descrizione'], lJObj.F['prezzo']]));
|
||||
end;
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnSingleRecClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'GetPersonRec';
|
||||
lReq.RequestID := Random(1000);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
var
|
||||
lPersonRec: TTestRec;
|
||||
begin
|
||||
lPersonRec := TJSONUtils.JSONObjectToRecord<TTestRec>(Resp);
|
||||
lbLogRec.Lines.Text := Resp.ResultAsJSONObject.ToJSON(False);
|
||||
lbLogRec.Lines.Add('-- record --');
|
||||
lbLogRec.Lines.Add(lPersonRec.ToString);
|
||||
end, fGeneralErrorHandler);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnSubtractClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
fExecutorAsync := TMVCJSONRPCExecutor.Create('http://localhost:8080');
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'subtract';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add(StrToInt(edtValue1.Text));
|
||||
lReq.Params.Add(StrToInt(edtValue2.Text));
|
||||
fExecutorAsync
|
||||
.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(JSONRPCResp: IJSONRPCResponse)
|
||||
begin
|
||||
edtResult.Text := JSONRPCResp.Result.AsInteger.ToString;
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnSubtractWithNamedParamsClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'subtract';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.AddByName('Value1', StrToInt(Edit1.Text));
|
||||
lReq.Params.AddByName('Value2', StrToInt(Edit2.Text));
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
Edit3.Text := Resp.Result.AsInteger.ToString;
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnWithJSONClick(Sender: TObject);
|
||||
var
|
||||
lPerson: TJsonObject;
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'SaveObjectWithJSON';
|
||||
lReq.RequestID := 1234;
|
||||
lPerson := TJsonObject.Create;
|
||||
lReq.Params.Add(lPerson, pdTJDOJsonObject);
|
||||
lPerson.S['StringProp'] := 'Hello World';
|
||||
lPerson.O['JSONObject'] := TJsonObject.Parse('{"name":"Daniele"}') as TJsonObject;
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
lPerson := Resp.Result.AsObject as TJsonObject;
|
||||
ShowMessage(lPerson.ToJSON(False));
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnParallelClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lThreadCount: Int64;
|
||||
Val1, Val2, Val3, Val4: String;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'subtract';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.AddByName('Value1', StrToInt(Edit1.Text));
|
||||
lReq.Params.AddByName('Value2', StrToInt(Edit2.Text));
|
||||
lThreadCount := 4;
|
||||
|
||||
TThread.CreateAnonymousThread(
|
||||
procedure
|
||||
begin
|
||||
while TInterlocked.Read(lThreadCount) > 0 do
|
||||
begin
|
||||
Sleep(100);
|
||||
end;
|
||||
TThread.Queue(nil,
|
||||
procedure
|
||||
begin
|
||||
ShowMessage(
|
||||
Val1 + sLineBreak +
|
||||
Val2 + sLineBreak +
|
||||
Val3 + sLineBreak +
|
||||
Val4 + sLineBreak
|
||||
);
|
||||
end);
|
||||
end).Start;
|
||||
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
Val1 := Resp.Result.AsInteger.ToString;
|
||||
TInterlocked.Decrement(lThreadCount);
|
||||
end);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
Val2 := Resp.Result.AsInteger.ToString;
|
||||
TInterlocked.Decrement(lThreadCount);
|
||||
end);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
Val3 := Resp.Result.AsInteger.ToString;
|
||||
TInterlocked.Decrement(lThreadCount);
|
||||
end);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
Val4 := Resp.Result.AsInteger.ToString;
|
||||
TInterlocked.Decrement(lThreadCount);
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnPassAndGetRecordClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lPersonRec: TTestRec;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'SavePersonRec';
|
||||
lReq.RequestID := Random(1000);
|
||||
lPersonRec := TTestRec.Create(2);
|
||||
lReq.Params.Add(TValue.From<TTestRec>(lPersonRec), pdtRecordOrArrayOfRecord);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure (Resp: IJSONRPCResponse)
|
||||
var
|
||||
lResPersonRec: TTestRec;
|
||||
begin
|
||||
lResPersonRec := TJSONUtils.JSONObjectToRecord<TTestRec>(Resp);
|
||||
lbLogRec.Lines.Text := Resp.ResultAsJSONObject.ToJSON(False);
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGenericExceptionClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCNotification;
|
||||
begin
|
||||
ShowMessage('Now will be raised a EDivByZero exception on the server. This exception will be catched by the client');
|
||||
lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
|
||||
FExecutor.ExecuteNotificationAsync('/jsonrpc', lReq);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGenericExcWithCustomHAndling2Click(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
ShowMessage
|
||||
('Now will be raised a EInvalidPointerOperation exception on the server. However this exception will be handled by a custom exception handler wich will add a data property with extra data');
|
||||
lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
|
||||
lReq.Params.Add(2);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpcex', lReq, nil);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGenericExcWithCustomHandlingClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
ShowMessage
|
||||
('Now will be raised a EDivByZero exception on the server. However this exception will be handled by a custom exception handler wich will add a data property with extra data');
|
||||
lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
|
||||
lReq.Params.Add(1);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpcex', lReq, nil);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGenericExcWithoutCustomHandlingClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
ShowMessage('Now will be raised a Exception exception on the server.');
|
||||
lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
|
||||
lReq.Params.Add(99);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpcex', lReq, nil, fGeneralErrorHandler);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGetArrayOfRecordsClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lPeopleRec: TArray<TTestRec>; // server serializes a static array, we read it as dynarray
|
||||
I: Integer;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'GetPeopleRecStaticArray';
|
||||
lReq.RequestID := Random(1000);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
lPeopleRec := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(Resp);
|
||||
lbLogRec.Lines.Text := Resp.ResultAsJSONArray.ToJSON(False);
|
||||
lbLogRec.Lines.Add('-- array of record elements --');
|
||||
I := 1;
|
||||
for var lPRec in lPeopleRec do
|
||||
begin
|
||||
lbLogRec.Lines.Add('ITEM : ' + I.ToString);
|
||||
lbLogRec.Lines.Add(lPRec.ToString);
|
||||
Inc(I);
|
||||
end;
|
||||
end, fGeneralErrorHandler);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGetDynArrayClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'GetPeopleRecDynArray';
|
||||
lReq.RequestID := Random(1000);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
var
|
||||
lPeopleRec : TArray<TTestRec>;
|
||||
begin
|
||||
lPeopleRec := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(Resp);
|
||||
lbLogRec.Lines.Text := Resp.ResultAsJSONArray.ToJSON(False);
|
||||
end, fGeneralErrorHandler);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGetListOfDatasetClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
FDMemTable1.Active := False;
|
||||
lReq := TJSONRPCRequest.Create(Random(1000), 'GetDataSetList');
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
var
|
||||
lMultiDS: TObjectList<TDataSet>;
|
||||
begin
|
||||
lMultiDS := TObjectList<TDataSet>.Create(True);
|
||||
try
|
||||
JsonArrayToList(Resp.ResultAsJSONArray, WrapAsList(lMultiDS), TDataSet, TMVCSerializationType.stDefault, nil);
|
||||
finally
|
||||
lMultiDS.Free;
|
||||
end;
|
||||
end);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGetMultiClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
FDMemTable1.Active := False;
|
||||
lReq := TJSONRPCRequest.Create(Random(1000), 'getmulti');
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
var
|
||||
lMultiDS: TMultiDataset;
|
||||
begin
|
||||
lMultiDS := TMultiDataset.Create;
|
||||
try
|
||||
JsonObjectToObject(Resp.ResultAsJSONObject, lMultiDS);
|
||||
lbMulti.Clear;
|
||||
|
||||
lMultiDS.Customers.First;
|
||||
lbMulti.Items.Add('** CUSTOMERS **');
|
||||
while not lMultiDS.Customers.Eof do
|
||||
begin
|
||||
lbMulti.Items.Add(Format('%-20s (Code %3s)', [lMultiDS.Customers.FieldByName('Name').AsString,
|
||||
lMultiDS.Customers.FieldByName('Code').AsString]));
|
||||
lMultiDS.Customers.Next;
|
||||
end;
|
||||
|
||||
lMultiDS.People.First;
|
||||
lbMulti.Items.Add('** PEOPLE **');
|
||||
while not lMultiDS.People.Eof do
|
||||
begin
|
||||
lbMulti.Items.Add(Format('%s %s', [lMultiDS.People.FieldByName('FirstName').AsString,
|
||||
lMultiDS.People.FieldByName('LastName').AsString]));
|
||||
lMultiDS.People.Next;
|
||||
end;
|
||||
finally
|
||||
lMultiDS.Free;
|
||||
end;
|
||||
end,
|
||||
nil,
|
||||
jrpcPOST);
|
||||
end;
|
||||
|
||||
procedure TMainForm.edtGetCustomersClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
FDMemTable1.Active := False;
|
||||
lReq := TJSONRPCRequest.Create(Random(1000), 'getcustomers');
|
||||
lReq.Params.AddByName('FilterString', edtFilter.Text);
|
||||
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
|
||||
procedure(Resp: IJSONRPCResponse)
|
||||
begin
|
||||
FDMemTable1.Active := True;
|
||||
FDMemTable1.LoadFromTValue(Resp.Result);
|
||||
FDMemTable1.First;
|
||||
end,
|
||||
procedure(Exc: Exception)
|
||||
begin
|
||||
ShowMessage(Exc.ClassName + ': ' + Exc.Message);
|
||||
end,
|
||||
jrpcPOST);
|
||||
end;
|
||||
|
||||
procedure TMainForm.FormCreate(Sender: TObject);
|
||||
const
|
||||
SIMULATE_SLOW_NETWORK = False;
|
||||
begin
|
||||
FExecutor := TMVCJSONRPCExecutor.Create('http://localhost:8080');
|
||||
|
||||
FExecutor.SetOnSendCommandAsync(
|
||||
procedure(JSONRPCObject: IJSONRPCObject)
|
||||
begin
|
||||
if SIMULATE_SLOW_NETWORK then
|
||||
begin
|
||||
Sleep(1000 + Random(3000));
|
||||
end;
|
||||
Log.Debug('REQUEST : ' + JSONRPCObject.ToString(True), 'jsonrpc');
|
||||
end);
|
||||
|
||||
FExecutor.SetOnReceiveResponseAsync(
|
||||
procedure(Req, Resp: IJSONRPCObject)
|
||||
begin
|
||||
Log.Debug('>> OnReceiveResponse // start', 'jsonrpc');
|
||||
Log.Debug(' REQUEST : ' + Req.ToString(True), 'jsonrpc');
|
||||
Log.Debug(' RESPONSE: ' + Resp.ToString(True), 'jsonrpc');
|
||||
Log.Debug('<< OnReceiveResponse // end', 'jsonrpc');
|
||||
end);
|
||||
|
||||
FExecutor.SetOnReceiveHTTPResponseAsync(
|
||||
procedure(HTTPResp: IHTTPResponse)
|
||||
begin
|
||||
Log.Debug('RESPONSE: ' + HTTPResp.ContentAsString(), 'jsonrpc');
|
||||
end);
|
||||
|
||||
|
||||
FExecutor.SetConfigureHTTPClientAsync(
|
||||
procedure (HTTPClient: THTTPClient)
|
||||
begin
|
||||
HTTPClient.ResponseTimeout := 20000;
|
||||
HTTPClient.CustomHeaders['X-DMVCFRAMEWORK'] := 'DMVCFRAMEWORK_VERSION ' + DMVCFRAMEWORK_VERSION;
|
||||
end);
|
||||
|
||||
|
||||
dtNextMonday.Date := Date;
|
||||
// these are the methods to handle http headers in JSONRPC
|
||||
// the following line and the check on the server is just for demo
|
||||
Assert(FExecutor.HTTPHeadersCount = 0);
|
||||
FExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString));
|
||||
Assert(FExecutor.HTTPHeadersCount = 1);
|
||||
FExecutor.ClearHTTPHeaders;
|
||||
Assert(FExecutor.HTTPHeadersCount = 0);
|
||||
FExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString));
|
||||
|
||||
PageControl1.ActivePageIndex := 0;
|
||||
|
||||
fGeneralErrorHandler := procedure(Exc: Exception)
|
||||
begin
|
||||
ShowMessage(Exc.ClassName + ': ' + Exc.Message);
|
||||
end;
|
||||
|
||||
|
||||
fWaiting := TWaitingForm.Create(Self);
|
||||
fWaiting.PopupParent := Self;
|
||||
FExecutor.SetOnBeginAsyncRequest(
|
||||
procedure
|
||||
begin
|
||||
fWaiting.IncreaseWaitingCount;
|
||||
end);
|
||||
|
||||
FExecutor.SetOnEndAsyncRequest(
|
||||
procedure
|
||||
begin
|
||||
fWaiting.DecreaseWaitingCount;
|
||||
end);
|
||||
end;
|
||||
|
||||
end.
|
||||
69
samples/jsonrpc/async_client/WaitingFormU.dfm
Normal file
69
samples/jsonrpc/async_client/WaitingFormU.dfm
Normal file
@ -0,0 +1,69 @@
|
||||
object WaitingForm: TWaitingForm
|
||||
Left = 0
|
||||
Top = 0
|
||||
BorderIcons = []
|
||||
BorderStyle = bsNone
|
||||
ClientHeight = 149
|
||||
ClientWidth = 616
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -12
|
||||
Font.Name = 'Segoe UI'
|
||||
Font.Style = []
|
||||
PopupMode = pmAuto
|
||||
Position = poOwnerFormCenter
|
||||
OnDestroy = FormDestroy
|
||||
TextHeight = 15
|
||||
object Shape1: TShape
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 616
|
||||
Height = 149
|
||||
Align = alClient
|
||||
Pen.Color = clSilver
|
||||
Pen.Style = psInsideFrame
|
||||
ExplicitLeft = 256
|
||||
ExplicitTop = 56
|
||||
ExplicitWidth = 65
|
||||
ExplicitHeight = 65
|
||||
end
|
||||
object lblMessage: TLabel
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 616
|
||||
Height = 149
|
||||
Align = alClient
|
||||
Alignment = taCenter
|
||||
Caption = 'Please wait'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clGray
|
||||
Font.Height = -32
|
||||
Font.Name = 'Segoe UI Light'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
Layout = tlCenter
|
||||
ExplicitWidth = 148
|
||||
ExplicitHeight = 45
|
||||
end
|
||||
object lblRunningRequests: TLabel
|
||||
Left = 8
|
||||
Top = 126
|
||||
Width = 92
|
||||
Height = 15
|
||||
Caption = 'Running requests'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clGray
|
||||
Font.Height = -12
|
||||
Font.Name = 'Segoe UI'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
end
|
||||
object TimerWaiting: TTimer
|
||||
Enabled = False
|
||||
Interval = 900
|
||||
OnTimer = TimerWaitingTimer
|
||||
Left = 56
|
||||
Top = 40
|
||||
end
|
||||
end
|
||||
112
samples/jsonrpc/async_client/WaitingFormU.pas
Normal file
112
samples/jsonrpc/async_client/WaitingFormU.pas
Normal file
@ -0,0 +1,112 @@
|
||||
// ***************************************************************************
|
||||
//
|
||||
// Delphi MVC Framework
|
||||
//
|
||||
// Copyright (c) 2010-2024 Daniele Teti and the DMVCFramework Team
|
||||
//
|
||||
// https://github.com/danieleteti/delphimvcframework
|
||||
//
|
||||
// ***************************************************************************
|
||||
//
|
||||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||||
// you may not use this file except in compliance with the License.
|
||||
// You may obtain a copy of the License at
|
||||
//
|
||||
// http://www.apache.org/licenses/LICENSE-2.0
|
||||
//
|
||||
// Unless required by applicable law or agreed to in writing, software
|
||||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
// See the License for the specific language governing permissions and
|
||||
// limitations under the License.
|
||||
//
|
||||
// *************************************************************************** }
|
||||
|
||||
unit WaitingFormU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||||
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
|
||||
|
||||
type
|
||||
TWaitingForm = class(TForm)
|
||||
lblMessage: TLabel;
|
||||
Shape1: TShape;
|
||||
lblRunningRequests: TLabel;
|
||||
TimerWaiting: TTimer;
|
||||
procedure TimerWaitingTimer(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
private
|
||||
FWaitingCount: Integer;
|
||||
fPoints: Integer;
|
||||
procedure SetWaitingCount(const Value: Integer);
|
||||
{ Private declarations }
|
||||
public
|
||||
property WaitingCount: Integer read FWaitingCount write SetWaitingCount;
|
||||
procedure IncreaseWaitingCount;
|
||||
procedure DecreaseWaitingCount;
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Math, System.StrUtils;
|
||||
|
||||
{$R *.dfm}
|
||||
{ TWaitingForm }
|
||||
|
||||
procedure TWaitingForm.DecreaseWaitingCount;
|
||||
begin
|
||||
WaitingCount := WaitingCount - 1;
|
||||
end;
|
||||
|
||||
procedure TWaitingForm.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
Screen.Cursor := crDefault;
|
||||
end;
|
||||
|
||||
procedure TWaitingForm.IncreaseWaitingCount;
|
||||
begin
|
||||
WaitingCount := WaitingCount + 1;
|
||||
end;
|
||||
|
||||
procedure TWaitingForm.SetWaitingCount(const Value: Integer);
|
||||
begin
|
||||
FWaitingCount := Max(0, Value);
|
||||
if FWaitingCount = 0 then
|
||||
begin
|
||||
TimerWaiting.Enabled := False;
|
||||
Hide;
|
||||
Screen.Cursor := crDefault;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if not Visible then
|
||||
begin
|
||||
Screen.Cursor := crHourGlass;
|
||||
fPoints := 0;
|
||||
TimerWaiting.Enabled := True;
|
||||
Show;
|
||||
end;
|
||||
lblRunningRequests.Caption := FWaitingCount.ToString + ' running request' + ifthen(FWaitingCount > 1, 's');
|
||||
lblRunningRequests.Update;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWaitingForm.TimerWaitingTimer(Sender: TObject);
|
||||
begin
|
||||
if fPoints = 3 then
|
||||
begin
|
||||
fPoints := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Inc(fPoints);
|
||||
end;
|
||||
lblMessage.Caption := 'Please wait' + StringOfChar('.', fPoints);
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -0,0 +1,19 @@
|
||||
program jsonrpcclientwithobjects_async;
|
||||
|
||||
uses
|
||||
Vcl.Forms,
|
||||
MainClientFormU in 'MainClientFormU.pas' {MainForm},
|
||||
RandomUtilsU in '..\..\commons\RandomUtilsU.pas',
|
||||
BusinessObjectsU in '..\..\commons\BusinessObjectsU.pas',
|
||||
CommonTypesU in '..\CommonTypesU.pas',
|
||||
WaitingFormU in 'WaitingFormU.pas' {WaitingForm};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
ReportMemoryLeaksOnShutdown := True;
|
||||
Application.Initialize;
|
||||
Application.MainFormOnTaskbar := True;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
1116
samples/jsonrpc/async_client/jsonrpcclientwithobjects_async.dproj
Normal file
1116
samples/jsonrpc/async_client/jsonrpcclientwithobjects_async.dproj
Normal file
File diff suppressed because it is too large
Load Diff
60
samples/jsonrpc/jsonrpc_group.groupproj
Normal file
60
samples/jsonrpc/jsonrpc_group.groupproj
Normal file
@ -0,0 +1,60 @@
|
||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||
<PropertyGroup>
|
||||
<ProjectGuid>{AFDF54C5-5184-4A5F-A230-FB7F37B3B2F0}</ProjectGuid>
|
||||
</PropertyGroup>
|
||||
<ItemGroup>
|
||||
<Projects Include="jsonrpcserver\jsonrpcserverwithobjects.dproj">
|
||||
<Dependencies/>
|
||||
</Projects>
|
||||
<Projects Include="sync_client\jsonrpcclientwithobjects_sync.dproj">
|
||||
<Dependencies/>
|
||||
</Projects>
|
||||
<Projects Include="async_client\jsonrpcclientwithobjects_async.dproj">
|
||||
<Dependencies/>
|
||||
</Projects>
|
||||
</ItemGroup>
|
||||
<ProjectExtensions>
|
||||
<Borland.Personality>Default.Personality.12</Borland.Personality>
|
||||
<Borland.ProjectType/>
|
||||
<BorlandProject>
|
||||
<Default.Personality/>
|
||||
</BorlandProject>
|
||||
</ProjectExtensions>
|
||||
<Target Name="jsonrpcserverwithobjects">
|
||||
<MSBuild Projects="jsonrpcserver\jsonrpcserverwithobjects.dproj"/>
|
||||
</Target>
|
||||
<Target Name="jsonrpcserverwithobjects:Clean">
|
||||
<MSBuild Projects="jsonrpcserver\jsonrpcserverwithobjects.dproj" Targets="Clean"/>
|
||||
</Target>
|
||||
<Target Name="jsonrpcserverwithobjects:Make">
|
||||
<MSBuild Projects="jsonrpcserver\jsonrpcserverwithobjects.dproj" Targets="Make"/>
|
||||
</Target>
|
||||
<Target Name="jsonrpcclientwithobjects_sync">
|
||||
<MSBuild Projects="sync_client\jsonrpcclientwithobjects_sync.dproj"/>
|
||||
</Target>
|
||||
<Target Name="jsonrpcclientwithobjects_sync:Clean">
|
||||
<MSBuild Projects="sync_client\jsonrpcclientwithobjects_sync.dproj" Targets="Clean"/>
|
||||
</Target>
|
||||
<Target Name="jsonrpcclientwithobjects_sync:Make">
|
||||
<MSBuild Projects="sync_client\jsonrpcclientwithobjects_sync.dproj" Targets="Make"/>
|
||||
</Target>
|
||||
<Target Name="jsonrpcclientwithobjects_async">
|
||||
<MSBuild Projects="async_client\jsonrpcclientwithobjects_async.dproj"/>
|
||||
</Target>
|
||||
<Target Name="jsonrpcclientwithobjects_async:Clean">
|
||||
<MSBuild Projects="async_client\jsonrpcclientwithobjects_async.dproj" Targets="Clean"/>
|
||||
</Target>
|
||||
<Target Name="jsonrpcclientwithobjects_async:Make">
|
||||
<MSBuild Projects="async_client\jsonrpcclientwithobjects_async.dproj" Targets="Make"/>
|
||||
</Target>
|
||||
<Target Name="Build">
|
||||
<CallTarget Targets="jsonrpcserverwithobjects;jsonrpcclientwithobjects_sync;jsonrpcclientwithobjects_async"/>
|
||||
</Target>
|
||||
<Target Name="Clean">
|
||||
<CallTarget Targets="jsonrpcserverwithobjects:Clean;jsonrpcclientwithobjects_sync:Clean;jsonrpcclientwithobjects_async:Clean"/>
|
||||
</Target>
|
||||
<Target Name="Make">
|
||||
<CallTarget Targets="jsonrpcserverwithobjects:Make;jsonrpcclientwithobjects_sync:Make;jsonrpcclientwithobjects_async:Make"/>
|
||||
</Target>
|
||||
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
|
||||
</Project>
|
||||
7
samples/jsonrpc/jsonrpcserver/MainWebModuleU.dfm
Normal file
7
samples/jsonrpc/jsonrpcserver/MainWebModuleU.dfm
Normal file
@ -0,0 +1,7 @@
|
||||
object MyWebModule: TMyWebModule
|
||||
OnCreate = WebModuleCreate
|
||||
OnDestroy = WebModuleDestroy
|
||||
Actions = <>
|
||||
Height = 230
|
||||
Width = 415
|
||||
end
|
||||
104
samples/jsonrpc/jsonrpcserver/MainWebModuleU.pas
Normal file
104
samples/jsonrpc/jsonrpcserver/MainWebModuleU.pas
Normal file
@ -0,0 +1,104 @@
|
||||
unit MainWebModuleU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
Web.HTTPApp,
|
||||
MVCFramework,
|
||||
FireDAC.Stan.Intf,
|
||||
FireDAC.Stan.Option,
|
||||
FireDAC.Stan.Param,
|
||||
FireDAC.Stan.Error,
|
||||
FireDAC.DatS,
|
||||
FireDAC.Phys.Intf,
|
||||
FireDAC.DApt.Intf,
|
||||
Data.DB,
|
||||
FireDAC.Comp.DataSet,
|
||||
FireDAC.Comp.Client;
|
||||
|
||||
type
|
||||
TMyWebModule = class(TWebModule)
|
||||
procedure WebModuleCreate(Sender: TObject);
|
||||
procedure WebModuleDestroy(Sender: TObject);
|
||||
private
|
||||
FMVC: TMVCEngine;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
WebModuleClass: TComponentClass = TMyWebModule;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
System.IOUtils,
|
||||
MVCFramework.Commons,
|
||||
MyObjectU,
|
||||
MVCFramework.JSONRPC,
|
||||
MainDM, MVCFramework.Serializer.Commons, JsonDataObjects;
|
||||
|
||||
procedure TMyWebModule.WebModuleCreate(Sender: TObject);
|
||||
begin
|
||||
FMVC := TMVCEngine.Create(Self);
|
||||
|
||||
FMVC.PublishObject(
|
||||
function: TObject
|
||||
begin
|
||||
Result := TMyObject.Create;
|
||||
end, '/jsonrpc');
|
||||
|
||||
FMVC.PublishObject(
|
||||
function: TObject
|
||||
begin
|
||||
Result := TdmMain.Create;
|
||||
end, '/rpcdatamodule');
|
||||
|
||||
FMVC.PublishObject(
|
||||
function: TObject
|
||||
begin
|
||||
Result := TMyObject.Create;
|
||||
end, '/jsonrpcex',
|
||||
procedure(Exc: Exception;
|
||||
WebContext: TWebContext;
|
||||
var ErrorInfo: TMVCJSONRPCExceptionErrorInfo;
|
||||
var ExceptionHandled: Boolean)
|
||||
var
|
||||
lExtra: TJSONObject;
|
||||
begin
|
||||
if Exc is EInvalidPointer then
|
||||
begin
|
||||
ExceptionHandled := True;
|
||||
ErrorInfo.Code := 9999;
|
||||
ErrorInfo.Msg := 'Custom Message: ' + Exc.Message;
|
||||
// add a json object to the "data" field of the response
|
||||
lExtra := TJsonObject.Create;
|
||||
lExtra.S['extra'] := 'some extra data';
|
||||
ErrorInfo.Data := lExtra;
|
||||
ExceptionHandled := true;
|
||||
end
|
||||
else if Exc is EDivByZero then
|
||||
begin
|
||||
ExceptionHandled := True;
|
||||
ErrorInfo.Code := 888;
|
||||
ErrorInfo.Msg := 'Custom Message: ' + Exc.Message;
|
||||
ErrorInfo.Data := 'You cannot divide by 0';
|
||||
end
|
||||
else
|
||||
begin
|
||||
ExceptionHandled := False;
|
||||
end;
|
||||
end);
|
||||
|
||||
end;
|
||||
|
||||
procedure TMyWebModule.WebModuleDestroy(Sender: TObject);
|
||||
begin
|
||||
FMVC.Free;
|
||||
end;
|
||||
|
||||
end.
|
||||
432
samples/jsonrpc/jsonrpcserver/MyObjectU.pas
Normal file
432
samples/jsonrpc/jsonrpcserver/MyObjectU.pas
Normal file
@ -0,0 +1,432 @@
|
||||
// ***************************************************************************
|
||||
//
|
||||
// Delphi MVC Framework
|
||||
//
|
||||
// Copyright (c) 2010-2024 Daniele Teti and the DMVCFramework Team
|
||||
//
|
||||
// https://github.com/danieleteti/delphimvcframework
|
||||
//
|
||||
// ***************************************************************************
|
||||
//
|
||||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||||
// you may not use this file except in compliance with the License.
|
||||
// You may obtain a copy of the License at
|
||||
//
|
||||
// http://www.apache.org/licenses/LICENSE-2.0
|
||||
//
|
||||
// Unless required by applicable law or agreed to in writing, software
|
||||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
// See the License for the specific language governing permissions and
|
||||
// limitations under the License.
|
||||
//
|
||||
// *************************************************************************** }
|
||||
|
||||
unit MyObjectU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
JsonDataObjects,
|
||||
System.Generics.Collections,
|
||||
Data.DB,
|
||||
BusinessObjectsU,
|
||||
FireDAC.Comp.Client,
|
||||
MVCFramework.Serializer.Commons,
|
||||
MVCFramework.Commons, MVCFramework, MVCFramework.JSONRPC, CommonTypesU;
|
||||
|
||||
type
|
||||
|
||||
TMyObject = class
|
||||
private
|
||||
function GetCustomersDataset: TFDMemTable;
|
||||
procedure FillCustomersDataset(const DataSet: TDataSet);
|
||||
// function GetPeopleDataset: TFDMemTable;
|
||||
procedure FillPeopleDataset(const DataSet: TDataSet);
|
||||
public
|
||||
procedure OnBeforeCallHook(const Context: TWebContext; const JSONRequest: TJDOJsonObject);
|
||||
procedure OnBeforeRoutingHook(const Context: TWebContext; const JSON: TJDOJsonObject);
|
||||
procedure OnAfterCallHook(const Context: TWebContext; const JSONResponse: TJDOJsonObject);
|
||||
public
|
||||
[MVCDoc('You know, returns aValue1 - aValue2')]
|
||||
function Subtract(Value1, Value2: Integer): Integer;
|
||||
[MVCDoc('Returns the revers of the string passed as input')]
|
||||
function ReverseString(const aString: string; const aUpperCase: Boolean): string;
|
||||
[MVCDoc('Returns the next monday starting from aDate')]
|
||||
function GetNextMonday(const aDate: TDate): TDate;
|
||||
function PlayWithDatesAndTimes(const aJustAFloat: Double; const aTime: TTime;
|
||||
const aDate: TDate; const aDateAndTime: TDateTime): TDateTime;
|
||||
[MVCJSONRPCAllowGET]
|
||||
function GetCustomers(FilterString: string): TDataSet;
|
||||
[MVCJSONRPCAllowGET]
|
||||
function GetMulti: TMultiDataset;
|
||||
[MVCJSONRPCAllowGET]
|
||||
function GetStringDictionary: TMVCStringDictionary;
|
||||
function GetUser(aUserName: string): TPerson;
|
||||
function SavePerson(const Person: TJsonObject): Integer;
|
||||
function FloatsTest(const aDouble: Double; const aExtended: Extended): Extended;
|
||||
procedure DoSomething;
|
||||
procedure RaiseCustomException;
|
||||
function RaiseGenericException(const ExceptionType: Integer): Integer;
|
||||
function SaveObjectWithJSON(const WithJSON: TJsonObject): TJsonObject;
|
||||
//enums and sets support
|
||||
function PassingEnums(Value1: TEnumTest; Value2: TEnumTest): TEnumTest;
|
||||
function GetSetBySet(Value: TSetTest): TSetTest;
|
||||
|
||||
//records support
|
||||
function SavePersonRec(PersonRec: TTestRec): TTestRec;
|
||||
function GetPeopleRecDynArray: TTestRecDynArray;
|
||||
function GetPeopleRecStaticArray: TTestRecArray;
|
||||
function GetPersonRec: TTestRec;
|
||||
function GetComplex1: TNestedArraysRec;
|
||||
function EchoComplexArrayOfRecords(PeopleList: TTestRecDynArray): TTestRecDynArray;
|
||||
function EchoComplexArrayOfRecords2(VendorProxiesAndLinks: TNestedArraysRec): TNestedArraysRec;
|
||||
|
||||
// invalid parameters modifiers
|
||||
procedure InvalidMethod1(var MyVarParam: Integer);
|
||||
procedure InvalidMethod2(out MyOutParam: Integer);
|
||||
|
||||
end;
|
||||
|
||||
TUtils = class sealed
|
||||
class function JSONObjectAs<T: constructor, class>(const JSON: TJsonObject): T;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
MVCFramework.Logger,
|
||||
System.StrUtils,
|
||||
System.DateUtils, MVCFramework.Serializer.JsonDataObjects;
|
||||
|
||||
class function TUtils.JSONObjectAs<T>(const JSON: TJsonObject): T;
|
||||
var
|
||||
lObj: TObject;
|
||||
lSerializer: TMVCJsonDataObjectsSerializer;
|
||||
begin
|
||||
lObj := T.Create;
|
||||
try
|
||||
lSerializer := TMVCJsonDataObjectsSerializer.Create;
|
||||
try
|
||||
lSerializer.JsonObjectToObject(JSON, lObj, TMVCSerializationType.stProperties, []);
|
||||
finally
|
||||
lSerializer.Free;
|
||||
end;
|
||||
except
|
||||
lObj.Free;
|
||||
raise;
|
||||
end;
|
||||
Result := T(lObj);
|
||||
end;
|
||||
|
||||
{ TMyDerivedController }
|
||||
|
||||
procedure TMyObject.DoSomething;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
function TMyObject.PassingEnums(Value1, Value2: TEnumTest): TEnumTest;
|
||||
begin
|
||||
if Value1 = Value2 then
|
||||
begin
|
||||
Result := TEnumTest.ptEnumValue4;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := TEnumTest.ptEnumValue3;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMyObject.EchoComplexArrayOfRecords(
|
||||
PeopleList: TTestRecDynArray): TTestRecDynArray;
|
||||
begin
|
||||
Result := PeopleList;
|
||||
end;
|
||||
|
||||
function TMyObject.EchoComplexArrayOfRecords2(
|
||||
VendorProxiesAndLinks: TNestedArraysRec): TNestedArraysRec;
|
||||
begin
|
||||
Result := VendorProxiesAndLinks;
|
||||
Result.TestRecProp.StringProp := VendorProxiesAndLinks.TestRecProp.StringProp + ' (changed from server)';
|
||||
end;
|
||||
|
||||
procedure TMyObject.FillCustomersDataset(const DataSet: TDataSet);
|
||||
begin
|
||||
DataSet.AppendRecord([1, 'Ford']);
|
||||
DataSet.AppendRecord([2, 'Ferrari']);
|
||||
DataSet.AppendRecord([3, 'Lotus']);
|
||||
DataSet.AppendRecord([4, 'FCA']);
|
||||
DataSet.AppendRecord([5, 'Hyundai']);
|
||||
DataSet.AppendRecord([6, 'De Tomaso']);
|
||||
DataSet.AppendRecord([7, 'Dodge']);
|
||||
DataSet.AppendRecord([8, 'Tesla']);
|
||||
DataSet.AppendRecord([9, 'Kia']);
|
||||
DataSet.AppendRecord([10, 'Tata']);
|
||||
DataSet.AppendRecord([11, 'Volkswagen']);
|
||||
DataSet.AppendRecord([12, 'Audi']);
|
||||
DataSet.AppendRecord([13, 'Skoda']);
|
||||
DataSet.First;
|
||||
end;
|
||||
|
||||
procedure TMyObject.FillPeopleDataset(const DataSet: TDataSet);
|
||||
begin
|
||||
DataSet.AppendRecord(['Daniele', 'Teti']);
|
||||
DataSet.AppendRecord(['Peter', 'Parker']);
|
||||
DataSet.AppendRecord(['Bruce', 'Banner']);
|
||||
DataSet.AppendRecord(['Scott', 'Summers']);
|
||||
DataSet.AppendRecord(['Sue', 'Storm']);
|
||||
DataSet.First;
|
||||
end;
|
||||
|
||||
function TMyObject.FloatsTest(const aDouble: Double; const aExtended: Extended): Extended;
|
||||
begin
|
||||
Result := aDouble + aExtended;
|
||||
end;
|
||||
|
||||
function TMyObject.GetComplex1: TNestedArraysRec;
|
||||
begin
|
||||
SetLength(Result.ArrayProp1, 2);
|
||||
SetLength(Result.ArrayProp2, 2);
|
||||
|
||||
Result.ArrayProp1[0] := TTestRec.Create(1234);
|
||||
Result.ArrayProp1[1] := TTestRec.Create(2345);
|
||||
|
||||
Result.ArrayProp2[0] := TTestRec.Create(3456);
|
||||
Result.ArrayProp2[1] := TTestRec.Create(4567);
|
||||
|
||||
end;
|
||||
|
||||
function TMyObject.GetCustomers(FilterString: string): TDataSet;
|
||||
var
|
||||
lMT: TFDMemTable;
|
||||
begin
|
||||
lMT := GetCustomersDataset;
|
||||
try
|
||||
if not FilterString.IsEmpty then
|
||||
begin
|
||||
lMT.Filter := FilterString;
|
||||
lMT.Filtered := True;
|
||||
end;
|
||||
lMT.First;
|
||||
Result := lMT;
|
||||
except
|
||||
lMT.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMyObject.GetCustomersDataset: TFDMemTable;
|
||||
var
|
||||
lMT: TFDMemTable;
|
||||
begin
|
||||
lMT := TFDMemTable.Create(nil);
|
||||
try
|
||||
lMT.FieldDefs.Clear;
|
||||
lMT.FieldDefs.Add('Code', ftInteger);
|
||||
lMT.FieldDefs.Add('Name', ftString, 20);
|
||||
lMT.Active := True;
|
||||
lMT.AppendRecord([1, 'Ford']);
|
||||
lMT.AppendRecord([2, 'Ferrari']);
|
||||
lMT.AppendRecord([3, 'Lotus']);
|
||||
lMT.AppendRecord([4, 'FCA']);
|
||||
lMT.AppendRecord([5, 'Hyundai']);
|
||||
lMT.AppendRecord([6, 'De Tomaso']);
|
||||
lMT.AppendRecord([7, 'Dodge']);
|
||||
lMT.AppendRecord([8, 'Tesla']);
|
||||
lMT.AppendRecord([9, 'Kia']);
|
||||
lMT.AppendRecord([10, 'Tata']);
|
||||
lMT.AppendRecord([11, 'Volkswagen']);
|
||||
lMT.AppendRecord([12, 'Audi']);
|
||||
lMT.AppendRecord([13, 'Skoda']);
|
||||
lMT.First;
|
||||
Result := lMT;
|
||||
except
|
||||
lMT.Free;
|
||||
raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMyObject.GetMulti: TMultiDataset;
|
||||
begin
|
||||
Result := TMultiDataset.Create;
|
||||
FillCustomersDataset(Result.Customers);
|
||||
FillPeopleDataset(Result.People);
|
||||
end;
|
||||
|
||||
function TMyObject.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 TMyObject.GetPeopleRecDynArray: TTestRecDynArray;
|
||||
begin
|
||||
SetLength(Result, 2);
|
||||
Result[0] := TTestRec.Create(1);
|
||||
Result[1] := TTestRec.Create(2);
|
||||
end;
|
||||
|
||||
function TMyObject.GetPeopleRecStaticArray: TTestRecArray;
|
||||
begin
|
||||
Result[0] := TTestRec.Create(7);
|
||||
Result[1] := TTestRec.Create(8);
|
||||
end;
|
||||
|
||||
function TMyObject.GetPersonRec: TTestRec;
|
||||
begin
|
||||
Result := TTestRec.Create(99);
|
||||
end;
|
||||
|
||||
function TMyObject.GetSetBySet(Value: TSetTest): TSetTest;
|
||||
begin
|
||||
Result := [];
|
||||
for var lItem := ptEnumValue1 to ptEnumValue4 do
|
||||
begin
|
||||
if lItem in Value then
|
||||
begin
|
||||
Result := Result - [lItem];
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := Result + [lItem];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMyObject.GetStringDictionary: TMVCStringDictionary;
|
||||
begin
|
||||
Result := TMVCStringDictionary.Create;
|
||||
Result.Add('key1', 'value1');
|
||||
Result.Add('key2', 'value2');
|
||||
Result.Add('key3', 'value3');
|
||||
Result.Add('key4', 'value4');
|
||||
end;
|
||||
|
||||
function TMyObject.GetUser(aUserName: string): TPerson;
|
||||
begin
|
||||
Result := TPerson.Create;
|
||||
Result.FirstName := 'Daniele (a.k.a. ' + aUserName + ')';
|
||||
Result.LastName := 'Teti';
|
||||
Result.DOB := EncodeDate(1932, 11, 4); // hey, it is a joke :-)
|
||||
Result.Married := True;
|
||||
end;
|
||||
|
||||
procedure TMyObject.InvalidMethod1(var MyVarParam: Integer);
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
procedure TMyObject.InvalidMethod2(out MyOutParam: Integer);
|
||||
begin
|
||||
// do nothing
|
||||
end;
|
||||
|
||||
function TMyObject.PlayWithDatesAndTimes(const aJustAFloat: Double; const aTime: TTime;
|
||||
const aDate: TDate; const aDateAndTime: TDateTime): TDateTime;
|
||||
begin
|
||||
Result := aDateAndTime + aDate + aTime + TDateTime(aJustAFloat);
|
||||
end;
|
||||
|
||||
procedure TMyObject.RaiseCustomException;
|
||||
begin
|
||||
raise EMVCJSONRPCError.Create(JSONRPC_USER_ERROR + 1, 'This is an exception message');
|
||||
end;
|
||||
|
||||
function TMyObject.RaiseGenericException(const ExceptionType: Integer): Integer;
|
||||
var
|
||||
l: Integer;
|
||||
begin
|
||||
case ExceptionType of
|
||||
1:
|
||||
begin
|
||||
l := 0;
|
||||
Result := 10 div l;
|
||||
end;
|
||||
2:
|
||||
begin
|
||||
raise EInvalidPointer.Create('Fake Invalid Pointer Operation');
|
||||
end;
|
||||
else
|
||||
begin
|
||||
raise Exception.Create('BOOOOM!');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMyObject.ReverseString(const aString: string; const aUpperCase: Boolean): string;
|
||||
begin
|
||||
Result := System.StrUtils.ReverseString(aString);
|
||||
if aUpperCase then
|
||||
Result := Result.ToUpper;
|
||||
end;
|
||||
|
||||
function TMyObject.SaveObjectWithJSON(const WithJSON: TJsonObject): TJsonObject;
|
||||
var
|
||||
lObj: TObjectWithJSONObject;
|
||||
begin
|
||||
lObj := TUtils.JSONObjectAs<TObjectWithJSONObject>(WithJSON);
|
||||
try
|
||||
LogD(lObj);
|
||||
Result := WithJSON.Clone as TJsonObject;
|
||||
finally
|
||||
lObj.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMyObject.SavePerson(const Person: 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 TMyObject.SavePersonRec(PersonRec: TTestRec): TTestRec;
|
||||
begin
|
||||
Result := PersonRec;
|
||||
end;
|
||||
|
||||
function TMyObject.Subtract(Value1, Value2: Integer): Integer;
|
||||
begin
|
||||
Result := Value1 - Value2;
|
||||
end;
|
||||
|
||||
{ TMyObjectWithHooks }
|
||||
|
||||
procedure TMyObject.OnBeforeCallHook(const Context: TWebContext; const JSONRequest: TJDOJsonObject);
|
||||
begin
|
||||
Log.Info('TMyObjectWithHooks.OnBeforeCallHook >> ', 'jsonrpc');
|
||||
Log.Info(JSONRequest.ToJSON(False), 'jsonrpc');
|
||||
Log.Info('TMyObjectWithHooks.OnBeforeCallHook << ', 'jsonrpc');
|
||||
end;
|
||||
|
||||
procedure TMyObject.OnBeforeRoutingHook(const Context: TWebContext; const JSON: TJDOJsonObject);
|
||||
begin
|
||||
Log.Info('TMyObjectWithHooks.OnBeforeRoutingHook >> ', 'jsonrpc');
|
||||
Log.Info(JSON.ToJSON(False), 'jsonrpc');
|
||||
Log.Info('TMyObjectWithHooks.OnBeforeRoutingHook << ', 'jsonrpc');
|
||||
end;
|
||||
|
||||
procedure TMyObject.OnAfterCallHook(const Context: TWebContext; const JSONResponse: TJDOJsonObject);
|
||||
begin
|
||||
Log.Info('TMyObjectWithHooks.OnAfterCallHook >> ', 'jsonrpc');
|
||||
Log.Info(JSONResponse.ToJSON(False), 'jsonrpc');
|
||||
Log.Info('TMyObjectWithHooks.OnAfterCallHook << ', 'jsonrpc');
|
||||
end;
|
||||
|
||||
end.
|
||||
60
samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dpr
Normal file
60
samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dpr
Normal file
@ -0,0 +1,60 @@
|
||||
program jsonrpcserverwithobjects;
|
||||
|
||||
{$APPTYPE CONSOLE}
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
MVCFramework.Logger,
|
||||
MVCFramework.Commons,
|
||||
MVCFramework.Console,
|
||||
Web.ReqMulti,
|
||||
Web.WebReq,
|
||||
Web.WebBroker,
|
||||
IdHTTPWebBrokerBridge,
|
||||
MVCFramework.Signal,
|
||||
MyObjectU in 'MyObjectU.pas',
|
||||
MainWebModuleU in 'MainWebModuleU.pas' {MyWebModule: TWebModule},
|
||||
BusinessObjectsU in '..\..\commons\BusinessObjectsU.pas',
|
||||
RandomUtilsU in '..\..\commons\RandomUtilsU.pas',
|
||||
MainDM in '..\..\articles_crud_server\MainDM.pas' {dmMain: TDataModule},
|
||||
CommonTypesU in '..\CommonTypesU.pas',
|
||||
Services in '..\..\articles_crud_server\Services.pas',
|
||||
BusinessObjects in '..\..\articles_crud_server\BusinessObjects.pas',
|
||||
Commons in '..\..\articles_crud_server\Commons.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
procedure RunServer(APort: Integer);
|
||||
var
|
||||
lServer: TIdHTTPWebBrokerBridge;
|
||||
begin
|
||||
LogI('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION);
|
||||
LogI('JSON-RPC Server with Published Objects');
|
||||
LogI('Listening on port ' + APort.ToString);
|
||||
|
||||
LServer := TIdHTTPWebBrokerBridge.Create(nil);
|
||||
try
|
||||
LServer.DefaultPort := APort;
|
||||
lServer.Active := True;
|
||||
LogI('CTRL+C to quit...');
|
||||
WaitForTerminationSignal;
|
||||
finally
|
||||
LServer.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
UseConsoleLogger := True;
|
||||
ReportMemoryLeaksOnShutdown := True;
|
||||
IsMultiThread := True;
|
||||
TextColor(TConsoleColor.White);
|
||||
try
|
||||
if WebRequestHandler <> nil then
|
||||
WebRequestHandler.WebModuleClass := WebModuleClass;
|
||||
WebRequestHandlerProc.MaxConnections := 1024;
|
||||
RunServer(8080);
|
||||
except
|
||||
on E: Exception do
|
||||
LogE(E.ClassName + ': ' + E.Message);
|
||||
end;
|
||||
end.
|
||||
1027
samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dproj
Normal file
1027
samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dproj
Normal file
File diff suppressed because it is too large
Load Diff
637
samples/jsonrpc/sync_client/MainClientFormU.dfm
Normal file
637
samples/jsonrpc/sync_client/MainClientFormU.dfm
Normal file
@ -0,0 +1,637 @@
|
||||
object MainForm: TMainForm
|
||||
Left = 0
|
||||
Top = 0
|
||||
Caption = 'JSON-RPC 2.0 Client'
|
||||
ClientHeight = 604
|
||||
ClientWidth = 842
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OnCreate = FormCreate
|
||||
TextHeight = 13
|
||||
object PageControl1: TPageControl
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 842
|
||||
Height = 604
|
||||
ActivePage = TabSheet1
|
||||
Align = alClient
|
||||
TabOrder = 0
|
||||
ExplicitWidth = 838
|
||||
ExplicitHeight = 603
|
||||
object TabSheet1: TTabSheet
|
||||
Caption = 'Invoking Plain PODO'
|
||||
object GroupBox1: TGroupBox
|
||||
Left = 3
|
||||
Top = 22
|
||||
Width = 815
|
||||
Height = 174
|
||||
Caption = 'Simple Types'
|
||||
TabOrder = 0
|
||||
object edtValue1: TEdit
|
||||
Left = 17
|
||||
Top = 32
|
||||
Width = 32
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
Text = '42'
|
||||
end
|
||||
object edtValue2: TEdit
|
||||
Left = 55
|
||||
Top = 32
|
||||
Width = 26
|
||||
Height = 21
|
||||
TabOrder = 1
|
||||
Text = '10'
|
||||
end
|
||||
object btnSubtract: TButton
|
||||
Left = 87
|
||||
Top = 30
|
||||
Width = 100
|
||||
Height = 25
|
||||
Caption = 'Subtract'
|
||||
TabOrder = 2
|
||||
OnClick = btnSubtractClick
|
||||
end
|
||||
object edtResult: TEdit
|
||||
Left = 193
|
||||
Top = 32
|
||||
Width = 27
|
||||
Height = 21
|
||||
ReadOnly = True
|
||||
TabOrder = 3
|
||||
end
|
||||
object edtReverseString: TEdit
|
||||
Left = 17
|
||||
Top = 80
|
||||
Width = 88
|
||||
Height = 21
|
||||
TabOrder = 4
|
||||
Text = 'Daniele Teti'
|
||||
end
|
||||
object btnReverseString: TButton
|
||||
Left = 111
|
||||
Top = 78
|
||||
Width = 109
|
||||
Height = 25
|
||||
Caption = 'Reverse String'
|
||||
TabOrder = 5
|
||||
OnClick = btnReverseStringClick
|
||||
end
|
||||
object edtReversedString: TEdit
|
||||
Left = 320
|
||||
Top = 80
|
||||
Width = 131
|
||||
Height = 21
|
||||
ReadOnly = True
|
||||
TabOrder = 6
|
||||
end
|
||||
object dtNextMonday: TDateTimePicker
|
||||
Left = 253
|
||||
Top = 32
|
||||
Width = 102
|
||||
Height = 21
|
||||
Date = 43018.000000000000000000
|
||||
Time = 0.469176562502980200
|
||||
TabOrder = 7
|
||||
end
|
||||
object btnAddDay: TButton
|
||||
Left = 361
|
||||
Top = 30
|
||||
Width = 104
|
||||
Height = 25
|
||||
Caption = 'Get Next Monday'
|
||||
TabOrder = 8
|
||||
OnClick = btnAddDayClick
|
||||
end
|
||||
object btnInvalid1: TButton
|
||||
Left = 626
|
||||
Top = 78
|
||||
Width = 84
|
||||
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
|
||||
WordWrap = True
|
||||
OnClick = btnInvalid1Click
|
||||
end
|
||||
object btnInvalid2: TButton
|
||||
Left = 716
|
||||
Top = 78
|
||||
Width = 84
|
||||
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
|
||||
object btnNotification: TButton
|
||||
Left = 464
|
||||
Top = 78
|
||||
Width = 75
|
||||
Height = 43
|
||||
Caption = 'Send Notification'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clScrollBar
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 11
|
||||
WordWrap = True
|
||||
OnClick = btnNotificationClick
|
||||
end
|
||||
object btnInvalidMethod: TButton
|
||||
Left = 545
|
||||
Top = 78
|
||||
Width = 75
|
||||
Height = 43
|
||||
Caption = 'Invalid Method'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clScrollBar
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 12
|
||||
WordWrap = True
|
||||
OnClick = btnInvalidMethodClick
|
||||
end
|
||||
object CheckBox1: TCheckBox
|
||||
Left = 226
|
||||
Top = 82
|
||||
Width = 88
|
||||
Height = 17
|
||||
Caption = 'As Uppercase'
|
||||
TabOrder = 13
|
||||
end
|
||||
object btnDates: TButton
|
||||
Left = 716
|
||||
Top = 30
|
||||
Width = 84
|
||||
Height = 25
|
||||
Caption = 'PlayWithDates'
|
||||
TabOrder = 14
|
||||
OnClick = btnDatesClick
|
||||
end
|
||||
object btnFloatsTests: TButton
|
||||
Left = 626
|
||||
Top = 30
|
||||
Width = 84
|
||||
Height = 25
|
||||
Caption = 'Floats'
|
||||
TabOrder = 15
|
||||
OnClick = btnFloatsTestsClick
|
||||
end
|
||||
object btnWithJSON: TButton
|
||||
Left = 545
|
||||
Top = 30
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = 'JSON Prop'
|
||||
TabOrder = 16
|
||||
OnClick = btnWithJSONClick
|
||||
end
|
||||
object Edit1: TEdit
|
||||
Left = 17
|
||||
Top = 136
|
||||
Width = 32
|
||||
Height = 21
|
||||
TabOrder = 17
|
||||
Text = '42'
|
||||
end
|
||||
object Edit2: TEdit
|
||||
Left = 55
|
||||
Top = 136
|
||||
Width = 26
|
||||
Height = 21
|
||||
TabOrder = 18
|
||||
Text = '10'
|
||||
end
|
||||
object btnSubtractWithNamedParams: TButton
|
||||
Left = 87
|
||||
Top = 134
|
||||
Width = 160
|
||||
Height = 25
|
||||
Caption = 'Subtract (named params)'
|
||||
TabOrder = 19
|
||||
OnClick = btnSubtractWithNamedParamsClick
|
||||
end
|
||||
object Edit3: TEdit
|
||||
Left = 253
|
||||
Top = 136
|
||||
Width = 27
|
||||
Height = 21
|
||||
ReadOnly = True
|
||||
TabOrder = 20
|
||||
end
|
||||
object btnGenericException: TButton
|
||||
Left = 464
|
||||
Top = 127
|
||||
Width = 156
|
||||
Height = 32
|
||||
Caption = 'Raise Generic Exception'
|
||||
TabOrder = 21
|
||||
OnClick = btnGenericExceptionClick
|
||||
end
|
||||
object btnException: TButton
|
||||
Left = 626
|
||||
Top = 127
|
||||
Width = 170
|
||||
Height = 32
|
||||
Caption = 'Raise Custom Exception'
|
||||
TabOrder = 22
|
||||
OnClick = btnExceptionClick
|
||||
end
|
||||
end
|
||||
object GroupBox2: TGroupBox
|
||||
Left = 3
|
||||
Top = 202
|
||||
Width = 489
|
||||
Height = 159
|
||||
Caption = 'Returning Objects'
|
||||
TabOrder = 1
|
||||
object edtUserName: TEdit
|
||||
Left = 16
|
||||
Top = 24
|
||||
Width = 184
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
Text = 'dteti'
|
||||
end
|
||||
object btnGetUser: TButton
|
||||
Left = 206
|
||||
Top = 22
|
||||
Width = 91
|
||||
Height = 25
|
||||
Caption = 'Get User'
|
||||
TabOrder = 1
|
||||
OnClick = btnGetUserClick
|
||||
end
|
||||
object lbPerson: TListBox
|
||||
Left = 16
|
||||
Top = 53
|
||||
Width = 435
|
||||
Height = 82
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -13
|
||||
Font.Name = 'Courier New'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
object GroupBox4: TGroupBox
|
||||
Left = 3
|
||||
Top = 383
|
||||
Width = 489
|
||||
Height = 129
|
||||
Caption = 'Passing Objects as parameters'
|
||||
TabOrder = 2
|
||||
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.000000000000000000
|
||||
Time = 0.469176562499342300
|
||||
TabOrder = 3
|
||||
end
|
||||
object btnSave: TButton
|
||||
Left = 376
|
||||
Top = 88
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = 'Save'
|
||||
TabOrder = 4
|
||||
OnClick = btnSaveClick
|
||||
end
|
||||
end
|
||||
object PageControl2: TPageControl
|
||||
Left = 514
|
||||
Top = 202
|
||||
Width = 304
|
||||
Height = 367
|
||||
ActivePage = TabSheet4
|
||||
TabOrder = 3
|
||||
object TabSheet3: TTabSheet
|
||||
Caption = 'Get DataSet'
|
||||
object edtFilter: TEdit
|
||||
Left = 3
|
||||
Top = 5
|
||||
Width = 184
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
end
|
||||
object edtGetCustomers: TButton
|
||||
Left = 193
|
||||
Top = 3
|
||||
Width = 91
|
||||
Height = 25
|
||||
Caption = 'Get Customers'
|
||||
TabOrder = 1
|
||||
OnClick = edtGetCustomersClick
|
||||
end
|
||||
object DBGrid1: TDBGrid
|
||||
Left = 3
|
||||
Top = 34
|
||||
Width = 279
|
||||
Height = 302
|
||||
DataSource = DataSource1
|
||||
TabOrder = 2
|
||||
TitleFont.Charset = DEFAULT_CHARSET
|
||||
TitleFont.Color = clWindowText
|
||||
TitleFont.Height = -11
|
||||
TitleFont.Name = 'Tahoma'
|
||||
TitleFont.Style = []
|
||||
end
|
||||
end
|
||||
object TabSheet4: TTabSheet
|
||||
Caption = 'Get Multi Dataset'
|
||||
ImageIndex = 1
|
||||
object btnGetMulti: TButton
|
||||
Left = 13
|
||||
Top = 16
|
||||
Width = 268
|
||||
Height = 41
|
||||
Caption = 'Get Multiple Datasets'
|
||||
TabOrder = 0
|
||||
OnClick = btnGetMultiClick
|
||||
end
|
||||
object lbMulti: TListBox
|
||||
Left = 16
|
||||
Top = 63
|
||||
Width = 265
|
||||
Height = 266
|
||||
Font.Charset = ANSI_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Courier New'
|
||||
Font.Style = []
|
||||
ItemHeight = 14
|
||||
ParentFont = False
|
||||
TabOrder = 1
|
||||
end
|
||||
end
|
||||
end
|
||||
object btnSet: TButton
|
||||
Left = 379
|
||||
Top = 536
|
||||
Width = 75
|
||||
Height = 25
|
||||
Caption = 'Using Sets'
|
||||
TabOrder = 4
|
||||
OnClick = btnSetClick
|
||||
end
|
||||
end
|
||||
object TabSheet2: TTabSheet
|
||||
Caption = 'Invoking DataModule Methods'
|
||||
ImageIndex = 1
|
||||
object GroupBox5: TGroupBox
|
||||
Left = 11
|
||||
Top = 18
|
||||
Width = 489
|
||||
Height = 391
|
||||
Caption = 'Returning Objects'
|
||||
TabOrder = 0
|
||||
DesignSize = (
|
||||
489
|
||||
391)
|
||||
object edtSearchText: TEdit
|
||||
Left = 16
|
||||
Top = 24
|
||||
Width = 184
|
||||
Height = 21
|
||||
TabOrder = 0
|
||||
Text = 'pizz'
|
||||
end
|
||||
object btnSearch: TButton
|
||||
Left = 206
|
||||
Top = 22
|
||||
Width = 91
|
||||
Height = 25
|
||||
Caption = 'Search Article'
|
||||
TabOrder = 1
|
||||
OnClick = btnSearchClick
|
||||
end
|
||||
object ListBox1: TListBox
|
||||
Left = 16
|
||||
Top = 53
|
||||
Width = 435
|
||||
Height = 316
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -13
|
||||
Font.Name = 'Courier New'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
end
|
||||
object TabSheet5: TTabSheet
|
||||
Caption = 'Custom Exceptions Handling'
|
||||
ImageIndex = 2
|
||||
object Label1: TLabel
|
||||
AlignWithMargins = True
|
||||
Left = 3
|
||||
Top = 3
|
||||
Width = 808
|
||||
Height = 69
|
||||
Align = alTop
|
||||
Caption =
|
||||
'If an exception raised by the serve doesn'#39't inherith from EMVCJS' +
|
||||
'ONRPCErrorResponse can be handled by a custom global exception b' +
|
||||
'lock. This custom handling can modify error code, error message ' +
|
||||
'and can add a custom data property to the exception.'
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -19
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
WordWrap = True
|
||||
end
|
||||
object btnGenericExcWithCustomHandling: TButton
|
||||
Left = 0
|
||||
Top = 103
|
||||
Width = 217
|
||||
Height = 82
|
||||
Caption = 'Raise Generic Exception with custom handling (DATA is a String)'
|
||||
TabOrder = 0
|
||||
WordWrap = True
|
||||
OnClick = btnGenericExcWithCustomHandlingClick
|
||||
end
|
||||
object btnGenericExcWithCustomHAndling2: TButton
|
||||
Left = 223
|
||||
Top = 103
|
||||
Width = 217
|
||||
Height = 82
|
||||
Caption =
|
||||
'Raise Generic Exception with custom handling (DATA is a JSONObje' +
|
||||
'ct)'
|
||||
TabOrder = 1
|
||||
WordWrap = True
|
||||
OnClick = btnGenericExcWithCustomHAndling2Click
|
||||
end
|
||||
object btnGenericExcWithoutCustomHandling: TButton
|
||||
Left = 446
|
||||
Top = 103
|
||||
Width = 217
|
||||
Height = 82
|
||||
Caption = 'Raise Generic Exception without custom handling'
|
||||
TabOrder = 2
|
||||
WordWrap = True
|
||||
OnClick = btnGenericExcWithoutCustomHandlingClick
|
||||
end
|
||||
end
|
||||
object TabSheet6: TTabSheet
|
||||
Caption = 'Using record as parameters'
|
||||
ImageIndex = 3
|
||||
DesignSize = (
|
||||
834
|
||||
576)
|
||||
object btnSingleRec: TButton
|
||||
Left = 16
|
||||
Top = 16
|
||||
Width = 185
|
||||
Height = 41
|
||||
Caption = 'Returning Single Record'
|
||||
TabOrder = 0
|
||||
OnClick = btnSingleRecClick
|
||||
end
|
||||
object lbLogRec: TMemo
|
||||
Left = 216
|
||||
Top = 16
|
||||
Width = 589
|
||||
Height = 545
|
||||
Anchors = [akLeft, akTop, akRight, akBottom]
|
||||
Font.Charset = ANSI_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -13
|
||||
Font.Name = 'Consolas'
|
||||
Font.Style = []
|
||||
ParentFont = False
|
||||
ReadOnly = True
|
||||
ScrollBars = ssBoth
|
||||
TabOrder = 1
|
||||
WordWrap = False
|
||||
end
|
||||
object btnGetArrayOfRecords: TButton
|
||||
Left = 16
|
||||
Top = 63
|
||||
Width = 185
|
||||
Height = 40
|
||||
Caption = 'Returning Array of Records'
|
||||
TabOrder = 2
|
||||
OnClick = btnGetArrayOfRecordsClick
|
||||
end
|
||||
object btnGetDynArray: TButton
|
||||
Left = 16
|
||||
Top = 109
|
||||
Width = 185
|
||||
Height = 40
|
||||
Caption = 'Returning DynArray of Records'
|
||||
TabOrder = 3
|
||||
OnClick = btnGetDynArrayClick
|
||||
end
|
||||
object btnPassAndGetRecord: TButton
|
||||
Left = 16
|
||||
Top = 155
|
||||
Width = 185
|
||||
Height = 40
|
||||
Caption = 'Using record parameters'
|
||||
TabOrder = 4
|
||||
OnClick = btnPassAndGetRecordClick
|
||||
end
|
||||
object btnEchoComplexArray: TButton
|
||||
Left = 16
|
||||
Top = 201
|
||||
Width = 185
|
||||
Height = 40
|
||||
Caption = 'Using Array as Parameter'
|
||||
TabOrder = 5
|
||||
OnClick = btnEchoComplexArrayClick
|
||||
end
|
||||
object btnComplex: TButton
|
||||
Left = 16
|
||||
Top = 247
|
||||
Width = 185
|
||||
Height = 40
|
||||
Caption = 'Using parameter with multiple arrays'
|
||||
TabOrder = 6
|
||||
OnClick = btnComplexClick
|
||||
end
|
||||
end
|
||||
end
|
||||
object DataSource1: TDataSource
|
||||
DataSet = FDMemTable1
|
||||
Left = 455
|
||||
Top = 216
|
||||
end
|
||||
object FDMemTable1: TFDMemTable
|
||||
FetchOptions.AssignedValues = [evMode]
|
||||
FetchOptions.Mode = fmAll
|
||||
ResourceOptions.AssignedValues = [rvSilentMode]
|
||||
ResourceOptions.SilentMode = True
|
||||
UpdateOptions.AssignedValues = [uvCheckRequired, uvAutoCommitUpdates]
|
||||
UpdateOptions.CheckRequired = False
|
||||
UpdateOptions.AutoCommitUpdates = True
|
||||
Left = 767
|
||||
Top = 328
|
||||
object FDMemTable1Code: TIntegerField
|
||||
FieldName = 'Code'
|
||||
end
|
||||
object FDMemTable1Name: TStringField
|
||||
FieldName = 'Name'
|
||||
end
|
||||
end
|
||||
end
|
||||
786
samples/jsonrpc/sync_client/MainClientFormU.pas
Normal file
786
samples/jsonrpc/sync_client/MainClientFormU.pas
Normal file
@ -0,0 +1,786 @@
|
||||
// ***************************************************************************
|
||||
//
|
||||
// Delphi MVC Framework
|
||||
//
|
||||
// Copyright (c) 2010-2023 Daniele Teti and the DMVCFramework Team
|
||||
//
|
||||
// https://github.com/danieleteti/delphimvcframework
|
||||
//
|
||||
// ***************************************************************************
|
||||
//
|
||||
// Licensed under the Apache License, Version 2.0 (the "License");
|
||||
// you may not use this file except in compliance with the License.
|
||||
// You may obtain a copy of the License at
|
||||
//
|
||||
// http://www.apache.org/licenses/LICENSE-2.0
|
||||
//
|
||||
// Unless required by applicable law or agreed to in writing, software
|
||||
// distributed under the License is distributed on an "AS IS" BASIS,
|
||||
// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
// See the License for the specific language governing permissions and
|
||||
// limitations under the License.
|
||||
//
|
||||
// *************************************************************************** }
|
||||
|
||||
unit MainClientFormU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Winapi.Windows,
|
||||
Winapi.Messages,
|
||||
System.SysUtils,
|
||||
System.Variants,
|
||||
System.Classes,
|
||||
Vcl.Graphics,
|
||||
Vcl.Controls,
|
||||
Vcl.Forms,
|
||||
Vcl.Dialogs,
|
||||
System.Net.HttpClientComponent,
|
||||
Vcl.StdCtrls,
|
||||
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,
|
||||
Vcl.ComCtrls,
|
||||
Vcl.ExtCtrls,
|
||||
MVCFramework.JSONRPC.Client, Vcl.Mask;
|
||||
|
||||
type
|
||||
TMainForm = class(TForm)
|
||||
DataSource1: TDataSource;
|
||||
FDMemTable1: TFDMemTable;
|
||||
FDMemTable1Code: TIntegerField;
|
||||
FDMemTable1Name: TStringField;
|
||||
GroupBox1: TGroupBox;
|
||||
edtValue1: TEdit;
|
||||
edtValue2: TEdit;
|
||||
btnSubtract: TButton;
|
||||
edtResult: TEdit;
|
||||
edtReverseString: TEdit;
|
||||
btnReverseString: TButton;
|
||||
edtReversedString: TEdit;
|
||||
GroupBox2: TGroupBox;
|
||||
edtUserName: TEdit;
|
||||
btnGetUser: TButton;
|
||||
lbPerson: TListBox;
|
||||
GroupBox4: TGroupBox;
|
||||
edtFirstName: TLabeledEdit;
|
||||
edtLastName: TLabeledEdit;
|
||||
chkMarried: TCheckBox;
|
||||
dtDOB: TDateTimePicker;
|
||||
btnSave: TButton;
|
||||
dtNextMonday: TDateTimePicker;
|
||||
btnAddDay: TButton;
|
||||
btnInvalid1: TButton;
|
||||
btnInvalid2: TButton;
|
||||
btnNotification: TButton;
|
||||
btnInvalidMethod: TButton;
|
||||
PageControl1: TPageControl;
|
||||
TabSheet1: TTabSheet;
|
||||
TabSheet2: TTabSheet;
|
||||
GroupBox5: TGroupBox;
|
||||
edtSearchText: TEdit;
|
||||
btnSearch: TButton;
|
||||
ListBox1: TListBox;
|
||||
CheckBox1: TCheckBox;
|
||||
btnDates: TButton;
|
||||
btnFloatsTests: TButton;
|
||||
btnWithJSON: TButton;
|
||||
Edit1: TEdit;
|
||||
Edit2: TEdit;
|
||||
btnSubtractWithNamedParams: TButton;
|
||||
Edit3: TEdit;
|
||||
PageControl2: TPageControl;
|
||||
TabSheet3: TTabSheet;
|
||||
TabSheet4: TTabSheet;
|
||||
edtFilter: TEdit;
|
||||
edtGetCustomers: TButton;
|
||||
DBGrid1: TDBGrid;
|
||||
btnGetMulti: TButton;
|
||||
lbMulti: TListBox;
|
||||
btnGenericException: TButton;
|
||||
TabSheet5: TTabSheet;
|
||||
Label1: TLabel;
|
||||
btnException: TButton;
|
||||
btnGenericExcWithCustomHandling: TButton;
|
||||
btnGenericExcWithCustomHAndling2: TButton;
|
||||
btnGenericExcWithoutCustomHandling: TButton;
|
||||
TabSheet6: TTabSheet;
|
||||
btnSingleRec: TButton;
|
||||
lbLogRec: TMemo;
|
||||
btnGetArrayOfRecords: TButton;
|
||||
btnGetDynArray: TButton;
|
||||
btnPassAndGetRecord: TButton;
|
||||
btnEchoComplexArray: TButton;
|
||||
btnComplex: TButton;
|
||||
btnSet: TButton;
|
||||
procedure btnSubtractClick(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);
|
||||
procedure btnNotificationClick(Sender: TObject);
|
||||
procedure btnInvalidMethodClick(Sender: TObject);
|
||||
procedure btnSearchClick(Sender: TObject);
|
||||
procedure btnDatesClick(Sender: TObject);
|
||||
procedure btnFloatsTestsClick(Sender: TObject);
|
||||
procedure btnWithJSONClick(Sender: TObject);
|
||||
procedure btnSubtractWithNamedParamsClick(Sender: TObject);
|
||||
procedure btnGetMultiClick(Sender: TObject);
|
||||
procedure btnGetListOfDatasetClick(Sender: TObject);
|
||||
procedure btnObjDictClick(Sender: TObject);
|
||||
procedure btnExceptionClick(Sender: TObject);
|
||||
procedure btnGenericExceptionClick(Sender: TObject);
|
||||
procedure btnGenericExcWithCustomHandlingClick(Sender: TObject);
|
||||
procedure btnGenericExcWithCustomHAndling2Click(Sender: TObject);
|
||||
procedure btnGenericExcWithoutCustomHandlingClick(Sender: TObject);
|
||||
procedure btnSingleRecClick(Sender: TObject);
|
||||
procedure btnGetArrayOfRecordsClick(Sender: TObject);
|
||||
procedure btnGetDynArrayClick(Sender: TObject);
|
||||
procedure btnPassAndGetRecordClick(Sender: TObject);
|
||||
procedure btnEchoComplexArrayClick(Sender: TObject);
|
||||
procedure btnComplexClick(Sender: TObject);
|
||||
procedure btnSetClick(Sender: TObject);
|
||||
private
|
||||
FExecutor: IMVCJSONRPCExecutor;
|
||||
public
|
||||
{ Public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
MainForm: TMainForm;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Generics.Collections,
|
||||
MVCFramework.JSONRPC,
|
||||
MVCFramework.Serializer.JsonDataObjects,
|
||||
JsonDataObjects,
|
||||
MVCFramework.Serializer.Commons,
|
||||
MVCFramework.Commons,
|
||||
MVCFramework.Logger,
|
||||
MVCFramework.Serializer.Defaults,
|
||||
MVCFramework.DataSet.Utils,
|
||||
BusinessObjectsU,
|
||||
System.Math,
|
||||
System.Rtti, CommonTypesU;
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
procedure TMainForm.btnAddDayClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'getnextmonday';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add(dtNextMonday.Date);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
dtNextMonday.Date := ISODateToDate(lResp.Result.AsString);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnComplexClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lComplex: TNestedArraysRec;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'EchoComplexArrayOfRecords2';
|
||||
lReq.RequestID := Random(1000);
|
||||
lComplex.TestRecProp := TTestRec.Create(10);
|
||||
SetLength(lComplex.ArrayProp1, 2);
|
||||
SetLength(lComplex.ArrayProp2, 2);
|
||||
lComplex.ArrayProp1[0] := TTestRec.Create(10);
|
||||
lComplex.ArrayProp1[1] := TTestRec.Create(10);
|
||||
lComplex.ArrayProp2[0] := TTestRec.Create(10);
|
||||
lComplex.ArrayProp2[1] := TTestRec.Create(10);
|
||||
lReq.Params.Add(
|
||||
TValue.From<TNestedArraysRec>(lComplex),
|
||||
pdtRecordOrArrayOfRecord);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
lComplex := TJSONUtils.JSONObjectToRecord<TNestedArraysRec>(lResp);
|
||||
lbLogRec.Lines.Clear;
|
||||
lbLogRec.Lines.Add(lComplex.ToString);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnDatesClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create(1234, 'playwithdatesandtimes');
|
||||
lReq.Params.Add(1234.5678, pdtFloat);
|
||||
lReq.Params.Add(Time(), pdtTime);
|
||||
lReq.Params.Add(Date(), pdtDate);
|
||||
lReq.Params.Add(Now(), pdtDateTime);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
ShowMessage(lResp.Result.AsString);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnEchoComplexArrayClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lPeople: TTestRecDynArray;
|
||||
I: Integer;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'EchoComplexArrayOfRecords';
|
||||
lReq.RequestID := Random(1000);
|
||||
SetLength(lPeople, 2);
|
||||
lPeople[0] := TTestRec.Create(1);
|
||||
lPeople[1] := TTestRec.Create(2);
|
||||
lReq.Params.Add(
|
||||
TValue.From<TTestRecDynArray>(lPeople),
|
||||
pdtRecordOrArrayOfRecord);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
lPeople := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(lResp);
|
||||
lbLogRec.Lines.Clear;
|
||||
lbLogRec.Lines.Add('--- array of record elements ---');
|
||||
I := 1;
|
||||
for var lPRec in lPeople do
|
||||
begin
|
||||
lbLogRec.Lines.Add('ITEM: ' + I.ToString);
|
||||
lbLogRec.Lines.Add(lPRec.ToString);
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnExceptionClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCNotification;
|
||||
begin
|
||||
ShowMessage('Now will be raised a custom exception on the server. This exception will be catched by the client');
|
||||
lReq := TJSONRPCNotification.Create('RaiseCustomException');
|
||||
FExecutor.ExecuteNotification('/jsonrpc', lReq);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnFloatsTestsClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lRes: Extended;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create(1234, 'floatstest');
|
||||
lReq.Params.Add(1234.5678, pdtFloat);
|
||||
lReq.Params.Add(2345.6789, pdtFloat);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
lRes := lResp.Result.AsType<Extended>;
|
||||
lRes := RoundTo(lRes, -4);
|
||||
Assert(SameValue(lRes, 3580.2467), 'Wrong result: ' + FloatToStrF(lRes, ffGeneral, 18, 9));
|
||||
|
||||
lReq := TJSONRPCRequest.Create(1234, 'floatstest');
|
||||
lReq.Params.Add(123);
|
||||
lReq.Params.Add(234);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
lRes := lResp.Result.AsType<Extended>;
|
||||
lRes := RoundTo(lRes, -4);
|
||||
Assert(SameValue(lRes, 357), 'Wrong result: ' + FloatToStrF(lRes, ffGeneral, 18, 9));
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGetUserClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lJSON: TJsonObject;
|
||||
begin
|
||||
lbPerson.Clear;
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'getuser';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add(edtUserName.Text);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
if Assigned(lResp.Error) then
|
||||
raise Exception.Create(lResp.Error.ErrMessage);
|
||||
|
||||
// Remember that TObject descendants (but TDataset, TJDOJSONObject and TJDOJSONArray)
|
||||
// are serialized as JSON objects
|
||||
lJSON := lResp.Result.AsObject as TJsonObject;
|
||||
lbPerson.Items.Add('First Name:'.PadRight(15) + lJSON.S['firstname']);
|
||||
lbPerson.Items.Add('Last Name:'.PadRight(15) + lJSON.S['lastname']);
|
||||
lbPerson.Items.Add('Married:'.PadRight(15) + lJSON.B['married'].ToString(TUseBoolStrs.True));
|
||||
lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lJSON.D['dob']));
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnInvalid1Click(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create(1234);
|
||||
lReq.Method := 'invalidmethod1';
|
||||
lReq.Params.Add(1);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
ShowMessage(lResp.Error.ErrMessage);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnInvalid2Click(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create(1234);
|
||||
lReq.Method := 'invalidmethod2';
|
||||
lReq.Params.Add(1);
|
||||
lResp := FExecutor.ExecuteNotification('/jsonrpc', lReq);
|
||||
ShowMessage(lResp.Error.ErrMessage);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnInvalidMethodClick(Sender: TObject);
|
||||
var
|
||||
lNotification: IJSONRPCNotification;
|
||||
begin
|
||||
lNotification := TJSONRPCNotification.Create;
|
||||
lNotification.Method := 'notexists';
|
||||
FExecutor.ExecuteNotification('/jsonrpc', lNotification);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnNotificationClick(Sender: TObject);
|
||||
var
|
||||
lNotification: IJSONRPCNotification;
|
||||
begin
|
||||
lNotification := TJSONRPCNotification.Create;
|
||||
lNotification.Method := 'dosomething';
|
||||
FExecutor.ExecuteNotification('/jsonrpc', lNotification);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnObjDictClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lMultiDS: TMultiDataset;
|
||||
begin
|
||||
FDMemTable1.Active := False;
|
||||
lReq := TJSONRPCRequest.Create(Random(1000), 'getobjdict');
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
|
||||
lMultiDS := TMultiDataset.Create;
|
||||
try
|
||||
JsonObjectToObject(lResp.ResultAsJSONObject, lMultiDS);
|
||||
lbMulti.Clear;
|
||||
|
||||
lMultiDS.Customers.First;
|
||||
lbMulti.Items.Add('** CUSTOMERS **');
|
||||
while not lMultiDS.Customers.Eof do
|
||||
begin
|
||||
lbMulti.Items.Add(Format('%-20s (Code %3s)', [lMultiDS.Customers.FieldByName('Name').AsString,
|
||||
lMultiDS.Customers.FieldByName('Code').AsString]));
|
||||
lMultiDS.Customers.Next;
|
||||
end;
|
||||
|
||||
lMultiDS.People.First;
|
||||
lbMulti.Items.Add('** PEOPLE **');
|
||||
while not lMultiDS.People.Eof do
|
||||
begin
|
||||
lbMulti.Items.Add(Format('%s %s', [lMultiDS.People.FieldByName('FirstName').AsString,
|
||||
lMultiDS.People.FieldByName('LastName').AsString]));
|
||||
lMultiDS.People.Next;
|
||||
end;
|
||||
|
||||
finally
|
||||
lMultiDS.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnReverseStringClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'reversestring';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.AddByName('aString', edtReverseString.Text);
|
||||
lReq.Params.AddByName('aUpperCase', CheckBox1.Checked);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
edtReversedString.Text := lResp.Result.AsString;
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnSaveClick(Sender: TObject);
|
||||
var
|
||||
lPerson: TPerson;
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'saveperson';
|
||||
lReq.RequestID := Random(1000);
|
||||
lPerson := TPerson.Create;
|
||||
lReq.Params.AddByName('Person', lPerson, pdtObject);
|
||||
lPerson.FirstName := edtFirstName.Text;
|
||||
lPerson.LastName := edtLastName.Text;
|
||||
lPerson.Married := chkMarried.Checked;
|
||||
lPerson.DOB := dtDOB.Date;
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
ShowMessage('Person saved with ID = ' + lResp.Result.AsInteger.ToString);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnSearchClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lJSON: TJsonArray;
|
||||
I: Integer;
|
||||
lJObj: TJsonObject;
|
||||
begin
|
||||
ListBox1.Clear;
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'searchproducts';
|
||||
lReq.RequestID := 1234;
|
||||
lReq.Params.Add(edtSearchText.Text);
|
||||
lResp := FExecutor.ExecuteRequest('/rpcdatamodule', lReq);
|
||||
if Assigned(lResp.Error) then
|
||||
raise Exception.Create(lResp.Error.ErrMessage);
|
||||
|
||||
// Remember that TObject descendants (but TDataset, TJDOJSONObject and TJDOJSONArray)
|
||||
// are serialized as JSON objects
|
||||
lJSON := lResp.Result.AsObject as TJsonArray;
|
||||
for I := 0 to lJSON.Count - 1 do
|
||||
begin
|
||||
lJObj := lJSON[I].ObjectValue;
|
||||
ListBox1.Items.Add(Format('%6s: %-34s € %5.2f', [lJObj.S['codice'], lJObj.S['descrizione'], lJObj.F['prezzo']]));
|
||||
end;
|
||||
// lbPerson.Items.Add('First Name:'.PadRight(15) + lJSON.S['firstname']);
|
||||
// lbPerson.Items.Add('Last Name:'.PadRight(15) + lJSON.S['lastname']);
|
||||
// lbPerson.Items.Add('Married:'.PadRight(15) + lJSON.B['married'].ToString(TUseBoolStrs.True));
|
||||
// lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lJSON.D['dob']));
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnSetClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'GetSetBySet';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add('ptEnumValue1,ptEnumValue2', TJSONRPCParamDataType.pdtString);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
ShowMessage(lResp.Result.AsString);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnSingleRecClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lPersonRec: TTestRec;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'GetPersonRec';
|
||||
lReq.RequestID := Random(1000);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
lPersonRec := TJSONUtils.JSONObjectToRecord<TTestRec>(lResp);
|
||||
lbLogRec.Lines.Text := lResp.ResultAsJSONObject.ToJSON(False);
|
||||
lbLogRec.Lines.Add('-- record --');
|
||||
lbLogRec.Lines.Add(lPersonRec.ToString);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnSubtractClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lExecutor: IMVCJSONRPCExecutor;
|
||||
begin
|
||||
lExecutor := TMVCJSONRPCExecutor.Create('http://localhost:8080');
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'subtract';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.Add(StrToInt(edtValue1.Text));
|
||||
lReq.Params.Add(StrToInt(edtValue2.Text));
|
||||
lResp := lExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
edtResult.Text := lResp.Result.AsInteger.ToString;
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnSubtractWithNamedParamsClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'subtract';
|
||||
lReq.RequestID := Random(1000);
|
||||
lReq.Params.AddByName('Value1', StrToInt(Edit1.Text));
|
||||
lReq.Params.AddByName('Value2', StrToInt(Edit2.Text));
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
Edit3.Text := lResp.Result.AsInteger.ToString;
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnWithJSONClick(Sender: TObject);
|
||||
var
|
||||
lPerson: TJsonObject;
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'SaveObjectWithJSON';
|
||||
lReq.RequestID := 1234;
|
||||
lPerson := TJsonObject.Create;
|
||||
lReq.Params.Add(lPerson, pdTJDOJsonObject);
|
||||
lPerson.S['StringProp'] := 'Hello World';
|
||||
lPerson.O['JSONObject'] := TJsonObject.Parse('{"name":"Daniele"}') as TJsonObject;
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
|
||||
lPerson := lResp.Result.AsObject as TJsonObject;
|
||||
ShowMessage(lPerson.ToJSON(False));
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnPassAndGetRecordClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lPersonRec: TTestRec;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'SavePersonRec';
|
||||
lReq.RequestID := Random(1000);
|
||||
lPersonRec := TTestRec.Create(2);
|
||||
lReq.Params.Add(TValue.From<TTestRec>(lPersonRec), pdtRecordOrArrayOfRecord);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
lPersonRec := TJSONUtils.JSONObjectToRecord<TTestRec>(lResp);
|
||||
lbLogRec.Lines.Text := lResp.ResultAsJSONObject.ToJSON(False);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGenericExceptionClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCNotification;
|
||||
begin
|
||||
ShowMessage('Now will be raised a EDivByZero exception on the server. This exception will be catched by the client');
|
||||
lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
|
||||
FExecutor.ExecuteNotification('/jsonrpc', lReq);
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGenericExcWithCustomHAndling2Click(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
ShowMessage('Now will be raised a EInvalidPointerOperation exception on the server. However this exception will be handled by a custom exception handler wich will add a data property with extra data');
|
||||
lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
|
||||
lReq.Params.Add(2);
|
||||
try
|
||||
FExecutor.ExecuteRequest('/jsonrpcex', lReq);
|
||||
except
|
||||
on E: EMVCJSONRPCRemoteException do
|
||||
begin
|
||||
ShowMessage(Format('[CLASSNAME: %s][CODE: %d][MESSAGE: %s][DATA: %s]', [
|
||||
E.ClassName,
|
||||
E.ErrCode,
|
||||
E.ErrMessage,
|
||||
(E.Data.AsObject as TJDOJsonObject).ToJSON(True)]));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGenericExcWithCustomHandlingClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
ShowMessage('Now will be raised a EDivByZero exception on the server. However this exception will be handled by a custom exception handler wich will add a data property with extra data');
|
||||
lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
|
||||
lReq.Params.Add(1);
|
||||
try
|
||||
FExecutor.ExecuteRequest('/jsonrpcex', lReq);
|
||||
except
|
||||
on E: EMVCJSONRPCRemoteException do
|
||||
begin
|
||||
ShowMessage(Format('[CLASSNAME: %s][CODE: %d][MESSAGE: %s][DATA: %s]', [
|
||||
E.ClassName,
|
||||
E.ErrCode,
|
||||
E.ErrMessage,
|
||||
E.Data.AsString]));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGenericExcWithoutCustomHandlingClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
begin
|
||||
ShowMessage('Now will be raised a Exception exception on the server.');
|
||||
lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
|
||||
lReq.Params.Add(99);
|
||||
try
|
||||
FExecutor.ExecuteRequest('/jsonrpcex', lReq);
|
||||
except
|
||||
on E: EMVCJSONRPCRemoteException do
|
||||
begin
|
||||
ShowMessage(Format('[CLASSNAME: %s][CODE: %d][MESSAGE: %s][DATA: %s]', [
|
||||
E.ClassName,
|
||||
E.ErrCode,
|
||||
E.ErrMessage,
|
||||
E.Data.AsString])); {Data.AsString is ''}
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGetArrayOfRecordsClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lPeopleRec: TArray<TTestRec>; //server serializes a static array, we read it as dynarray
|
||||
I: Integer;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'GetPeopleRecStaticArray';
|
||||
lReq.RequestID := Random(1000);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
lPeopleRec := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(lResp);
|
||||
lbLogRec.Lines.Text := lResp.ResultAsJSONArray.ToJSON(False);
|
||||
lbLogRec.Lines.Add('-- array of record elements --');
|
||||
I:= 1;
|
||||
for var lPRec in lPeopleRec do
|
||||
begin
|
||||
lbLogRec.Lines.Add('ITEM : ' + I.ToString);
|
||||
lbLogRec.Lines.Add(lPRec.ToString);
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGetDynArrayClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lPeopleRec: TArray<TTestRec>;
|
||||
begin
|
||||
lReq := TJSONRPCRequest.Create;
|
||||
lReq.Method := 'GetPeopleRecDynArray';
|
||||
lReq.RequestID := Random(1000);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
lPeopleRec := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(lResp);
|
||||
lbLogRec.Lines.Text := lResp.ResultAsJSONArray.ToJSON(False);
|
||||
// lbLogRec.Items.Add('-- elements --');
|
||||
// for var lPRec in lPeopleRec do
|
||||
// begin
|
||||
// lbLogRec.Items.Add(' ' + lPRec.ToString);
|
||||
// end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGetListOfDatasetClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lMultiDS: TObjectList<TDataSet>;
|
||||
begin
|
||||
FDMemTable1.Active := False;
|
||||
lReq := TJSONRPCRequest.Create(Random(1000), 'GetDataSetList');
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
|
||||
lMultiDS := TObjectList<TDataSet>.Create(True);
|
||||
try
|
||||
JsonArrayToList(lResp.ResultAsJSONArray, WrapAsList(lMultiDS), TDataSet, TMVCSerializationType.stDefault, nil);
|
||||
finally
|
||||
lMultiDS.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.btnGetMultiClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
lMultiDS: TMultiDataset;
|
||||
begin
|
||||
FDMemTable1.Active := False;
|
||||
|
||||
|
||||
lReq := TJSONRPCRequest.Create(Random(1000), 'getmulti');
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq);
|
||||
|
||||
lMultiDS := TMultiDataset.Create;
|
||||
try
|
||||
JsonObjectToObject(lResp.ResultAsJSONObject, lMultiDS);
|
||||
lbMulti.Clear;
|
||||
|
||||
lMultiDS.Customers.First;
|
||||
lbMulti.Items.Add('** CUSTOMERS **');
|
||||
while not lMultiDS.Customers.Eof do
|
||||
begin
|
||||
lbMulti.Items.Add(Format('%-20s (Code %3s)', [lMultiDS.Customers.FieldByName('Name').AsString,
|
||||
lMultiDS.Customers.FieldByName('Code').AsString]));
|
||||
lMultiDS.Customers.Next;
|
||||
end;
|
||||
|
||||
lMultiDS.People.First;
|
||||
lbMulti.Items.Add('** PEOPLE **');
|
||||
while not lMultiDS.People.Eof do
|
||||
begin
|
||||
lbMulti.Items.Add(Format('%s %s', [lMultiDS.People.FieldByName('FirstName').AsString,
|
||||
lMultiDS.People.FieldByName('LastName').AsString]));
|
||||
lMultiDS.People.Next;
|
||||
end;
|
||||
|
||||
finally
|
||||
lMultiDS.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.edtGetCustomersClick(Sender: TObject);
|
||||
var
|
||||
lReq: IJSONRPCRequest;
|
||||
lResp: IJSONRPCResponse;
|
||||
begin
|
||||
FDMemTable1.Active := False;
|
||||
lReq := TJSONRPCRequest.Create(Random(1000), 'getcustomers');
|
||||
lReq.Params.AddByName('FilterString', edtFilter.Text);
|
||||
lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq, jrpcGET);
|
||||
FDMemTable1.Active := True;
|
||||
FDMemTable1.LoadFromTValue(lResp.Result);
|
||||
FDMemTable1.First;
|
||||
end;
|
||||
|
||||
procedure TMainForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FExecutor := TMVCJSONRPCExecutor.Create('http://localhost:8080');
|
||||
|
||||
FExecutor.SetOnSendCommand(
|
||||
procedure(JSONRPCObject: IJSONRPCObject)
|
||||
begin
|
||||
Log.Debug('REQUEST : ' + JSONRPCObject.ToString(True), 'jsonrpc');
|
||||
end);
|
||||
|
||||
FExecutor.SetOnReceiveResponse(
|
||||
procedure(Req, Resp: IJSONRPCObject)
|
||||
begin
|
||||
Log.Debug('>> OnReceiveResponse // start', 'jsonrpc');
|
||||
Log.Debug(' REQUEST : ' + Req.ToString(True), 'jsonrpc');
|
||||
Log.Debug(' RESPONSE: ' + Resp.ToString(True), 'jsonrpc');
|
||||
Log.Debug('<< OnReceiveResponse // end', 'jsonrpc');
|
||||
end);
|
||||
|
||||
FExecutor.SetOnReceiveHTTPResponse(
|
||||
procedure(HTTPResp: IHTTPResponse)
|
||||
begin
|
||||
Log.Debug('RESPONSE: ' + HTTPResp.ContentAsString(), 'jsonrpc');
|
||||
end);
|
||||
|
||||
dtNextMonday.Date := Date;
|
||||
// these are the methods to handle http headers in JSONRPC
|
||||
// the following line and the check on the server is just for demo
|
||||
Assert(FExecutor.HTTPHeadersCount = 0);
|
||||
FExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString));
|
||||
Assert(FExecutor.HTTPHeadersCount = 1);
|
||||
FExecutor.ClearHTTPHeaders;
|
||||
Assert(FExecutor.HTTPHeadersCount = 0);
|
||||
FExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString));
|
||||
|
||||
PageControl1.ActivePageIndex := 0;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -0,0 +1,18 @@
|
||||
program jsonrpcclientwithobjects_sync;
|
||||
|
||||
uses
|
||||
Vcl.Forms,
|
||||
MainClientFormU in 'MainClientFormU.pas' {MainForm},
|
||||
RandomUtilsU in '..\..\commons\RandomUtilsU.pas',
|
||||
BusinessObjectsU in '..\..\commons\BusinessObjectsU.pas',
|
||||
CommonTypesU in '..\CommonTypesU.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
ReportMemoryLeaksOnShutdown := True;
|
||||
Application.Initialize;
|
||||
Application.MainFormOnTaskbar := True;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
1115
samples/jsonrpc/sync_client/jsonrpcclientwithobjects_sync.dproj
Normal file
1115
samples/jsonrpc/sync_client/jsonrpcclientwithobjects_sync.dproj
Normal file
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user