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

https://github.com/danieleteti/delphimvcframework/issues/538 (WIP)

Browse Source
This commit is contained in:
Daniele Teti 2022-03-31 16:43:32 +02:00
parent 96bb67a29d
commit 594b3a36a9
10 changed files with 522 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
samples/jsonrpc_with_published_objects/MainClientFormU.dfm
View File

@ -10,16 +10,14 @@ object MainForm: TMainForm
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object PageControl1: TPageControl
Left = 0
Top = 0
Width = 842
Height = 604
ActivePage = TabSheet1
ActivePage = TabSheet5
Align = alClient
TabOrder = 0
object TabSheet1: TTabSheet
@ -239,6 +237,24 @@ object MainForm: TMainForm
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
@ -450,15 +466,63 @@ object MainForm: TMainForm
end
end
end
end
object btnException: TButton
Left = 633
Top = 173
Width = 170
Height = 32
Caption = 'Raise Custom Exception'
TabOrder = 1
OnClick = btnExceptionClick
object TabSheet5: TTabSheet
Caption = 'Custom Exceptions Handling'
ImageIndex = 2
object Label1: TLabel
AlignWithMargins = True
Left = 3
Top = 3
Width = 828
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
end
object DataSource1: TDataSource
DataSet = FDMemTable1

83
samples/jsonrpc_with_published_objects/MainClientFormU.pas
View File

@ -85,7 +85,13 @@ type
DBGrid1: TDBGrid;
btnGetMulti: TButton;
lbMulti: TListBox;
btnGenericException: TButton;
TabSheet5: TTabSheet;
Label1: TLabel;
btnException: TButton;
btnGenericExcWithCustomHandling: TButton;
btnGenericExcWithCustomHAndling2: TButton;
btnGenericExcWithoutCustomHandling: TButton;
procedure btnSubstractClick(Sender: TObject);
procedure btnReverseStringClick(Sender: TObject);
procedure edtGetCustomersClick(Sender: TObject);
@ -106,6 +112,10 @@ type
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);
private
FExecutor: IMVCJSONRPCExecutor;
// FExecutor2: IMVCJSONRPCExecutor;
@ -164,7 +174,6 @@ end;
procedure TMainForm.btnExceptionClick(Sender: TObject);
var
lReq: IJSONRPCNotification;
// lResp: IJSONRPCResponse;
begin
ShowMessage('Now will be raised a custom exception on the server. This exception will be catched by the client');
lReq := TJSONRPCNotification.Create('RaiseCustomException');
@ -409,6 +418,78 @@ begin
ShowMessage(lPerson.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.btnGetListOfDatasetClick(Sender: TObject);
var
lReq: IJSONRPCRequest;

1
samples/jsonrpc_with_published_objects/MainWebModuleU.dfm
View File

@ -1,5 +1,4 @@
object MyWebModule: TMyWebModule
OldCreateOrder = False
OnCreate = WebModuleCreate
OnDestroy = WebModuleDestroy
Actions = <>

33
samples/jsonrpc_with_published_objects/MainWebModuleU.pas
View File

@ -40,7 +40,7 @@ uses
MVCFramework.Commons,
MyObjectU,
MVCFramework.JSONRPC,
MainDM;
MainDM, MVCFramework.Serializer.Commons;
procedure TMyWebModule.WebModuleCreate(Sender: TObject);
begin
@ -57,6 +57,37 @@ begin
begin
Result := TdmMain.Create(nil);
end, '/rpcdatamodule');
FMVC.PublishObject(
function: TObject
begin
Result := TMyObject.Create;
end, '/jsonrpcex',
procedure(Exc: Exception;
WebContext: TWebContext;
var ErrorInfo: TMVCJSONRPCExceptionErrorInfo;
var ExceptionHandled: Boolean)
begin
if Exc is EInvalidPointer then
begin
ExceptionHandled := True;
ErrorInfo.Code := 9999;
ErrorInfo.Msg := 'Custom Message: ' + Exc.Message;
ErrorInfo.Data := StrDict(['key1','key2'],['value1','value2']);
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);

86
samples/jsonrpc_with_published_objects/MyObjectU.pas
View File

@ -40,13 +40,12 @@ type
private
function GetCustomersDataset: TFDMemTable;
procedure FillCustomersDataset(const DataSet: TDataSet);
//function GetPeopleDataset: TFDMemTable;
// function GetPeopleDataset: TFDMemTable;
procedure FillPeopleDataset(const DataSet: TDataSet);
public
procedure OnBeforeCall(const JSONRequest: TJDOJsonObject);
procedure OnBeforeRouting(const JSON: TJDOJsonObject);
procedure OnBeforeSendResponse(
const JSONResponse: TJDOJsonObject);
procedure OnBeforeSendResponse(const JSONResponse: TJDOJsonObject);
public
[MVCDoc('You know, returns aValue1 - aValue2')]
function Subtract(Value1, Value2: Integer): Integer;
@ -54,10 +53,10 @@ type
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;
function PlayWithDatesAndTimes(const aJustAFloat: Double; const aTime: TTime;
const aDate: TDate; const aDateAndTime: TDateTime): TDateTime;
[MVCJSONRPCAllowGET]
function GetCustomers(FilterString: string): TDataset;
function GetCustomers(FilterString: string): TDataSet;
[MVCJSONRPCAllowGET]
function GetMulti: TMultiDataset;
[MVCJSONRPCAllowGET]
@ -67,6 +66,7 @@ type
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;
// invalid parameters modifiers
procedure InvalidMethod1(var MyVarParam: Integer);
@ -146,7 +146,7 @@ begin
Result := aDouble + aExtended;
end;
function TMyObject.GetCustomers(FilterString: string): TDataset;
function TMyObject.GetCustomers(FilterString: string): TDataSet;
var
lMT: TFDMemTable;
begin
@ -215,28 +215,28 @@ begin
Result := lDate;
end;
//function TMyObject.GetPeopleDataset: TFDMemTable;
//var
// lMT: TFDMemTable;
//begin
// lMT := TFDMemTable.Create(nil);
// try
// lMT.FieldDefs.Clear;
// lMT.FieldDefs.Add('FirstName', ftString, 20);
// lMT.FieldDefs.Add('LastName', ftString, 20);
// lMT.Active := True;
// lMT.AppendRecord(['Daniele', 'Teti']);
// lMT.AppendRecord(['Peter', 'Parker']);
// lMT.AppendRecord(['Bruce', 'Banner']);
// lMT.AppendRecord(['Scott', 'Summers']);
// lMT.AppendRecord(['Sue', 'Storm']);
// lMT.First;
// Result := lMT;
// except
// lMT.Free;
// raise;
// end;
//end;
// function TMyObject.GetPeopleDataset: TFDMemTable;
// var
// lMT: TFDMemTable;
// begin
// lMT := TFDMemTable.Create(nil);
// try
// lMT.FieldDefs.Clear;
// lMT.FieldDefs.Add('FirstName', ftString, 20);
// lMT.FieldDefs.Add('LastName', ftString, 20);
// lMT.Active := True;
// lMT.AppendRecord(['Daniele', 'Teti']);
// lMT.AppendRecord(['Peter', 'Parker']);
// lMT.AppendRecord(['Bruce', 'Banner']);
// lMT.AppendRecord(['Scott', 'Summers']);
// lMT.AppendRecord(['Sue', 'Storm']);
// lMT.First;
// Result := lMT;
// except
// lMT.Free;
// raise;
// end;
// end;
function TMyObject.GetStringDictionary: TMVCStringDictionary;
begin
@ -266,8 +266,8 @@ begin
// do nothing
end;
function TMyObject.PlayWithDatesAndTimes(const aJustAFloat: Double; const aTime: TTime; const aDate: TDate;
const aDateAndTime: TDateTime): TDateTime;
function TMyObject.PlayWithDatesAndTimes(const aJustAFloat: Double; const aTime: TTime;
const aDate: TDate; const aDateAndTime: TDateTime): TDateTime;
begin
Result := aDateAndTime + aDate + aTime + TDateTime(aJustAFloat);
end;
@ -277,6 +277,27 @@ 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);
@ -333,8 +354,7 @@ begin
Log.Info('TMyObjectWithHooks.OnBeforeRouting << ', 'jsonrpc');
end;
procedure TMyObject.OnBeforeSendResponse(
const JSONResponse: TJDOJsonObject);
procedure TMyObject.OnBeforeSendResponse(const JSONResponse: TJDOJsonObject);
begin
Log.Info('TMyObjectWithHooks.OnBeforeSendResponse >> ', 'jsonrpc');
Log.Info(JSONResponse.ToJSON(False), 'jsonrpc');

76
samples/jsonrpc_with_published_objects/jsonrpcclientwithobjects.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{300F83FF-8F7B-43FD-B740-A3DFDF7238ED}</ProjectGuid>
<ProjectVersion>19.2</ProjectVersion>
<ProjectVersion>19.4</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>jsonrpcclientwithobjects.dpr</MainSource>
<Base>True</Base>
@ -106,10 +106,6 @@
<DCCReference Include="..\..\sources\MVCFramework.JSONRPC.Client.pas"/>
<DCCReference Include="..\commons\RandomUtilsU.pas"/>
<DCCReference Include="..\commons\BusinessObjectsU.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
@ -117,6 +113,10 @@
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
@ -146,6 +146,16 @@
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClasses">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>64</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>classes</RemoteDir>
<Operation>64</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
@ -447,6 +457,11 @@
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="OSXARM64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
@ -474,6 +489,11 @@
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSXARM64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
@ -502,6 +522,11 @@
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSXARM64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
@ -531,6 +556,10 @@
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="OSXARM64">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
@ -1112,6 +1141,10 @@
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSXARM64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXEntitlements">
<Platform Name="OSX32">
@ -1122,6 +1155,10 @@
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSXARM64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXInfoPList">
<Platform Name="OSX32">
@ -1132,6 +1169,10 @@
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSXARM64">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
@ -1142,6 +1183,10 @@
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSXARM64">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
@ -1172,6 +1217,10 @@
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSXARM64">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
@ -1210,16 +1259,17 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Win32">True</Platform>

69
samples/jsonrpc_with_published_objects/jsonrpcserverwithobjects.dproj
View File

@ -1,7 +1,7 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{AF5FBC36-0D1D-4C07-B2E3-C2A2E688AC6F}</ProjectGuid>
<ProjectVersion>19.2</ProjectVersion>
<ProjectVersion>19.4</ProjectVersion>
<FrameworkType>VCL</FrameworkType>
<MainSource>jsonrpcserverwithobjects.dpr</MainSource>
<Base>True</Base>
@ -144,10 +144,6 @@
<FormType>dfm</FormType>
<DesignClass>TDataModule</DesignClass>
</DCCReference>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
@ -155,6 +151,10 @@
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
@ -166,11 +166,6 @@
</Source>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="OSX32">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
@ -186,6 +181,11 @@
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="OSX32">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Debug\jsonrpcserverwithobjects.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>jsonrpcserverwithobjects.exe</RemoteName>
@ -200,6 +200,16 @@
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClasses">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>64</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>classes</RemoteDir>
<Operation>64</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
@ -498,6 +508,10 @@
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="OSXARM64">
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
@ -511,6 +525,10 @@
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSXARM64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
@ -537,6 +555,10 @@
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSXARM64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
@ -564,6 +586,9 @@
<Platform Name="OSX64">
<Operation>0</Operation>
</Platform>
<Platform Name="OSXARM64">
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
@ -1117,6 +1142,10 @@
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSXARM64">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
@ -1145,6 +1174,9 @@
<Platform Name="OSX64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSXARM64">
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
@ -1183,16 +1215,17 @@
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSXARM64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
</Deployment>
<Platforms>
<Platform value="Android">False</Platform>

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

@ -308,13 +308,18 @@ begin
if lJSONRPCResponse = nil then
begin
raise EMVCException.CreateFmt('[REMOTE EXCEPTION][%d: %s]: %s',
[fHTTPResponse.StatusCode, fHTTPResponse.StatusText, fHTTPResponse.ContentAsString()]);
raise EMVCJSONRPCException.CreateFmt('[PROTOCOL EXCEPTION][%d: %s]: %s',
[fHTTPResponse.StatusCode,
fHTTPResponse.StatusText,
fHTTPResponse.ContentAsString()]);
end;
if Assigned(lJSONRPCResponse.Error) and fRaiseExceptionOnError then
raise EMVCJSONRPCException.CreateFmt('[REMOTE EXCEPTION][%d]: %s',
[lJSONRPCResponse.Error.Code, lJSONRPCResponse.Error.ErrMessage]);
raise EMVCJSONRPCRemoteException.Create(
lJSONRPCResponse.Error.Code,
lJSONRPCResponse.Error.ErrMessage,
lJSONRPCResponse.Error.Data
);
Result := lJSONRPCResponse;
finally
lSS.Free;

153
sources/MVCFramework.JSONRPC.pas
View File

@ -238,11 +238,16 @@ type
private
FCode: Integer;
FMessage: string;
FData: TValue;
procedure SetCode(const Value: Integer);
procedure SetMessage(const Value: string);
procedure SetData(const Value: TValue);
public
constructor Create; virtual;
destructor Destroy; override;
property Code: Integer read FCode write SetCode;
property ErrMessage: string read FMessage write SetMessage;
property Data: TValue read fData write SetData;
end;
IJSONRPCResponse = interface(IJSONRPCObject)
@ -318,17 +323,34 @@ type
end;
EMVCJSONRPCRemoteException = class(EMVCJSONRPCException)
private
fErrData: TValue;
fErrCode: Integer;
fErrMessage: String;
public
constructor Create(const ErrCode: Integer; const ErrMessage: String; const ErrData: TValue); overload;
constructor Create(const ErrCode: Integer; const ErrMessage: String); overload;
property Data: TValue read fErrData;
property ErrCode: Integer read fErrCode;
property ErrMessage: String read fErrMessage;
end;
EMVCJSONRPCErrorResponse = class abstract(Exception)
protected
fJSONRPCErrorCode: Integer;
fJSONRPCErrorData: TValue;
public
property JSONRPCErrorCode: Integer read fJSONRPCErrorCode;
property JSONRPCErrorData: TValue read fJSONRPCErrorData;
end;
EMVCJSONRPCError = class(EMVCJSONRPCErrorResponse)
public
constructor Create(const ErrCode: Integer; const Msg: string);
constructor CreateFmt(const ErrCode: Integer; const Msg: string; const Args: array of const);
constructor Create(const ErrCode: Integer; const ErrMsg: string); overload;
constructor Create(const ErrCode: Integer; const ErrMsg: string; const Data: TValue); overload;
constructor CreateFmt(const ErrCode: Integer; const ErrMsg: string; const Args: array of const);
end;
EMVCJSONRPCParseError = class(EMVCJSONRPCErrorResponse)
@ -372,6 +394,7 @@ type
TMVCJSONRPCController = class(TMVCController)
private
fExceptionHandler: TMVCJSONRPCExceptionHandlerProc;
fSerializer: TMVCJsonDataObjectsSerializer;
fRPCInstance: TObject;
fOwsRPCInstance: Boolean;
@ -379,7 +402,10 @@ type
function GetDeclaredMethod(lMethod: string; lRTTIType: TRttiType): TRTTIMethod;
function GetInheritedMethod(lMethod: string; lRTTIType: TRttiType): TRTTIMethod;
protected
function CreateError(const RequestID: TValue; const ErrorCode: Integer; const Message: string): TJDOJsonObject;
function CreateError(const RequestID: TValue; const ErrorCode: Integer;
const Message: string): TJDOJsonObject; overload;
function CreateError(const RequestID: TValue; const ErrorCode: Integer;
const Message: string; const Data: TValue): TJDOJsonObject; overload;
function CreateResponse(const RequestID: TValue; const Value: TValue): TJSONRPCResponse;
function CreateRequest(const JSON: TJDOJsonObject): IJSONRPCRequest;
function JSONObjectAs<T: class, constructor>(const JSON: TJDOJsonObject): T;
@ -408,7 +434,8 @@ type
TMVCJSONRPCPublisher = class(TMVCJSONRPCController)
public
constructor Create(const RPCInstance: TObject; const Owns: Boolean = True); reintroduce; overload;
constructor Create(const RPCInstance: TObject; const Owns: Boolean = True; ExceptionHandler: TMVCJSONRPCExceptionHandlerProc = nil);
reintroduce; overload;
end;
TJSONRPCProxyGenerator = class abstract
@ -821,11 +848,13 @@ end;
{ TMVCJSONRPCController }
constructor TMVCJSONRPCPublisher.Create(const RPCInstance: TObject; const Owns: Boolean);
constructor TMVCJSONRPCPublisher.Create(const RPCInstance: TObject; const Owns: Boolean = True; ExceptionHandler:
TMVCJSONRPCExceptionHandlerProc = nil);
begin
inherited Create;
fRPCInstance := RPCInstance;
fOwsRPCInstance := Owns;
fExceptionHandler := ExceptionHandler;
end;
// procedure TMVCJSONRPCController.CheckInputParametersTypes(aRTTIMethod: TRTTIMethod);
@ -862,6 +891,12 @@ end;
function TMVCJSONRPCController.CreateError(const RequestID: TValue; const ErrorCode: Integer; const Message: string)
: TJDOJsonObject;
begin
Result := CreateError(RequestID, ErrorCode, Message, TValue.Empty);
end;
function TMVCJSONRPCController.CreateError(const RequestID: TValue; const ErrorCode: Integer; const Message: string; const Data: TValue)
: TJDOJsonObject;
var
lErrResp: TJSONRPCResponse;
begin
@ -871,12 +906,17 @@ begin
lErrResp.Error := TJSONRPCResponseError.Create;
lErrResp.Error.Code := ErrorCode;
lErrResp.Error.ErrMessage := message;
if not Data.IsEmpty then
begin
lErrResp.Error.Data := Data;
end;
Result := lErrResp.AsJSON;
finally
lErrResp.Free;
end;
end;
function TMVCJSONRPCController.CreateRequest(const JSON: TJDOJsonObject): IJSONRPCRequest;
var
lReqID: TValue;
@ -1147,6 +1187,8 @@ var
lTypeAttrs: TArray<TCustomAttribute>;
lHTTPVerb: TMVCHTTPMethodType;
lAllMethodsCallableWithGET: Boolean;
lExceptionHandled: Boolean;
lJSONRespErrorInfo: TMVCJSONRPCExceptionErrorInfo;
begin
lBeforeCallHookHasBeenInvoked := False;
lAfterCallHookHasBeenInvoked := False;
@ -1340,16 +1382,46 @@ begin
JSONRPC_ERR_SERVER_ERROR_LOWERBOUND .. JSONRPC_ERR_SERVER_ERROR_UPPERBOUND:
ResponseStatus(500);
end;
lJSONResp := CreateError(lReqID, E.JSONRPCErrorCode, E.Message);
lJSONResp := CreateError(lReqID, E.JSONRPCErrorCode, E.Message, E.JSONRPCErrorData);
LogE(Format('[JSON-RPC][CLS %s][ERR %d][MSG "%s"]', [E.ClassName, E.JSONRPCErrorCode, E.Message]));
end;
on Ex: Exception do // use another name for exception variable, otherwise E is nil!!
begin
lJSONResp := CreateError(lReqID, 0, Ex.Message);
//lJSONResp := CreateError(lReqID, 0, Ex.Message);
LogE(Format('[JSON-RPC][CLS %s][MSG "%s"]', [Ex.ClassName, Ex.Message]));
if Assigned(fExceptionHandler) then
begin
lExceptionHandled := False;
lJSONRespErrorInfo.Code := 0;
lJSONRespErrorInfo.Msg := Ex.Message;
lJSONRespErrorInfo.Data := nil;
fExceptionHandler(Ex, Context, lJSONRespErrorInfo, lExceptionHandled);
try
if not lExceptionHandled then
begin
lJSONResp := CreateError(lReqID, 0, Ex.Message);
end
else
begin
lJSONResp := CreateError(lReqID, lJSONRespErrorInfo.Code,
lJSONRespErrorInfo.Msg, lJSONRespErrorInfo.Data);
end;
finally
if not lJSONRespErrorInfo.Data.IsEmpty then
begin
if lJSONRespErrorInfo.Data.IsObjectInstance then
begin
lJSONRespErrorInfo.Data.AsObject.Free;
end;
end;
end;
end
else
begin
lJSONResp := CreateError(lReqID, 0, Ex.Message);
end;
end;
end; // except
if lBeforeCallHookHasBeenInvoked and (not lAfterCallHookHasBeenInvoked) then
begin
try
@ -1772,6 +1844,10 @@ begin
begin
Result.O[JSONRPC_ERROR].I[JSONRPC_CODE] := FError.Code;
Result.O[JSONRPC_ERROR].S[JSONRPC_MESSAGE] := FError.ErrMessage;
if not FError.Data.IsEmpty then
begin
TValueToJSONObjectProperty(FError.Data, Result.O[JSONRPC_ERROR], JSONRPC_DATA);
end;
end
else
begin
@ -1848,6 +1924,14 @@ begin
FError := TJSONRPCResponseError.Create;
FError.Code := JSON.O[JSONRPC_ERROR].I[JSONRPC_CODE];
FError.ErrMessage := JSON.O[JSONRPC_ERROR].S[JSONRPC_MESSAGE];
if JSON.O[JSONRPC_ERROR].Contains(JSONRPC_DATA) then
begin
try
FError.Data := JSONDataValueToTValue(JSON.O[JSONRPC_ERROR].Path[JSONRPC_DATA]);
except
FError.Data := JSON.O[JSONRPC_ERROR].Path[JSONRPC_DATA].Value;
end;
end;
end
else
begin
@ -1927,11 +2011,34 @@ end;
{ TJSONRPCResponseError }
constructor TJSONRPCResponseError.Create;
begin
inherited;
FData := TValue.Empty;
end;
destructor TJSONRPCResponseError.Destroy;
begin
if not FData.IsEmpty then
begin
if FData.IsObjectInstance then
begin
FData.AsObject.Free;
end;
end;
inherited;
end;
procedure TJSONRPCResponseError.SetCode(const Value: Integer);
begin
FCode := Value;
end;
procedure TJSONRPCResponseError.SetData(const Value: TValue);
begin
fData := Value;
end;
procedure TJSONRPCResponseError.SetMessage(const Value: string);
begin
FMessage := Value;
@ -2182,9 +2289,9 @@ end;
{ EMVCJSONRPCException }
constructor EMVCJSONRPCError.Create(const ErrCode: Integer; const Msg: string);
constructor EMVCJSONRPCError.Create(const ErrCode: Integer; const ErrMsg: string);
begin
inherited Create(Msg);
inherited Create(ErrMsg);
fJSONRPCErrorCode := ErrCode;
end;
@ -2268,12 +2375,34 @@ begin
Result := '';
end;
constructor EMVCJSONRPCError.CreateFmt(const ErrCode: Integer; const Msg: string; const Args: array of const);
constructor EMVCJSONRPCError.Create(const ErrCode: Integer; const ErrMsg: string; const Data: TValue);
begin
inherited CreateFmt(Msg, Args);
Create(ErrCode, ErrMsg);
fJSONRPCErrorData := Data;
end;
constructor EMVCJSONRPCError.CreateFmt(const ErrCode: Integer; const ErrMsg: string; const Args: array of const);
begin
inherited CreateFmt(ErrMsg, Args);
fJSONRPCErrorCode := ErrCode;
end;
{ EMVCJSONRPCRemoteException }
constructor EMVCJSONRPCRemoteException.Create(const ErrCode: Integer; const ErrMessage: String);
begin
Create(ErrCode, ErrMessage);
end;
constructor EMVCJSONRPCRemoteException.Create(const ErrCode: Integer; const ErrMessage: String;
const ErrData: TValue);
begin
inherited Create(Format('[REMOTE EXCEPTION - CODE: %d] %s', [ErrCode, ErrMessage]));
fErrData := ErrData;
fErrCode := ErrCode;
fErrMessage := ErrMessage;
end;
initialization
finalization

19
sources/MVCFramework.pas
View File

@ -567,6 +567,12 @@ type
property ParamsTable: TMVCRequestParamsTable read GetParamsTable write SetParamsTable;
end;
TMVCJSONRPCExceptionErrorInfo = record
Code: Integer;
Msg: string;
Data: TValue;
end;
TMVCEngine = class;
TMVCBase = class
@ -896,6 +902,11 @@ type
TMVCRouterLogState = (rlsRouteFound, rlsRouteNotFound);
TMVCRouterLogHandlerProc = reference to procedure(const Router: TMVCCustomRouter;
const RouterLogState: TMVCRouterLogState; const WebContext: TWebContext);
TMVCJSONRPCExceptionHandlerProc = reference to procedure(E: Exception;
{ SelectedController: TMVCController; //YAGNI }
WebContext: TWebContext;
var ErrorInfo: TMVCJSONRPCExceptionErrorInfo;
var ExceptionHandled: Boolean);
TWebContextCreateEvent = reference to procedure(const AContext: TWebContext);
TWebContextDestroyEvent = reference to procedure(const AContext: TWebContext);
@ -983,7 +994,7 @@ type
const ACreateAction: TMVCControllerCreateAction; const AURLSegment: string = '')
: TMVCEngine; overload;
function PublishObject(const AObjectCreatorDelegate: TMVCObjectCreatorDelegate;
const AURLSegment: string): TMVCEngine;
const AURLSegment: string; ExceptionHandler: TMVCJSONRPCExceptionHandlerProc = nil): TMVCEngine;
function SetViewEngine(const AViewEngineClass: TMVCViewEngineClass): TMVCEngine;
function SetExceptionHandler(const AExceptionHandlerProc: TMVCExceptionHandlerProc): TMVCEngine;
@ -1079,7 +1090,6 @@ type
property Output: string read FOutput;
end;
function IsShuttingDown: Boolean;
procedure EnterInShutdownState;
function CreateResponse(const StatusCode: UInt16; const ReasonString: string;
@ -3117,12 +3127,13 @@ begin
end;
function TMVCEngine.PublishObject(const AObjectCreatorDelegate: TMVCObjectCreatorDelegate;
const AURLSegment: string): TMVCEngine;
const AURLSegment: string; ExceptionHandler: TMVCJSONRPCExceptionHandlerProc = nil): TMVCEngine;
begin
Result := AddController(TMVCJSONRPCPublisher,
function: TMVCController
begin
Result := TMVCJSONRPCPublisher.Create(AObjectCreatorDelegate(), True);
Result := TMVCJSONRPCPublisher.Create(AObjectCreatorDelegate(),
True, ExceptionHandler);
end, AURLSegment);
end;