You are not logged in.
My application can have two different behave, depending on the customer's network.
Has two classes that implement the same interface.
One of the classes makes access to the database and the other creates a httpclient object to consume the class that makes access to the database.
All methods return RawJSON, when I use a simple structure that uses only one instance of the application class that makes access to the database JSON return is correct.
But when I use two instances of the application (consuming one another) the first return JSON is ok, and in the second the JSON is invalid.
See sample:
IMyInterface = interface (IInvokable)
function sample: RawJSON;
end;
TMyClassDirect = class (TInterfacedObject, IMyInterface)
public
function sample: RawJSON;
end;
TMyClassBridge = class (TInterfacedObjectWithCustomCreate, IMyInterface)
private
fSQLModel: TSQLModel;
fSQLHttpClient: TSQLHttpClient;
fMyClassDirect: IMyInterface;
public
function sample: RawJSON;
constructor Create; override;
end;
function TMyClassDirect.sample: RawJSON;
var
MyObject: TMyObject;
begin
MyObject: = TMyObject.Create;
MyObject.Foo: = 'bar';
Result: = ObjectToJson (MyObject);
FreeAndNil (MyObject);
end;
function TMyClassBridge.sample: RawJSON;
begin
Result: = fMyClassDirect.Sample;
end;
valid JSON
http://{direct host}:778/root/app/sample
{"result":[{"Foo":"bar"}]}
invalid JSON
http://{bridge host}:778/root/app/sample
{"result":["Foo":"bar"}]}
The difference is that it lacks the character {.
I hope you understood my explanation of the problem.
I can help?
Offline
sorry,
invalid json is
{"result":[{"Foo":"bar"}]]}
not
{"result":["Foo":"bar"}]}
including this character ]
Offline
Hi AB,
Below is the code of my example.
Server.dpr
program Server;
uses
Vcl.Forms,
MainServer in 'MainServer.pas' {FrmApp},
mORMot,
SynCommons,
main in 'main.pas';
{$R *.res}
begin
with TSQLLog.Family do begin
Level := LOG_VERBOSE;
EchoToConsole := LOG_VERBOSE; // log all events to the console
end;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TFrmApp, FrmApp);
ReportMemoryLeaksOnShutdown := True;
Application.Run;
end.
MainServer (Form)
unit MainServer;
interface
uses
System.SysUtils, Vcl.Forms, System.Classes, Vcl.Controls, Vcl.StdCtrls,
Vcl.ExtCtrls,
main;
type
TFrmApp = class(TForm)
BtnConnect: TButton;
cbBridge: TCheckBox;
Panel1: TPanel;
Panel2: TPanel;
Edit1: TEdit;
Edit2: TEdit;
procedure BtnConnectClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
MyServer: TMyHTTPServer;
public
end;
var
FrmApp: TFrmApp;
implementation
{$R *.dfm}
procedure TFrmApp.BtnConnectClick(Sender: TObject);
begin
if (cbBridge.Checked) then
begin
IP_Bridge := Edit2.Text;
Porta_Bridge := Edit1.Text;
end;
if Assigned(MyServer) then
begin
FreeAndNil(MyServer);
BtnConnect.caption := 'Desconectado';
end else
begin
MyServer := TMyHTTPServer.Create('773', 1);
if (cbBridge.Checked) then
MyServer.ServiceRegister(TMyClassBridge, TypeInfo(IMyInterface), '1')
else
MyServer.ServiceRegister(TMyClassDirect, TypeInfo(IMyInterface), '1');
BtnConnect.caption := 'Connect';
end;
end;
procedure TFrmApp.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeAndNil(MyServer);
end;
end.
Main.pas
unit main;
interface
uses
SynCommons, mORMot, mORMotHttpServer, mORMotHttpClient;
type
TMyService = class(TSQLRestServerFullMemory)
published
procedure myapp(Ctxt: TSQLRestServerURIContext);
end;
TMyHTTPServer = class(TSQLHttpServer)
private
oModel: TSQLModel;
oSQLRestServerFullMemory: TMyService;
public
function ServiceRegister(AImplementationClass: TInterfacedClass; const AInterfaces: PTypeInfo;
const AContractExpected: RawUTF8): boolean;
constructor Create(const APorta: RawUTF8; AThreadPoolCount: Integer); reintroduce;
destructor Destroy; override;
end;
TMyHTTPClient = class
private
oSQLModel1: TSQLModel;
oSQLHttpClient1: TSQLHttpClient;
FIPServidor: String;
FPortaMultiEmpresa: String;
public
constructor Create(const AIPServidor: String; const APortaServidor: String); overload;
function HttpServerConnect: Boolean;
function GetInterface(AInterface: PTypeInfo; const AVersaoInterface: RawUTF8; out Obj): Boolean;
function ServerTimeStampSynchronize: Boolean;
procedure CloseConnection;
end;
TMyObject = class
private
FFoo: RawUTF8;
published
property foo: RawUTF8 read FFoo write FFoo;
end;
IMyInterface = interface(IInvokable)
['{E6C6ADFD-5977-4759-B400-AA4140F1D683}']
function sample: RawJSON;
end;
TMyClassDirect = class(TInterfacedObject, IMyInterface)
public
function sample: RawJSON;
end;
TMyClassBridge = class(TInterfacedObjectWithCustomCreate, IMyInterface)
protected
FInstanciaInterface: IMyInterface;
oHTTPClient: TMyHTTPClient;
public
function sample: RawJSON;
constructor Create; override;
destructor Destroy; override;
end;
var
IP_Bridge: String;
Porta_Bridge: String;
implementation
uses
System.SysUtils, MainServer, Vcl.Forms, Winapi.Windows;
{ TMyClassBridge }
constructor TMyClassBridge.Create;
begin
inherited;
oHTTPClient := TMyHTTPClient.Create(IP_Bridge, Porta_Bridge);
oHTTPClient.HttpServerConnect;
oHTTPClient.GetInterface(TypeInfo(IMyInterface), '1', FInstanciaInterface);
end;
destructor TMyClassBridge.Destroy;
begin
FreeAndNil(oHTTPClient);
inherited;
end;
function TMyClassBridge.sample: RawJSON;
var
iEmpresaTerminal: Cardinal;
begin
try
Result := FInstanciaInterface.sample;
except
on E:Exception do
Result := E.Message;
end;
end;
{ TMyClassDirect }
function TMyClassDirect.sample: RawJSON;
var
MyObject: TMyObject;
begin
MyObject := TMyObject.Create;
MyObject.foo := 'bar';
Result := ObjectToJson(MyObject, []);
FreeAndNil(MyObject);
end;
{ TMyService }
procedure TMyService.myapp(Ctxt: TSQLRestServerURIContext);
var
sFileName: TFileName;
begin
sFileName := Ctxt.ResourceFileName;
if sFileName = '' then
Ctxt.Redirect('myapp/index.html')
else
Ctxt.ReturnFile(ExtractFilePath(Application.ExeName) + sFileName, true);
end;
{ TMyHTTPServer }
constructor TMyHTTPServer.Create(const APorta: RawUTF8; AThreadPoolCount: Integer);
begin
oModel := TSQLModel.Create([], 'app');
oSQLRestServerFullMemory := TMyService.Create(oModel, '', false, false);
inherited Create(APorta, [oSQLRestServerFullMemory], '+', useHttpApiRegisteringURI, AThreadPoolCount);
end;
function TMyHTTPServer.ServiceRegister(AImplementationClass: TInterfacedClass; const AInterfaces: PTypeInfo;
const AContractExpected: RawUTF8): boolean;
begin
oSQLRestServerFullMemory.ServiceRegister(AImplementationClass,
[AInterfaces], sicSingle).ContractExpected := AContractExpected;
Result := true;
end;
destructor TMyHTTPServer.Destroy;
begin
FreeAndNil(oModel);
FreeAndNil(oSQLRestServerFullMemory);
inherited;
end;
{ TMyHTTPClient }
procedure TMyHTTPClient.CloseConnection;
begin
FreeAndNil(oSQLHttpClient1);
oSQLHttpClient1 := nil;
FreeAndNil(oSQLModel1);
oSQLModel1 := nil;
end;
constructor TMyHTTPClient.Create(const AIPServidor,
APortaServidor: String);
begin
inherited Create;
FIPServidor := AIPServidor;
FPortaMultiEmpresa := APortaServidor;
end;
function TMyHTTPClient.GetInterface(AInterface: PTypeInfo;
const AVersaoInterface: RawUTF8; out Obj): Boolean;
var
sInterfaceName: RawUTF8;
begin
Result := False;
try
if (HttpServerConnect) then
begin
sInterfaceName := Copy(AInterface.Name, 2, Length(AInterface.Name));
if not(Assigned(oSQLHttpClient1.Services[sInterfaceName])) then
Result := oSQLHttpClient1.ServiceRegister(AInterface, sicSingle, AVersaoInterface) <> nil;
if (Result) then
Result := oSQLHttpClient1.Services[sInterfaceName].Get(Obj);
end;
except
on E:Exception do
begin
Result := False;
end;
end;
end;
function TMyHTTPClient.HttpServerConnect: Boolean;
var
i: integer;
begin
if (Assigned(oSQLHttpClient1)) then
CloseConnection;
for i := 1 to 2 do
begin
try
if Assigned(oSQLModel1) then
oSQLModel1.Free;
oSQLModel1 := TSQLModel.Create([], 'app');
oSQLHttpClient1 := TSQLHttpClient.Create(FIpServidor, FPortaMultiEmpresa ,
oSQLModel1, False, '', '', 30000, 30000);
Break;
except
on e: Exception do
begin
if i = 1 then
begin
oSQLHttpClient1.Free;
oSQLModel1.Free;
end
else
raise;
end;
end;
end;
Result := Assigned(oSQLHttpClient1) and (oSQLHttpClient1.ServerTimeStamp > 0);
if (not(Result)) then
raise Exception.Create('Connection server fail. ' +
oSQLHttpClient1.LastErrorMessage + ' error code: ' +
IntToStr(oSQLHttpClient1.LastErrorCode))
end;
function TMyHTTPClient.ServerTimeStampSynchronize: Boolean;
var
dServerDateTime: TDateTime;
dSystemTime: TSystemTime;
begin
try
Result := HttpServerConnect and oSQLHttpClient1.ServerTimeStampSynchronize;
if (Result) then
begin
dServerDateTime := TimeLogToDateTime(oSQLHttpClient1.ServerTimeStamp);
if (dServerDateTime > 0) then
begin
DateTimeToSystemTime(dServerDateTime, dSystemTime);
SetLocalTime(dSystemTime);
end;
end;
finally
CloseConnection;
end;
end;
end.
Json Valid (Direct)
http://127.0.0.1:773/app/MyInterface/sample
{"result":[{"foo":"bar"}]}
Json InValid (Bridge)
http://127.0.0.1:773/app/MyInterface/sample
{"result":[{"foo":"bar"}]]}
Offline
Could you please create a new ticket?
Do not forget to link this forum thread, as reference.
Thanks a lot for the feedback, and for taking the time to send some program to reproduce the issue!
Offline
Thanks AB.
I'm glad to help.
Ticket UUID: 4cf639afe6b45925a76260106c976c217947a9a3
Offline
hi AB,
I tried to change to solve the problem.
Tests for Service oriented architecture passed.
unit: mORMot.pas
class: TSQLRestServerURIContext
method: ServiceResultEnd
See if this is correct:
procedure TSQLRestServerURIContext.ServiceResultEnd(WR: TTextWriter; ID: integer);
const JSONSEND_WITHID: array[boolean] of RawUTF8 = ('],"id":','},"id":');
JSONSEND_NOID: array[boolean] of AnsiChar = (']','}');
begin // InternalExecuteSOAByInterface has set ForceServiceResultAsJSONObject
if (ID=0) and (WR.lastchar <> JSONSEND_NOID[ForceServiceResultAsJSONObject]) then
WR.Add(JSONSEND_NOID[ForceServiceResultAsJSONObject])
else if (WR.lastchar <> JSONSEND_WITHID[ForceServiceResultAsJSONObject]) then
begin
WR.AddString(JSONSEND_WITHID[ForceServiceResultAsJSONObject]);
WR.Add(ID); // only used in sicClientDriven mode
end;
WR.Add('}');
end;
Offline
Sorry,
else if condition will never be true.
Changed to
else if (WR.lastchar <> JSONSEND_WITHID[ForceServiceResultAsJSONObject][1]) then
But the tests did not pass.
2.7. Service oriented architecture:
- Weak interfaces: 56 assertions passed 405us
- Service initialization: 243 assertions passed 2.30ms
- Direct call: 583,392 assertions passed 24.99ms
- Server side: 583,411 assertions passed 25.31ms
! Exception EInterfaceFactoryException raised with messsage:
! Invalid TInterfacedObjectFake.FakeCall() for IComplexCalculator.Collections:
Invalid returned JSON content: expects {"result":...}
Offline
Should be fixed by http://synopse.info/fossil/info/ec20618d437
This was a more general issue about RawJSON decoding.
Thanks for the report.
Offline