From 2758b2bbea0c76633bf33e657856db2f29d8c74a Mon Sep 17 00:00:00 2001 From: Daniele Teti Date: Tue, 2 Jul 2024 19:14:45 +0200 Subject: [PATCH] Fixed some weird behaviour of the sample about JSONRPC --- samples/jsonrpc/AuthenticationU.pas | 70 ++ samples/jsonrpc/CommonTypesU.pas | 272 ++++ .../jsonrpc/async_client/MainClientFormU.dfm | 636 ++++++++++ .../jsonrpc/async_client/MainClientFormU.pas | 885 +++++++++++++ samples/jsonrpc/async_client/WaitingFormU.dfm | 69 + samples/jsonrpc/async_client/WaitingFormU.pas | 112 ++ .../jsonrpcclientwithobjects_async.dpr | 19 + .../jsonrpcclientwithobjects_async.dproj | 1116 +++++++++++++++++ samples/jsonrpc/jsonrpc_group.groupproj | 60 + .../jsonrpc/jsonrpcserver/MainWebModuleU.dfm | 7 + .../jsonrpc/jsonrpcserver/MainWebModuleU.pas | 104 ++ samples/jsonrpc/jsonrpcserver/MyObjectU.pas | 432 +++++++ .../jsonrpcserverwithobjects.dpr | 60 + .../jsonrpcserverwithobjects.dproj | 1027 +++++++++++++++ .../jsonrpc/sync_client/MainClientFormU.dfm | 637 ++++++++++ .../jsonrpc/sync_client/MainClientFormU.pas | 786 ++++++++++++ .../jsonrpcclientwithobjects_sync.dpr | 18 + .../jsonrpcclientwithobjects_sync.dproj | 1115 ++++++++++++++++ 18 files changed, 7425 insertions(+) create mode 100644 samples/jsonrpc/AuthenticationU.pas create mode 100644 samples/jsonrpc/CommonTypesU.pas create mode 100644 samples/jsonrpc/async_client/MainClientFormU.dfm create mode 100644 samples/jsonrpc/async_client/MainClientFormU.pas create mode 100644 samples/jsonrpc/async_client/WaitingFormU.dfm create mode 100644 samples/jsonrpc/async_client/WaitingFormU.pas create mode 100644 samples/jsonrpc/async_client/jsonrpcclientwithobjects_async.dpr create mode 100644 samples/jsonrpc/async_client/jsonrpcclientwithobjects_async.dproj create mode 100644 samples/jsonrpc/jsonrpc_group.groupproj create mode 100644 samples/jsonrpc/jsonrpcserver/MainWebModuleU.dfm create mode 100644 samples/jsonrpc/jsonrpcserver/MainWebModuleU.pas create mode 100644 samples/jsonrpc/jsonrpcserver/MyObjectU.pas create mode 100644 samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dpr create mode 100644 samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dproj create mode 100644 samples/jsonrpc/sync_client/MainClientFormU.dfm create mode 100644 samples/jsonrpc/sync_client/MainClientFormU.pas create mode 100644 samples/jsonrpc/sync_client/jsonrpcclientwithobjects_sync.dpr create mode 100644 samples/jsonrpc/sync_client/jsonrpcclientwithobjects_sync.dproj diff --git a/samples/jsonrpc/AuthenticationU.pas b/samples/jsonrpc/AuthenticationU.pas new file mode 100644 index 000000000..5310e680d --- /dev/null +++ b/samples/jsonrpc/AuthenticationU.pas @@ -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; + var IsValid: Boolean; const SessionData: TSessionData); + procedure OnAuthorization(const AContext: TWebContext; UserRoles + : System.Generics.Collections.TList; + 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; + 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; + 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. diff --git a/samples/jsonrpc/CommonTypesU.pas b/samples/jsonrpc/CommonTypesU.pas new file mode 100644 index 000000000..d4bd248ed --- /dev/null +++ b/samples/jsonrpc/CommonTypesU.pas @@ -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; + ArrOfIntegersProp: TArray; + ArrOfBooleansProp: TArray; + ArrOfDateProp: TArray; + ArrOfTimeProp: TArray; + ArrOfDateTimeProp: TArray; + constructor Create(Value: Integer); + function ToString: String; + end; + + [MVCNameCase(ncCamelCase)] + TTestRec = record + StringProp: String; + IntegerProp: Integer; + BooleanProp: Boolean; + EnumProp: TEnumTest; + SetProp: TSetTest; + ArrOfStringsProp: TArray; + ArrOfIntegersProp: TArray; + ArrOfBooleansProp: TArray; + ArrOfDateProp: TArray; + ArrOfTimeProp: TArray; + ArrOfDateTimeProp: TArray; + NestedRecProp: TNestedRec; + function ToString: String; + constructor Create(Value: Integer); + end; + + TTestRecDynArray = TArray; + + TTestRecArray = array [0 .. 1] of TTestRec; + + TNestedArraysRec = record + TestRecProp: TTestRec; + ArrayProp1: TArray; + ArrayProp2: TArray; + 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. diff --git a/samples/jsonrpc/async_client/MainClientFormU.dfm b/samples/jsonrpc/async_client/MainClientFormU.dfm new file mode 100644 index 000000000..d7821af3e --- /dev/null +++ b/samples/jsonrpc/async_client/MainClientFormU.dfm @@ -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 diff --git a/samples/jsonrpc/async_client/MainClientFormU.pas b/samples/jsonrpc/async_client/MainClientFormU.pas new file mode 100644 index 000000000..6f842dea4 --- /dev/null +++ b/samples/jsonrpc/async_client/MainClientFormU.pas @@ -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(lComplex), pdtRecordOrArrayOfRecord); + FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, + procedure(Resp: IJSONRPCResponse) + begin + lComplex := TJSONUtils.JSONObjectToRecord(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(lPeople), pdtRecordOrArrayOfRecord); + FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, + procedure(Resp: IJSONRPCResponse) + begin + lPeople := TJSONUtils.JSONArrayToArrayOfRecord(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; + 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; + 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(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(lPersonRec), pdtRecordOrArrayOfRecord); + FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, + procedure (Resp: IJSONRPCResponse) + var + lResPersonRec: TTestRec; + begin + lResPersonRec := TJSONUtils.JSONObjectToRecord(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; // 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(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; + begin + lPeopleRec := TJSONUtils.JSONArrayToArrayOfRecord(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; + begin + lMultiDS := TObjectList.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. diff --git a/samples/jsonrpc/async_client/WaitingFormU.dfm b/samples/jsonrpc/async_client/WaitingFormU.dfm new file mode 100644 index 000000000..376459195 --- /dev/null +++ b/samples/jsonrpc/async_client/WaitingFormU.dfm @@ -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 diff --git a/samples/jsonrpc/async_client/WaitingFormU.pas b/samples/jsonrpc/async_client/WaitingFormU.pas new file mode 100644 index 000000000..818eb2f94 --- /dev/null +++ b/samples/jsonrpc/async_client/WaitingFormU.pas @@ -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. diff --git a/samples/jsonrpc/async_client/jsonrpcclientwithobjects_async.dpr b/samples/jsonrpc/async_client/jsonrpcclientwithobjects_async.dpr new file mode 100644 index 000000000..235f163ea --- /dev/null +++ b/samples/jsonrpc/async_client/jsonrpcclientwithobjects_async.dpr @@ -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. diff --git a/samples/jsonrpc/async_client/jsonrpcclientwithobjects_async.dproj b/samples/jsonrpc/async_client/jsonrpcclientwithobjects_async.dproj new file mode 100644 index 000000000..aa7eabd5a --- /dev/null +++ b/samples/jsonrpc/async_client/jsonrpcclientwithobjects_async.dproj @@ -0,0 +1,1116 @@ + + + {192C33A7-36AC-4357-8D52-AE88D4C974E7} + 20.1 + VCL + True + Debug + Win32 + 1 + Application + jsonrpcclientwithobjects_async.dpr + jsonrpcclientwithobjects_async + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + ..\bin + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + jsonrpcclientwithobjects_async + 1040 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + + + RaizeComponentsVcl;vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;ibmonitor;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;Tee;soapmidas;SVGIconImageListFMX;vclactnband;TeeUI;fmxFireDAC;dbexpress;Python;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;PythonVcl;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;SVGIconPackage;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;vcldb;ibxbindings;SynEditDR;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IndyCore;RESTBackendComponents;dmvcframeworkDT;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RaizeComponentsVclDb;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;LockBoxDR;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;dmvcframeworkRT;ibxpress;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;vclib;fmxobj;bindcompvclsmp;FMXTee;DataSnapNativeClient;PythonFmx;DatasnapConnectorsFreePascal;soaprtl;SVGIconImageList;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + RaizeComponentsVcl;vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;ibmonitor;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;Tee;soapmidas;SVGIconImageListFMX;vclactnband;TeeUI;fmxFireDAC;dbexpress;Python;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;PythonVcl;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;SVGIconPackage;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;vcldb;ibxbindings;SynEditDR;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RaizeComponentsVclDb;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;LockBoxDR;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;ibxpress;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;vclib;fmxobj;bindcompvclsmp;FMXTee;DataSnapNativeClient;PythonFmx;DatasnapConnectorsFreePascal;soaprtl;SVGIconImageList;soapserver;FireDACIBDriver;$(DCC_UsePackage) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + true + true + + + false + PerMonitorV2 + true + 1033 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + PerMonitorV2 + + + + MainSource + + +
MainForm
+ dfm + + + + + +
WaitingForm
+ dfm + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + jsonrpcclientwithobjects_async.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + jsonrpcclientwithobjects_async.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 64 + + + classes + 64 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + True + False + + + 12 + + + + + diff --git a/samples/jsonrpc/jsonrpc_group.groupproj b/samples/jsonrpc/jsonrpc_group.groupproj new file mode 100644 index 000000000..a3f31f0ec --- /dev/null +++ b/samples/jsonrpc/jsonrpc_group.groupproj @@ -0,0 +1,60 @@ + + + {AFDF54C5-5184-4A5F-A230-FB7F37B3B2F0} + + + + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/samples/jsonrpc/jsonrpcserver/MainWebModuleU.dfm b/samples/jsonrpc/jsonrpcserver/MainWebModuleU.dfm new file mode 100644 index 000000000..02d66b979 --- /dev/null +++ b/samples/jsonrpc/jsonrpcserver/MainWebModuleU.dfm @@ -0,0 +1,7 @@ +object MyWebModule: TMyWebModule + OnCreate = WebModuleCreate + OnDestroy = WebModuleDestroy + Actions = <> + Height = 230 + Width = 415 +end diff --git a/samples/jsonrpc/jsonrpcserver/MainWebModuleU.pas b/samples/jsonrpc/jsonrpcserver/MainWebModuleU.pas new file mode 100644 index 000000000..71e1b2256 --- /dev/null +++ b/samples/jsonrpc/jsonrpcserver/MainWebModuleU.pas @@ -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. diff --git a/samples/jsonrpc/jsonrpcserver/MyObjectU.pas b/samples/jsonrpc/jsonrpcserver/MyObjectU.pas new file mode 100644 index 000000000..4e32ccb5f --- /dev/null +++ b/samples/jsonrpc/jsonrpcserver/MyObjectU.pas @@ -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(const JSON: TJsonObject): T; + end; + +implementation + +uses + System.SysUtils, + MVCFramework.Logger, + System.StrUtils, + System.DateUtils, MVCFramework.Serializer.JsonDataObjects; + +class function TUtils.JSONObjectAs(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(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(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. diff --git a/samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dpr b/samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dpr new file mode 100644 index 000000000..0442ec504 --- /dev/null +++ b/samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dpr @@ -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. diff --git a/samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dproj b/samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dproj new file mode 100644 index 000000000..cb7b0f0eb --- /dev/null +++ b/samples/jsonrpc/jsonrpcserver/jsonrpcserverwithobjects.dproj @@ -0,0 +1,1027 @@ + + + {AF5FBC36-0D1D-4C07-B2E3-C2A2E688AC6F} + 20.1 + VCL + jsonrpcserverwithobjects.dpr + True + Debug + Win32 + 1 + Console + jsonrpcserverwithobjects + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + false + false + false + false + false + RESTComponents;emsclientfiredac;DataSnapFireDAC;FireDACIBDriver;emsclient;FireDACCommon;RESTBackendComponents;soapserver;CloudService;FireDACCommonDriver;inet;FireDAC;FireDACSqliteDriver;soaprtl;soapmidas;$(DCC_UsePackage) + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + true + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + $(DMVC);$(DCC_UnitSearchPath) + VCL;$(DCC_Framework) + jsonrpcserverwithobjects + 1040 + ..\bin + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + + + DBXSqliteDriver;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;tethering;svnui;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;Intraweb;DBXOracleDriver;Spring.Data;inetdb;FmxTeeUI;emsedge;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;FixInsight_10_2;DataSnapConnectors;VCLRESTComponents;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;TelegaPiBot;dsnapcon;DMVC_IDE_Expert_D102Tokyo;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;emshosting;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;ibxbindings;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;JSPack_Tokyo;DataSnapServerMidas;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + ..\(None) + none + + + DBXSqliteDriver;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;Spring.Data;inetdb;FmxTeeUI;emsedge;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;DataSnapConnectors;VCLRESTComponents;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;emshosting;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;ibxbindings;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + 1033 + none + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + ..\..\(None) + + + + MainSource + + + +
MyWebModule
+ TWebModule + + + + +
dmMain
+ TDataModule + + + + + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Console + + + + jsonrpcserverwithobjects.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + + + + + jsonrpcserverwithobjects.exe + true + + + + + + 1 + + + 0 + + + + + classes + 64 + + + classes + 64 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + 1 + + + 0 + + + + + 1 + .framework + + + 1 + .framework + + + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + + + 1 + + + 1 + + + + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + + True + False + + + 12 + + + + + diff --git a/samples/jsonrpc/sync_client/MainClientFormU.dfm b/samples/jsonrpc/sync_client/MainClientFormU.dfm new file mode 100644 index 000000000..7937a724b --- /dev/null +++ b/samples/jsonrpc/sync_client/MainClientFormU.dfm @@ -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 diff --git a/samples/jsonrpc/sync_client/MainClientFormU.pas b/samples/jsonrpc/sync_client/MainClientFormU.pas new file mode 100644 index 000000000..a238a8bdc --- /dev/null +++ b/samples/jsonrpc/sync_client/MainClientFormU.pas @@ -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(lComplex), + pdtRecordOrArrayOfRecord); + lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq); + lComplex := TJSONUtils.JSONObjectToRecord(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(lPeople), + pdtRecordOrArrayOfRecord); + lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq); + lPeople := TJSONUtils.JSONArrayToArrayOfRecord(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; + 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; + 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(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(lPersonRec), pdtRecordOrArrayOfRecord); + lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq); + lPersonRec := TJSONUtils.JSONObjectToRecord(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; //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(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; +begin + lReq := TJSONRPCRequest.Create; + lReq.Method := 'GetPeopleRecDynArray'; + lReq.RequestID := Random(1000); + lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq); + lPeopleRec := TJSONUtils.JSONArrayToArrayOfRecord(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; +begin + FDMemTable1.Active := False; + lReq := TJSONRPCRequest.Create(Random(1000), 'GetDataSetList'); + lResp := FExecutor.ExecuteRequest('/jsonrpc', lReq); + + lMultiDS := TObjectList.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. diff --git a/samples/jsonrpc/sync_client/jsonrpcclientwithobjects_sync.dpr b/samples/jsonrpc/sync_client/jsonrpcclientwithobjects_sync.dpr new file mode 100644 index 000000000..17a52b874 --- /dev/null +++ b/samples/jsonrpc/sync_client/jsonrpcclientwithobjects_sync.dpr @@ -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. diff --git a/samples/jsonrpc/sync_client/jsonrpcclientwithobjects_sync.dproj b/samples/jsonrpc/sync_client/jsonrpcclientwithobjects_sync.dproj new file mode 100644 index 000000000..47fd0c148 --- /dev/null +++ b/samples/jsonrpc/sync_client/jsonrpcclientwithobjects_sync.dproj @@ -0,0 +1,1115 @@ + + + {300F83FF-8F7B-43FD-B740-A3DFDF7238ED} + 20.1 + VCL + jsonrpcclientwithobjects_sync.dpr + True + Debug + Win32 + 1 + Application + jsonrpcclientwithobjects_sync + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + ..\bin + false + false + false + false + false + RESTComponents;emsclientfiredac;DataSnapFireDAC;FireDACIBDriver;emsclient;FireDACCommon;RESTBackendComponents;soapserver;CloudService;FireDACCommonDriver;inet;FireDAC;FireDACSqliteDriver;soaprtl;soapmidas;$(DCC_UsePackage) + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + jsonrpcclientwithobjects_sync + 1040 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + + + DBXSqliteDriver;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;tethering;svnui;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;Intraweb;DBXOracleDriver;Spring.Data;inetdb;FmxTeeUI;emsedge;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;FixInsight_10_2;DataSnapConnectors;VCLRESTComponents;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;TelegaPiBot;dsnapcon;DMVC_IDE_Expert_D102Tokyo;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;emshosting;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;ibxbindings;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;JSPack_Tokyo;DataSnapServerMidas;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + none + + + DBXSqliteDriver;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;Spring.Data;inetdb;FmxTeeUI;emsedge;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;DataSnapConnectors;VCLRESTComponents;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;emshosting;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;ibxbindings;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + PerMonitor + true + 1033 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitor + + + + MainSource + + +
MainForm
+ dfm + + + + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + jsonrpcclientwithobjects_sync.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + + jsonrpcclientwithobjects_sync.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 64 + + + classes + 64 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + + True + False + + + 12 + + + + +