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

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

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

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

@ -65,12 +65,13 @@ type
[MVCJSONRPCAllowGET]
function GetStringDictionary: TMVCStringDictionary;
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;
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;
@ -383,7 +384,7 @@ begin
end;
end;
function TMyObject.SavePerson(const Person: TJsonObject): Integer;
function TMyObject.SavePerson(const Person: TPerson): Integer;
// var
// lPerson: TPerson;
begin
@ -427,7 +428,10 @@ end;
procedure TMyObject.OnAfterCallHook(const Context: TWebContext; const JSONResponse: TJDOJsonObject);
begin
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');
end;

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

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

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

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

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

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

112
sources/MVCFramework.JSONRPC.pas
View File

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