Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 07:45:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

JSONRPC methods can use MVCInject attribute
Some checks are pending
TOC Generator / TOC Generator (push) Waiting to run
Details

Browse Source
This commit is contained in:
Daniele Teti 2024-10-10 01:26:34 +02:00
parent 4e2cc963f4
commit febe311d01
7 changed files with 228 additions and 195 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
samples/jsonrpc/async_client/MainClientFormU.dfm
View File

@ -482,7 +482,7 @@ object MainForm: TMainForm
AlignWithMargins = True AlignWithMargins = True
Left = 3 Left = 3
Top = 3 Top = 3
Width = 824 Width = 808
Height = 69 Height = 69
Align = alTop Align = alTop
Caption = Caption =
@ -497,7 +497,6 @@ object MainForm: TMainForm
Font.Style = [] Font.Style = []
ParentFont = False ParentFont = False
WordWrap = True WordWrap = True
ExplicitWidth = 808
end end
object btnGenericExcWithCustomHandling: TButton object btnGenericExcWithCustomHandling: TButton
Left = 0 Left = 0

257
samples/jsonrpc/async_client/MainClientFormU.pas
View File

@ -159,7 +159,7 @@ type
private private
fExecutor: IMVCJSONRPCExecutorAsync; fExecutor: IMVCJSONRPCExecutorAsync;
fExecutorAsync: IMVCJSONRPCExecutorAsync; fExecutorAsync: IMVCJSONRPCExecutorAsync;
fGeneralErrorHandler : TJSONRPCErrorHandlerProc; fGeneralErrorHandler: TJSONRPCErrorHandlerProc;
fWaiting: TWaitingForm; fWaiting: TWaitingForm;
public public
{ Public declarations } { Public declarations }
@ -196,7 +196,7 @@ begin
lReq.Method := 'getnextmonday'; lReq.Method := 'getnextmonday';
lReq.RequestID := Random(1000); lReq.RequestID := Random(1000);
lReq.Params.Add(dtNextMonday.Date); lReq.Params.Add(dtNextMonday.Date);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
dtNextMonday.Date := ISODateToDate(Resp.Result.AsString); dtNextMonday.Date := ISODateToDate(Resp.Result.AsString);
@ -219,14 +219,14 @@ begin
lComplex.ArrayProp2[0] := TTestRec.Create(10); lComplex.ArrayProp2[0] := TTestRec.Create(10);
lComplex.ArrayProp2[1] := TTestRec.Create(10); lComplex.ArrayProp2[1] := TTestRec.Create(10);
lReq.Params.Add(TValue.From<TNestedArraysRec>(lComplex), pdtRecordOrArrayOfRecord); lReq.Params.Add(TValue.From<TNestedArraysRec>(lComplex), pdtRecordOrArrayOfRecord);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
lComplex := TJSONUtils.JSONObjectToRecord<TNestedArraysRec>(Resp); lComplex := TJSONUtils.JSONObjectToRecord<TNestedArraysRec>(Resp);
lbLogRec.Lines.Clear; lbLogRec.Lines.Clear;
lbLogRec.Lines.Add(lComplex.ToString); lbLogRec.Lines.Add(lComplex.ToString);
end, end,
procedure (Exc: Exception) procedure(Exc: Exception)
begin begin
ShowMessage(Exc.ClassName + ': ' + Exc.Message); ShowMessage(Exc.ClassName + ': ' + Exc.Message);
end); end);
@ -241,7 +241,7 @@ begin
lReq.Params.Add(Time(), pdtTime); lReq.Params.Add(Time(), pdtTime);
lReq.Params.Add(Date(), pdtDate); lReq.Params.Add(Date(), pdtDate);
lReq.Params.Add(Now(), pdtDateTime); lReq.Params.Add(Now(), pdtDateTime);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
ShowMessage(Resp.Result.AsString); ShowMessage(Resp.Result.AsString);
@ -261,20 +261,20 @@ begin
lPeople[0] := TTestRec.Create(1); lPeople[0] := TTestRec.Create(1);
lPeople[1] := TTestRec.Create(2); lPeople[1] := TTestRec.Create(2);
lReq.Params.Add(TValue.From<TTestRecDynArray>(lPeople), pdtRecordOrArrayOfRecord); lReq.Params.Add(TValue.From<TTestRecDynArray>(lPeople), pdtRecordOrArrayOfRecord);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin
lPeople := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(Resp);
lbLogRec.Lines.Clear;
lbLogRec.Lines.Add('--- array of record elements ---');
I := 1;
for var lPRec in lPeople do
begin begin
lbLogRec.Lines.Add('ITEM: ' + I.ToString); lPeople := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(Resp);
lbLogRec.Lines.Add(lPRec.ToString); lbLogRec.Lines.Clear;
Inc(I); lbLogRec.Lines.Add('--- array of record elements ---');
end; I := 1;
end); for var lPRec in lPeople do
begin
lbLogRec.Lines.Add('ITEM: ' + I.ToString);
lbLogRec.Lines.Add(lPRec.ToString);
Inc(I);
end;
end);
end; end;
procedure TMainForm.btnExceptionClick(Sender: TObject); procedure TMainForm.btnExceptionClick(Sender: TObject);
@ -283,7 +283,7 @@ var
begin begin
ShowMessage('Now will be raised a custom exception on the server. This exception will be catched by the client'); ShowMessage('Now will be raised a custom exception on the server. This exception will be catched by the client');
lReq := TJSONRPCNotification.Create('RaiseCustomException'); lReq := TJSONRPCNotification.Create('RaiseCustomException');
FExecutor.ExecuteNotificationAsync('/jsonrpc', lReq, fGeneralErrorHandler); fExecutor.ExecuteNotificationAsync('/jsonrpc', lReq, fGeneralErrorHandler);
end; end;
procedure TMainForm.btnFloatsTestsClick(Sender: TObject); procedure TMainForm.btnFloatsTestsClick(Sender: TObject);
@ -294,7 +294,7 @@ begin
lReq := TJSONRPCRequest.Create(1234, 'floatstest'); lReq := TJSONRPCRequest.Create(1234, 'floatstest');
lReq.Params.Add(1234.5678, pdtFloat); lReq.Params.Add(1234.5678, pdtFloat);
lReq.Params.Add(2345.6789, pdtFloat); lReq.Params.Add(2345.6789, pdtFloat);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
lRes := Resp.Result.AsType<Extended>; lRes := Resp.Result.AsType<Extended>;
@ -304,15 +304,15 @@ begin
lReq := TJSONRPCRequest.Create(1234, 'floatstest'); lReq := TJSONRPCRequest.Create(1234, 'floatstest');
lReq.Params.Add(123); lReq.Params.Add(123);
lReq.Params.Add(234); lReq.Params.Add(234);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
var var
lRes: Extended; lRes: Extended;
begin begin
lRes := Resp.Result.AsType<Extended>; lRes := Resp.Result.AsType<Extended>;
lRes := RoundTo(lRes, -4); lRes := RoundTo(lRes, -4);
Assert(SameValue(lRes, 357), 'Wrong result: ' + FloatToStrF(lRes, ffGeneral, 18, 9)); Assert(SameValue(lRes, 357), 'Wrong result: ' + FloatToStrF(lRes, ffGeneral, 18, 9));
end); end);
end); end);
end; end;
@ -326,27 +326,28 @@ begin
lReq.Method := 'getuser'; lReq.Method := 'getuser';
lReq.RequestID := Random(1000); lReq.RequestID := Random(1000);
lReq.Params.Add(edtUserName.Text); lReq.Params.Add(edtUserName.Text);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
// Remember that TObject descendants (but TDataset, TJDOJSONObject and TJDOJSONArray) // Remember that TObject descendants (but TDataset, TJDOJSONObject and TJDOJSONArray)
// are serialized as JSON objects, so you can always read the JSON object // are serialized as JSON objects, so you can always read the JSON object
// lJSON := Resp.Result.AsObject as TJsonObject; // lJSON := Resp.Result.AsObject as TJsonObject;
// lbPerson.Items.Add('First Name:'.PadRight(15) + lJSON.S['firstname']); // lbPerson.Items.Add('First Name:'.PadRight(15) + lJSON.S['firstname']);
// lbPerson.Items.Add('Last Name:'.PadRight(15) + lJSON.S['lastname']); // 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('Married:'.PadRight(15) + lJSON.B['married'].ToString(TUseBoolStrs.True));
// lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lJSON.D['dob'])); // lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lJSON.D['dob']));
var lPerson := TPerson.Create; var
try lPerson := TPerson.Create;
Resp.ResultAs(lPerson); try
lbPerson.Items.Add('First Name:'.PadRight(15) + lPerson.FirstName); Resp.ResultAs(lPerson);
lbPerson.Items.Add('Last Name:'.PadRight(15) + lPerson.LastName); lbPerson.Items.Add('First Name:'.PadRight(15) + lPerson.FirstName);
lbPerson.Items.Add('Married:'.PadRight(15) + lPerson.Married.ToString(TUseBoolStrs.True)); lbPerson.Items.Add('Last Name:'.PadRight(15) + lPerson.LastName);
lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lPerson.DOB)); lbPerson.Items.Add('Married:'.PadRight(15) + lPerson.Married.ToString(TUseBoolStrs.True));
finally lbPerson.Items.Add('DOB:'.PadRight(15) + DateToStr(lPerson.DOB));
lPerson.Free; finally
end; lPerson.Free;
end); end;
end);
end; end;
procedure TMainForm.btnInvalid1Click(Sender: TObject); procedure TMainForm.btnInvalid1Click(Sender: TObject);
@ -356,11 +357,11 @@ begin
lReq := TJSONRPCRequest.Create(1234); lReq := TJSONRPCRequest.Create(1234);
lReq.Method := 'invalidmethod1'; lReq.Method := 'invalidmethod1';
lReq.Params.Add(1); lReq.Params.Add(1);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
ShowMessage(Resp.Error.ErrMessage); ShowMessage(Resp.Error.ErrMessage);
end); end);
end; end;
procedure TMainForm.btnInvalid2Click(Sender: TObject); procedure TMainForm.btnInvalid2Click(Sender: TObject);
@ -370,10 +371,8 @@ begin
lReq := TJSONRPCRequest.Create(1234); lReq := TJSONRPCRequest.Create(1234);
lReq.Method := 'invalidmethod2'; lReq.Method := 'invalidmethod2';
lReq.Params.Add(1); lReq.Params.Add(1);
FExecutor.ExecuteNotificationAsync( fExecutor.ExecuteNotificationAsync('/jsonrpc', lReq,
'/jsonrpc', procedure(Exc: Exception)
lReq,
procedure (Exc: Exception)
begin begin
ShowMessage(Exc.Message); ShowMessage(Exc.Message);
end); end);
@ -385,15 +384,15 @@ var
begin begin
lNotification := TJSONRPCNotification.Create; lNotification := TJSONRPCNotification.Create;
lNotification.Method := 'notexists'; lNotification.Method := 'notexists';
FExecutor.ExecuteNotificationAsync('/jsonrpc', lNotification); fExecutor.ExecuteNotificationAsync('/jsonrpc', lNotification);
end; end;
procedure TMainForm.btnNotificationClick(Sender: TObject); procedure TMainForm.btnNotificationClick(Sender: TObject);
var var
lNotification: IJSONRPCNotification; lNotification: IJSONRPCNotification;
begin begin
lNotification := FExecutor.CreateNotification('dosomething'); lNotification := fExecutor.CreateNotification('dosomething');
FExecutor.ExecuteNotificationAsync('/jsonrpc', lNotification); fExecutor.ExecuteNotificationAsync('/jsonrpc', lNotification);
end; end;
procedure TMainForm.btnObjDictClick(Sender: TObject); procedure TMainForm.btnObjDictClick(Sender: TObject);
@ -404,7 +403,7 @@ var
begin begin
FDMemTable1.Active := False; FDMemTable1.Active := False;
lReq := TJSONRPCRequest.Create(Random(1000), 'getobjdict'); lReq := TJSONRPCRequest.Create(Random(1000), 'getobjdict');
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(JSONRPCResponse: IJSONRPCResponse) procedure(JSONRPCResponse: IJSONRPCResponse)
begin begin
lMultiDS := TMultiDataset.Create; lMultiDS := TMultiDataset.Create;
@ -440,14 +439,14 @@ procedure TMainForm.btnReverseStringClick(Sender: TObject);
var var
lReq: IJSONRPCRequest; lReq: IJSONRPCRequest;
begin begin
lReq := FExecutor.CreateRequest('reversestring', Random(1000)); lReq := fExecutor.CreateRequest('reversestring', Random(1000));
lReq.Params.AddByName('aString', edtReverseString.Text); lReq.Params.AddByName('aString', edtReverseString.Text);
lReq.Params.AddByName('aUpperCase', CheckBox1.Checked); lReq.Params.AddByName('aUpperCase', CheckBox1.Checked);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure (Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
edtReversedString.Text := Resp.Result.AsString; edtReversedString.Text := Resp.Result.AsString;
end); end);
end; end;
procedure TMainForm.btnSaveClick(Sender: TObject); procedure TMainForm.btnSaveClick(Sender: TObject);
@ -464,7 +463,7 @@ begin
lPerson.LastName := edtLastName.Text; lPerson.LastName := edtLastName.Text;
lPerson.Married := chkMarried.Checked; lPerson.Married := chkMarried.Checked;
lPerson.DOB := dtDOB.Date; lPerson.DOB := dtDOB.Date;
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
ShowMessage('Person saved with ID = ' + Resp.Result.AsInteger.ToString); ShowMessage('Person saved with ID = ' + Resp.Result.AsInteger.ToString);
@ -482,7 +481,7 @@ begin
lReq.Method := 'searchproducts'; lReq.Method := 'searchproducts';
lReq.RequestID := 1234; lReq.RequestID := 1234;
lReq.Params.Add(edtSearchText.Text); lReq.Params.Add(edtSearchText.Text);
FExecutor.ExecuteRequestAsync('/rpcdatamodule', lReq, fExecutor.ExecuteRequestAsync('/rpcdatamodule', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
var var
I: Integer; I: Integer;
@ -493,7 +492,8 @@ begin
for I := 0 to lJSON.Count - 1 do for I := 0 to lJSON.Count - 1 do
begin begin
lJObj := lJSON[I].ObjectValue; lJObj := lJSON[I].ObjectValue;
ListBox1.Items.Add(Format('%6s: %-34s € %5.2f', [lJObj.S['codice'], lJObj.S['descrizione'], lJObj.F['prezzo']])); ListBox1.Items.Add(Format('%6s: %-34s € %5.2f', [lJObj.S['codice'], lJObj.S['descrizione'],
lJObj.F['prezzo']]));
end; end;
end); end);
end; end;
@ -505,7 +505,7 @@ begin
lReq := TJSONRPCRequest.Create; lReq := TJSONRPCRequest.Create;
lReq.Method := 'GetPersonRec'; lReq.Method := 'GetPersonRec';
lReq.RequestID := Random(1000); lReq.RequestID := Random(1000);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
var var
lPersonRec: TTestRec; lPersonRec: TTestRec;
@ -525,8 +525,7 @@ begin
lReq := fExecutorAsync.CreateRequest('subtract', Random(1000)); lReq := fExecutorAsync.CreateRequest('subtract', Random(1000));
lReq.Params.Add(StrToInt(edtValue1.Text)); lReq.Params.Add(StrToInt(edtValue1.Text));
lReq.Params.Add(StrToInt(edtValue2.Text)); lReq.Params.Add(StrToInt(edtValue2.Text));
fExecutorAsync fExecutorAsync.ExecuteRequestAsync('/jsonrpc', lReq,
.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(JSONRPCResp: IJSONRPCResponse) procedure(JSONRPCResp: IJSONRPCResponse)
begin begin
edtResult.Text := JSONRPCResp.Result.AsInteger.ToString; edtResult.Text := JSONRPCResp.Result.AsInteger.ToString;
@ -540,7 +539,7 @@ begin
lReq := fExecutor.CreateRequest('subtract', Random(1000)); lReq := fExecutor.CreateRequest('subtract', Random(1000));
lReq.Params.AddByName('Value1', StrToInt(Edit1.Text)); lReq.Params.AddByName('Value1', StrToInt(Edit1.Text));
lReq.Params.AddByName('Value2', StrToInt(Edit2.Text)); lReq.Params.AddByName('Value2', StrToInt(Edit2.Text));
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
Edit3.Text := Resp.Result.AsInteger.ToString; Edit3.Text := Resp.Result.AsInteger.ToString;
@ -552,12 +551,12 @@ var
lPerson: TJsonObject; lPerson: TJsonObject;
lReq: IJSONRPCRequest; lReq: IJSONRPCRequest;
begin begin
lReq := FExecutor.CreateRequest('SaveObjectWithJSON', 1234); lReq := fExecutor.CreateRequest('SaveObjectWithJSON', 1234);
lPerson := TJsonObject.Create; lPerson := TJsonObject.Create;
lReq.Params.Add(lPerson, pdTJDOJsonObject); lReq.Params.Add(lPerson, pdTJDOJsonObject);
lPerson.S['StringProp'] := 'Hello World'; lPerson.S['StringProp'] := 'Hello World';
lPerson.O['JSONObject'] := TJsonObject.Parse('{"name":"Daniele"}') as TJsonObject; lPerson.O['JSONObject'] := TJsonObject.Parse('{"name":"Daniele"}') as TJsonObject;
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
lPerson := Resp.Result.AsObject as TJsonObject; lPerson := Resp.Result.AsObject as TJsonObject;
@ -579,43 +578,38 @@ begin
lThreadCount := 4; lThreadCount := 4;
TThread.CreateAnonymousThread( TThread.CreateAnonymousThread(
procedure
begin
while TInterlocked.Read(lThreadCount) > 0 do
begin
Sleep(100);
end;
TThread.Queue(nil,
procedure procedure
begin begin
ShowMessage( while TInterlocked.Read(lThreadCount) > 0 do
Val1 + sLineBreak + begin
Val2 + sLineBreak + Sleep(100);
Val3 + sLineBreak + end;
Val4 + sLineBreak TThread.Queue(nil,
); procedure
end); begin
end).Start; ShowMessage(Val1 + sLineBreak + Val2 + sLineBreak + Val3 + sLineBreak + Val4 + sLineBreak);
end);
end).Start;
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
Val1 := Resp.Result.AsInteger.ToString; Val1 := Resp.Result.AsInteger.ToString;
TInterlocked.Decrement(lThreadCount); TInterlocked.Decrement(lThreadCount);
end); end);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
Val2 := Resp.Result.AsInteger.ToString; Val2 := Resp.Result.AsInteger.ToString;
TInterlocked.Decrement(lThreadCount); TInterlocked.Decrement(lThreadCount);
end); end);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
Val3 := Resp.Result.AsInteger.ToString; Val3 := Resp.Result.AsInteger.ToString;
TInterlocked.Decrement(lThreadCount); TInterlocked.Decrement(lThreadCount);
end); end);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
Val4 := Resp.Result.AsInteger.ToString; Val4 := Resp.Result.AsInteger.ToString;
@ -633,8 +627,8 @@ begin
lReq.RequestID := Random(1000); lReq.RequestID := Random(1000);
lPersonRec := TTestRec.Create(2); lPersonRec := TTestRec.Create(2);
lReq.Params.Add(TValue.From<TTestRec>(lPersonRec), pdtRecordOrArrayOfRecord); lReq.Params.Add(TValue.From<TTestRec>(lPersonRec), pdtRecordOrArrayOfRecord);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure (Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
var var
lResPersonRec: TTestRec; lResPersonRec: TTestRec;
begin begin
@ -649,7 +643,7 @@ var
begin begin
ShowMessage('Now will be raised a EDivByZero exception on the server. This exception will be catched by the client'); ShowMessage('Now will be raised a EDivByZero exception on the server. This exception will be catched by the client');
lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException'); lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
FExecutor.ExecuteNotificationAsync('/jsonrpc', lReq); fExecutor.ExecuteNotificationAsync('/jsonrpc', lReq);
end; end;
procedure TMainForm.btnGenericExcWithCustomHAndling2Click(Sender: TObject); procedure TMainForm.btnGenericExcWithCustomHAndling2Click(Sender: TObject);
@ -660,7 +654,7 @@ begin
('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'); ('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 := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
lReq.Params.Add(2); lReq.Params.Add(2);
FExecutor.ExecuteRequestAsync('/jsonrpcex', lReq, nil); fExecutor.ExecuteRequestAsync('/jsonrpcex', lReq, nil);
end; end;
procedure TMainForm.btnGenericExcWithCustomHandlingClick(Sender: TObject); procedure TMainForm.btnGenericExcWithCustomHandlingClick(Sender: TObject);
@ -671,7 +665,7 @@ begin
('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'); ('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 := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
lReq.Params.Add(1); lReq.Params.Add(1);
FExecutor.ExecuteRequestAsync('/jsonrpcex', lReq, nil); fExecutor.ExecuteRequestAsync('/jsonrpcex', lReq, nil);
end; end;
procedure TMainForm.btnGenericExcWithoutCustomHandlingClick(Sender: TObject); procedure TMainForm.btnGenericExcWithoutCustomHandlingClick(Sender: TObject);
@ -681,7 +675,7 @@ begin
ShowMessage('Now will be raised a Exception exception on the server.'); ShowMessage('Now will be raised a Exception exception on the server.');
lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException'); lReq := TJSONRPCRequest.Create(1234, 'RaiseGenericException');
lReq.Params.Add(99); lReq.Params.Add(99);
FExecutor.ExecuteRequestAsync('/jsonrpcex', lReq, nil, fGeneralErrorHandler); fExecutor.ExecuteRequestAsync('/jsonrpcex', lReq, nil, fGeneralErrorHandler);
end; end;
procedure TMainForm.btnGetArrayOfRecordsClick(Sender: TObject); procedure TMainForm.btnGetArrayOfRecordsClick(Sender: TObject);
@ -693,7 +687,7 @@ begin
lReq := TJSONRPCRequest.Create; lReq := TJSONRPCRequest.Create;
lReq.Method := 'GetPeopleRecStaticArray'; lReq.Method := 'GetPeopleRecStaticArray';
lReq.RequestID := Random(1000); lReq.RequestID := Random(1000);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
lPeopleRec := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(Resp); lPeopleRec := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(Resp);
@ -716,10 +710,10 @@ begin
lReq := TJSONRPCRequest.Create; lReq := TJSONRPCRequest.Create;
lReq.Method := 'GetPeopleRecDynArray'; lReq.Method := 'GetPeopleRecDynArray';
lReq.RequestID := Random(1000); lReq.RequestID := Random(1000);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
var var
lPeopleRec : TArray<TTestRec>; lPeopleRec: TArray<TTestRec>;
begin begin
lPeopleRec := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(Resp); lPeopleRec := TJSONUtils.JSONArrayToArrayOfRecord<TTestRec>(Resp);
lbLogRec.Lines.Text := Resp.ResultAsJSONArray.ToJSON(False); lbLogRec.Lines.Text := Resp.ResultAsJSONArray.ToJSON(False);
@ -732,7 +726,7 @@ var
begin begin
FDMemTable1.Active := False; FDMemTable1.Active := False;
lReq := TJSONRPCRequest.Create(Random(1000), 'GetDataSetList'); lReq := TJSONRPCRequest.Create(Random(1000), 'GetDataSetList');
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
var var
lMultiDS: TObjectList<TDataSet>; lMultiDS: TObjectList<TDataSet>;
@ -752,7 +746,7 @@ var
begin begin
FDMemTable1.Active := False; FDMemTable1.Active := False;
lReq := TJSONRPCRequest.Create(Random(1000), 'getmulti'); lReq := TJSONRPCRequest.Create(Random(1000), 'getmulti');
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
var var
lMultiDS: TMultiDataset; lMultiDS: TMultiDataset;
@ -782,9 +776,7 @@ begin
finally finally
lMultiDS.Free; lMultiDS.Free;
end; end;
end, end, nil, jrpcPOST);
nil,
jrpcPOST);
end; end;
procedure TMainForm.edtGetCustomersClick(Sender: TObject); procedure TMainForm.edtGetCustomersClick(Sender: TObject);
@ -794,7 +786,7 @@ begin
FDMemTable1.Active := False; FDMemTable1.Active := False;
lReq := TJSONRPCRequest.Create(Random(1000), 'getcustomers'); lReq := TJSONRPCRequest.Create(Random(1000), 'getcustomers');
lReq.Params.AddByName('FilterString', edtFilter.Text); lReq.Params.AddByName('FilterString', edtFilter.Text);
FExecutor.ExecuteRequestAsync('/jsonrpc', lReq, fExecutor.ExecuteRequestAsync('/jsonrpc', lReq,
procedure(Resp: IJSONRPCResponse) procedure(Resp: IJSONRPCResponse)
begin begin
FDMemTable1.Active := True; FDMemTable1.Active := True;
@ -803,17 +795,16 @@ begin
procedure(Exc: Exception) procedure(Exc: Exception)
begin begin
ShowMessage(Exc.ClassName + ': ' + Exc.Message); ShowMessage(Exc.ClassName + ': ' + Exc.Message);
end, end, jrpcPOST);
jrpcPOST);
end; end;
procedure TMainForm.FormCreate(Sender: TObject); procedure TMainForm.FormCreate(Sender: TObject);
const const
SIMULATE_SLOW_NETWORK = False; SIMULATE_SLOW_NETWORK = False;
begin begin
FExecutor := TMVCJSONRPCExecutor.Create('http://localhost:8080'); fExecutor := TMVCJSONRPCExecutor.Create('http://localhost:8080');
FExecutor.SetOnSendCommandAsync( fExecutor.SetOnSendCommandAsync(
procedure(JSONRPCObject: IJSONRPCObject) procedure(JSONRPCObject: IJSONRPCObject)
begin begin
if SIMULATE_SLOW_NETWORK then if SIMULATE_SLOW_NETWORK then
@ -821,8 +812,11 @@ begin
Sleep(1000 + Random(3000)); Sleep(1000 + Random(3000));
end; end;
Log.Debug('REQUEST : ' + JSONRPCObject.ToString(True), 'jsonrpc'); Log.Debug('REQUEST : ' + JSONRPCObject.ToString(True), 'jsonrpc');
end) end);
.SetOnReceiveResponseAsync(
fExecutorAsync := TMVCJSONRPCExecutor.Create('http://localhost:8080');
fExecutorAsync.SetOnReceiveResponseAsync(
procedure(Req, Resp: IJSONRPCObject) procedure(Req, Resp: IJSONRPCObject)
begin begin
Log.Debug('>> OnReceiveResponse // start', 'jsonrpc'); Log.Debug('>> OnReceiveResponse // start', 'jsonrpc');
@ -830,27 +824,27 @@ begin
Log.Debug(' RESPONSE: ' + Resp.ToString(True), 'jsonrpc'); Log.Debug(' RESPONSE: ' + Resp.ToString(True), 'jsonrpc');
Log.Debug('<< OnReceiveResponse // end', 'jsonrpc'); Log.Debug('<< OnReceiveResponse // end', 'jsonrpc');
end) end)
.SetOnReceiveHTTPResponseAsync( .SetOnReceiveHTTPResponseAsync(
procedure(HTTPResp: IHTTPResponse) procedure(HTTPResp: IHTTPResponse)
begin begin
Log.Debug('RESPONSE: ' + HTTPResp.ContentAsString(), 'jsonrpc'); Log.Debug('RESPONSE: ' + HTTPResp.ContentAsString(), 'jsonrpc');
end) end)
.SetConfigureHTTPClientAsync( .SetConfigureHTTPClientAsync(
procedure (HTTPClient: THTTPClient) procedure(HttpClient: THTTPClient)
begin begin
HTTPClient.ResponseTimeout := 20000; HttpClient.ResponseTimeout := 20000;
HTTPClient.CustomHeaders['X-DMVCFRAMEWORK'] := 'DMVCFRAMEWORK_VERSION ' + DMVCFRAMEWORK_VERSION; HttpClient.CustomHeaders['X-DMVCFRAMEWORK'] := 'DMVCFRAMEWORK_VERSION ' + DMVCFRAMEWORK_VERSION;
end); end);
dtNextMonday.Date := Date; dtNextMonday.Date := Date;
// these are the methods to handle http headers in JSONRPC // these are the methods to handle http headers in JSONRPC
// the following line and the check on the server is just for demo // the following line and the check on the server is just for demo
Assert(FExecutor.HTTPHeadersCount = 0); Assert(fExecutor.HTTPHeadersCount = 0);
FExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString)); fExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString));
Assert(FExecutor.HTTPHeadersCount = 1); Assert(fExecutor.HTTPHeadersCount = 1);
FExecutor.ClearHTTPHeaders; fExecutor.ClearHTTPHeaders;
Assert(FExecutor.HTTPHeadersCount = 0); Assert(fExecutor.HTTPHeadersCount = 0);
FExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString)); fExecutor.AddHTTPHeader(TNetHeader.Create('x-token', TGUID.NewGuid.ToString));
PageControl1.ActivePageIndex := 0; PageControl1.ActivePageIndex := 0;
@ -859,16 +853,15 @@ begin
ShowMessage(Exc.ClassName + ': ' + Exc.Message); ShowMessage(Exc.ClassName + ': ' + Exc.Message);
end; end;
fWaiting := TWaitingForm.Create(Self); fWaiting := TWaitingForm.Create(Self);
fWaiting.PopupParent := Self; fWaiting.PopupParent := Self;
FExecutor.SetOnBeginAsyncRequest( fExecutor.SetOnBeginAsyncRequest(
procedure procedure
begin begin
fWaiting.IncreaseWaitingCount; fWaiting.IncreaseWaitingCount;
end); end);
FExecutor.SetOnEndAsyncRequest( fExecutor.SetOnEndAsyncRequest(
procedure procedure
begin begin
fWaiting.DecreaseWaitingCount; fWaiting.DecreaseWaitingCount;

10
samples/jsonrpc/jsonrpcserver/MyObjectU.pas
View File

@ -65,12 +65,13 @@ type
[MVCJSONRPCAllowGET] [MVCJSONRPCAllowGET]
function GetStringDictionary: TMVCStringDictionary; function GetStringDictionary: TMVCStringDictionary;
function GetUser(aUserName: string): TPerson; function GetUser(aUserName: string): TPerson;
function SavePerson(const Person: TJsonObject): Integer; function SavePerson(const Person: TPerson): Integer;
function FloatsTest(const aDouble: Double; const aExtended: Extended): Extended; function FloatsTest(const aDouble: Double; const aExtended: Extended): Extended;
procedure DoSomething; procedure DoSomething;
procedure RaiseCustomException; procedure RaiseCustomException;
function RaiseGenericException(const ExceptionType: Integer): Integer; function RaiseGenericException(const ExceptionType: Integer): Integer;
function SaveObjectWithJSON(const WithJSON: TJsonObject): TJsonObject; function SaveObjectWithJSON(const WithJSON: TJsonObject): TJsonObject;
//enums and sets support //enums and sets support
function PassingEnums(Value1: TEnumTest; Value2: TEnumTest): TEnumTest; function PassingEnums(Value1: TEnumTest; Value2: TEnumTest): TEnumTest;
function GetSetBySet(Value: TSetTest): TSetTest; function GetSetBySet(Value: TSetTest): TSetTest;
@ -383,7 +384,7 @@ begin
end; end;
end; end;
function TMyObject.SavePerson(const Person: TJsonObject): Integer; function TMyObject.SavePerson(const Person: TPerson): Integer;
// var // var
// lPerson: TPerson; // lPerson: TPerson;
begin begin
@ -427,7 +428,10 @@ end;
procedure TMyObject.OnAfterCallHook(const Context: TWebContext; const JSONResponse: TJDOJsonObject); procedure TMyObject.OnAfterCallHook(const Context: TWebContext; const JSONResponse: TJDOJsonObject);
begin begin
Log.Info('TMyObjectWithHooks.OnAfterCallHook >> ', 'jsonrpc'); Log.Info('TMyObjectWithHooks.OnAfterCallHook >> ', 'jsonrpc');
Log.Info(sLineBreak + JSONResponse.ToJSON(False), 'jsonrpc'); if Assigned(JSONResponse) then
begin
Log.Info(sLineBreak + JSONResponse.ToJSON(False), 'jsonrpc');
end;
Log.Info('TMyObjectWithHooks.OnAfterCallHook << ', 'jsonrpc'); Log.Info('TMyObjectWithHooks.OnAfterCallHook << ', 'jsonrpc');
end; end;

3
samples/jsonrpc/sync_client/MainClientFormU.dfm
View File

@ -482,7 +482,7 @@ object MainForm: TMainForm
AlignWithMargins = True AlignWithMargins = True
Left = 3 Left = 3
Top = 3 Top = 3
Width = 828 Width = 808
Height = 69 Height = 69
Align = alTop Align = alTop
Caption = Caption =
@ -497,7 +497,6 @@ object MainForm: TMainForm
Font.Style = [] Font.Style = []
ParentFont = False ParentFont = False
WordWrap = True WordWrap = True
ExplicitWidth = 808
end end
object btnGenericExcWithCustomHandling: TButton object btnGenericExcWithCustomHandling: TButton
Left = 0 Left = 0

1
samples/jsonrpc/sync_client/MainClientFormU.pas
View File

@ -300,7 +300,6 @@ procedure TMainForm.btnGetUserClick(Sender: TObject);
var var
lReq: IJSONRPCRequest; lReq: IJSONRPCRequest;
lResp: IJSONRPCResponse; lResp: IJSONRPCResponse;
lJSON: TJsonObject;
begin begin
lbPerson.Clear; lbPerson.Clear;
lReq := TJSONRPCRequest.Create; lReq := TJSONRPCRequest.Create;

37
sources/MVCFramework.JSONRPC.Client.pas
View File

@ -118,16 +118,16 @@ type
function CreateNotification(const MethodName: String): IJSONRPCNotification; function CreateNotification(const MethodName: String): IJSONRPCNotification;
//async //async
function SetOnReceiveResponseAsync(const aOnReceiveResponseAsyncProc: TProc<IJSONRPCObject, IJSONRPCObject>) function SetOnReceiveResponseAsync(const aOnReceiveResponseAsyncProc: TProc<IJSONRPCObject, IJSONRPCObject>)
: IMVCJSONRPCExecutor; : IMVCJSONRPCExecutorAsync;
function SetOnSendCommandAsync(const aOnSendCommandAsyncProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutor; function SetOnSendCommandAsync(const aOnSendCommandAsyncProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutorAsync;
function SetOnReceiveHTTPResponseAsync(const aOnReceiveHTTPResponseAsync: TProc<IHTTPResponse>): IMVCJSONRPCExecutor; function SetOnReceiveHTTPResponseAsync(const aOnReceiveHTTPResponseAsync: TProc<IHTTPResponse>): IMVCJSONRPCExecutorAsync;
function SetOnBeginAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutor; function SetOnBeginAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutorAsync;
function SetOnEndAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutor; function SetOnEndAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutorAsync;
/// <summary> /// <summary>
/// Invoked internally just before each async requests/notifications. /// Invoked internally just before each async requests/notifications.
/// Use it to customize properties and events of HTTP client used in async operations. /// Use it to customize properties and events of HTTP client used in async operations.
/// </summary> /// </summary>
function SetConfigureHTTPClientAsync(const aConfigProcAsync: TProc<THTTPClient>): IMVCJSONRPCExecutor; function SetConfigureHTTPClientAsync(const aConfigProcAsync: TProc<THTTPClient>): IMVCJSONRPCExecutorAsync;
//end events //end events
end; end;
@ -205,8 +205,8 @@ type
const AJSONRPCNotification: IJSONRPCNotification; const AJSONRPCNotification: IJSONRPCNotification;
const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc; const AJSONRPCErrorHandler: TJSONRPCErrorHandlerProc;
const UseVerb: TJSONRPCHTTPVerb); overload; const UseVerb: TJSONRPCHTTPVerb); overload;
function SetOnBeginAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutor; function SetOnBeginAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutorAsync;
function SetOnEndAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutor; function SetOnEndAsyncRequest(const Proc: TProc): IMVCJSONRPCExecutorAsync;
// Http headers handling // Http headers handling
procedure AddHTTPHeader(const aNetHeader: TNetHeader); procedure AddHTTPHeader(const aNetHeader: TNetHeader);
procedure ClearHTTPHeaders; procedure ClearHTTPHeaders;
@ -226,10 +226,10 @@ type
: IMVCJSONRPCExecutor; : IMVCJSONRPCExecutor;
function SetOnReceiveHTTPResponse(const aOnReceiveHTTPResponse: TProc<IHTTPResponse>): IMVCJSONRPCExecutor; function SetOnReceiveHTTPResponse(const aOnReceiveHTTPResponse: TProc<IHTTPResponse>): IMVCJSONRPCExecutor;
//async //async
function SetOnReceiveResponseAsync(const aOnReceiveResponseAsyncProc: TProc<IJSONRPCObject, IJSONRPCObject>): IMVCJSONRPCExecutor; function SetOnReceiveResponseAsync(const aOnReceiveResponseAsyncProc: TProc<IJSONRPCObject, IJSONRPCObject>): IMVCJSONRPCExecutorAsync;
function SetOnSendCommandAsync(const aOnSendCommandAsyncProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutor; function SetOnSendCommandAsync(const aOnSendCommandAsyncProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutorAsync;
function SetOnReceiveHTTPResponseAsync(const aOnReceiveHTTPResponseAsync: TProc<IHTTPResponse>): IMVCJSONRPCExecutor; function SetOnReceiveHTTPResponseAsync(const aOnReceiveHTTPResponseAsync: TProc<IHTTPResponse>): IMVCJSONRPCExecutorAsync;
function SetConfigureHTTPClientAsync(const aConfigProcAsync: TProc<THTTPClient>): IMVCJSONRPCExecutor; function SetConfigureHTTPClientAsync(const aConfigProcAsync: TProc<THTTPClient>): IMVCJSONRPCExecutorAsync;
//end events //end events
function ConfigureHTTPClient(const aConfigProc: TProc<THTTPClient>): IMVCJSONRPCExecutor; function ConfigureHTTPClient(const aConfigProc: TProc<THTTPClient>): IMVCJSONRPCExecutor;
public public
@ -656,20 +656,21 @@ begin
end; end;
function TMVCJSONRPCExecutor.SetConfigureHTTPClientAsync( function TMVCJSONRPCExecutor.SetConfigureHTTPClientAsync(
const aConfigProcAsync: TProc<THTTPClient>): IMVCJSONRPCExecutor; const aConfigProcAsync: TProc<THTTPClient>): IMVCJSONRPCExecutorAsync;
begin begin
fConfigProcAsync := aConfigProcAsync; fConfigProcAsync := aConfigProcAsync;
Result := Self;
end; end;
function TMVCJSONRPCExecutor.SetOnBeginAsyncRequest( function TMVCJSONRPCExecutor.SetOnBeginAsyncRequest(
const Proc: TProc): IMVCJSONRPCExecutor; const Proc: TProc): IMVCJSONRPCExecutorAsync;
begin begin
fOnBeginAsyncRequest := Proc; fOnBeginAsyncRequest := Proc;
Result := Self; Result := Self;
end; end;
function TMVCJSONRPCExecutor.SetOnEndAsyncRequest( function TMVCJSONRPCExecutor.SetOnEndAsyncRequest(
const Proc: TProc): IMVCJSONRPCExecutor; const Proc: TProc): IMVCJSONRPCExecutorAsync;
begin begin
fOnEndAsyncRequest := Proc; fOnEndAsyncRequest := Proc;
Result := Self; Result := Self;
@ -697,7 +698,7 @@ begin
end; end;
function TMVCJSONRPCExecutor.SetOnReceiveHTTPResponseAsync( function TMVCJSONRPCExecutor.SetOnReceiveHTTPResponseAsync(
const aOnReceiveHTTPResponseAsync: TProc<IHTTPResponse>): IMVCJSONRPCExecutor; const aOnReceiveHTTPResponseAsync: TProc<IHTTPResponse>): IMVCJSONRPCExecutorAsync;
begin begin
fOnReceiveHTTPResponseAsync := aOnReceiveHTTPResponseAsync; fOnReceiveHTTPResponseAsync := aOnReceiveHTTPResponseAsync;
Result := Self; Result := Self;
@ -711,7 +712,7 @@ begin
end; end;
function TMVCJSONRPCExecutor.SetOnReceiveResponseAsync( function TMVCJSONRPCExecutor.SetOnReceiveResponseAsync(
const aOnReceiveResponseAsyncProc: TProc<IJSONRPCObject, IJSONRPCObject>): IMVCJSONRPCExecutor; const aOnReceiveResponseAsyncProc: TProc<IJSONRPCObject, IJSONRPCObject>): IMVCJSONRPCExecutorAsync;
begin begin
fOnReceiveResponseAsync := aOnReceiveResponseAsyncProc; fOnReceiveResponseAsync := aOnReceiveResponseAsyncProc;
Result := Self; Result := Self;
@ -724,7 +725,7 @@ begin
end; end;
function TMVCJSONRPCExecutor.SetOnSendCommandAsync( function TMVCJSONRPCExecutor.SetOnSendCommandAsync(
const aOnSendCommandAsyncProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutor; const aOnSendCommandAsyncProc: TProc<IJSONRPCObject>): IMVCJSONRPCExecutorAsync;
begin begin
fOnSendCommandAsync := aOnSendCommandAsyncProc; fOnSendCommandAsync := aOnSendCommandAsyncProc;
Result := Self; Result := Self;

112
sources/MVCFramework.JSONRPC.pas
View File

@ -41,8 +41,8 @@ uses
MVCFramework.Commons, MVCFramework.Commons,
System.Rtti, System.Rtti,
System.Generics.Collections, System.Generics.Collections,
MVCFramework.Serializer.JsonDataObjects, MVCFramework.Serializer.JsonDataObjects, MVCFramework.Serializer.Commons,
System.SysUtils, MVCFramework.Serializer.Commons; System.SysUtils;
const const
JSONRPC_VERSION = '2.0'; JSONRPC_VERSION = '2.0';
@ -1775,12 +1775,16 @@ var
lRTTIMethodParam: TRttiParameter; lRTTIMethodParam: TRttiParameter;
lJSONParams: TJDOJsonArray; lJSONParams: TJDOJsonArray;
lJSONNamedParams: TJDOJsonObject; lJSONNamedParams: TJDOJsonObject;
I, lParamsCount: Integer; I, lParamsCount, lParamsCountMinusInjectedOnes: Integer;
lUseNamedParams: Boolean; lUseNamedParams: Boolean;
lParamsArray: TArray<TValue>; lParamsArray: TArray<TValue>;
lParamsIsRecord: TArray<Boolean>; lParamsIsRecord: TArray<Boolean>;
lRecordsPointer: TArray<PByte>; lRecordsPointer: TArray<PByte>;
lParamArrayLength: TArray<Integer>; lParamArrayLength: TArray<Integer>;
lInjectAttribute: MVCInjectAttribute;
lIntf: IInterface;
lOutIntf: IInterface;
lInjectedParamsFoundSoFar: Integer;
function GetJsonDataValueHelper(const JSONNamedParams: TJsonObject; const JsonPropName: string): TJsonDataValueHelper; function GetJsonDataValueHelper(const JSONNamedParams: TJsonObject; const JsonPropName: string): TJsonDataValueHelper;
var var
I: Integer; I: Integer;
@ -1820,24 +1824,33 @@ begin
lRTTIMethodParams := RTTIMethod.GetParameters; lRTTIMethodParams := RTTIMethod.GetParameters;
lParamsCount := Length(lRTTIMethodParams); lParamsCount := Length(lRTTIMethodParams);
lParamsCountMinusInjectedOnes := lParamsCount;
for lRTTIMethodParam in lRTTIMethodParams do
begin
if TRttiUtils.HasAttribute<MVCInjectAttribute>(lRTTIMethodParam) then
begin
Dec(lParamsCountMinusInjectedOnes);
end;
end;
if lUseNamedParams then if lUseNamedParams then
begin begin
if (lParamsCount > 0) and (not Assigned(lJSONNamedParams)) then if (lParamsCountMinusInjectedOnes > 0) and (not Assigned(lJSONNamedParams)) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].', [lParamsCount, 0]); raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].', [lParamsCountMinusInjectedOnes, 0]);
if Assigned(lJSONNamedParams) and (lParamsCount <> lJSONNamedParams.Count) then if Assigned(lJSONNamedParams) and (lParamsCountMinusInjectedOnes <> lJSONNamedParams.Count) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].', raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].',
[lParamsCount, lJSONNamedParams.Count]); [lParamsCount, lJSONNamedParams.Count]);
end end
else else
begin begin
if (lParamsCount > 0) and (not Assigned(lJSONParams)) then if (lParamsCountMinusInjectedOnes > 0) and (not Assigned(lJSONParams)) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].', raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].',
[lParamsCount, 0]); [lParamsCountMinusInjectedOnes, 0]);
if Assigned(lJSONParams) and (lParamsCount <> lJSONParams.Count) then if Assigned(lJSONParams) and (lParamsCountMinusInjectedOnes <> lJSONParams.Count) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].', raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].',
[lParamsCount, lJSONParams.Count]); [lParamsCountMinusInjectedOnes, lJSONParams.Count]);
end; end;
for lRTTIMethodParam in lRTTIMethodParams do for lRTTIMethodParam in lRTTIMethodParams do
@ -1856,39 +1869,65 @@ begin
SetLength(lRecordsPointer, lParamsCount); SetLength(lRecordsPointer, lParamsCount);
SetLength(lParamArrayLength, lParamsCount); SetLength(lParamArrayLength, lParamsCount);
try try
lInjectedParamsFoundSoFar := 0;
// scroll json params and rttimethod params and find the best match // scroll json params and rttimethod params and find the best match
if Assigned(lJSONParams) then
for I := 0 to lParamsCount - 1 do
begin begin
// positional params if TRttiUtils.HasAttribute<MVCInjectAttribute>(lRTTIMethodParams[I], lInjectAttribute) then
for I := 0 to lJSONParams.Count - 1 do
begin begin
JSONDataValueToTValueParamEx( lIntf := Context.ServiceContainerResolver.Resolve(lRTTIMethodParams[I].ParamType.Handle, lInjectAttribute.ServiceName);
fSerializer, Supports(lIntf, lRTTIMethodParams[I].ParamType.Handle.TypeData.GUID, lOutIntf);
lJSONParams[I], TValue.Make(@lOutIntf, lRTTIMethodParams[I].ParamType.Handle, lParamsArray[I]);
lRTTIMethodParams[I], Inc(lInjectedParamsFoundSoFar);
lParamsArray[I], end
lParamsIsRecord[I], else
lRecordsPointer[I],
lParamArrayLength[i]
);
end;
end
else if Assigned(lJSONNamedParams) then
begin
// named params
for I := 0 to lJSONNamedParams.Count - 1 do
begin begin
JSONDataValueToTValueParamEx( if lUseNamedParams then
fSerializer, begin
GetJsonDataValueHelper(lJSONNamedParams, lRTTIMethodParams[I].Name.ToLower), JSONDataValueToTValueParamEx(
lRTTIMethodParams[I], fSerializer,
lParamsArray[I], GetJsonDataValueHelper(lJSONNamedParams, lRTTIMethodParams[I].Name.ToLower),
lParamsIsRecord[I], lRTTIMethodParams[I],
lRecordsPointer[I], lParamsArray[I],
lParamArrayLength[i]); lParamsIsRecord[I],
lRecordsPointer[I],
lParamArrayLength[i]);
end
else
begin
JSONDataValueToTValueParamEx(
fSerializer,
lJSONParams[I - lInjectedParamsFoundSoFar],
lRTTIMethodParams[I],
lParamsArray[I],
lParamsIsRecord[I],
lRecordsPointer[I],
lParamArrayLength[i]
);
end;
end; end;
end; end;
//do we consumes all parameters (considering the injected ones?)
if not lUseNamedParams then
begin
if Assigned(lJSONParams) and (lJSONParams.Count + lInjectedParamsFoundSoFar <> lParamsCount) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].',
[lParamsCount - lInjectedParamsFoundSoFar, lJSONParams.Count + lInjectedParamsFoundSoFar]);
if (not Assigned(lJSONParams)) and (lInjectedParamsFoundSoFar <> lParamsCount) then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].',
[lParamsCount - lInjectedParamsFoundSoFar, 0]);
end;
if lUseNamedParams then
begin
if lJSONNamedParams.Count + lInjectedParamsFoundSoFar <> lParamsCount then
raise EMVCJSONRPCInvalidParams.CreateFmt('Wrong parameters count. Expected [%d] got [%d].',
[lParamsCount - lInjectedParamsFoundSoFar, lJSONNamedParams.Count + lInjectedParamsFoundSoFar]);
end;
TryToCallMethod(RTTIType, JSONRPC_HOOKS_ON_BEFORE_CALL, JSON); TryToCallMethod(RTTIType, JSONRPC_HOOKS_ON_BEFORE_CALL, JSON);
BeforeCallHookHasBeenInvoked := True; BeforeCallHookHasBeenInvoked := True;
try try
@ -2214,7 +2253,6 @@ begin
for I := 0 to lJSONNamedParams.Count - 1 do for I := 0 to lJSONNamedParams.Count - 1 do
begin begin
JSONDataValueToTValueParam(GetJsonDataValueHelper(lJSONNamedParams, lRTTIMethodParams[I].Name.ToLower), JSONDataValueToTValueParam(GetJsonDataValueHelper(lJSONNamedParams, lRTTIMethodParams[I].Name.ToLower),
{ lJSONNamedParams.Values[lRTTIMethodParams[I].Name.ToLower], }
lRTTIMethodParams[I], Params); lRTTIMethodParams[I], Params);
end; end;
end; end;