You are not logged in.
Pages: 1
I need a help. I'm converting my ERP to mormot. In my ERP, the user can choose the database to connect. I use a Service Interface.
In Service Interface, I have this code:
type
TRemoteSQLEngine = (rseOleDB, rseODBC, rseOracle, rseSQlite3, rseJet, rseMSSQL, rseFirebird);
TSQLCPU_USER = class(TSQLRecordVirtual)
private
fIDUSER : Double;
fUSER_CODEXT: RawUTF8;
fNAME : RawUTF8;
fIDGROUP : Double;
fEMAIL : RawUTF8;
fINC_DATE : TDateTime;
fMOD_DATE : TDateTime;
fINC_USER : Double;
fMOD_USER : Double;
published
property IDUSER : Double read fIDUSER write fIDUSER;
property USER_CODEXT: RawUTF8 read fUSER_CODEXT write fUSER_CODEXT;
property NAME : RawUTF8 read fNAME write fNAME;
property IDGROUP : Double read fIDGROUP write fIDGROUP;
property EMAIL : RawUTF8 read fEMAIL write fEMAIL;
property INC_DATE : TDateTime read fINC_DATE write fINC_DATE;
property MOD_DATE : TDateTime read fMOD_DATE write fMOD_DATE;
property INC_USER : Double read fINC_USER write fINC_USER;
property MOD_USER : Double read fMOD_USER write fMOD_USER;
end;
IRemoteSQL = interface(IInvokable)
['{7392E8F4-02AE-4054-8DB7-56A8B95B795B}']
// Função para conectar ao banco de dados - Thread
function fn_connectdb(const AServer,
AUserName,
APassword,
AServerName,
ADataBase: RawUTF8;
const AEngine: TRemoteSQLEngine): RawUTF8;
end;
var
fProps : TSQLDBConnectionProperties;
fServerDB : TSQLRestServerDB;
fModel : TSQLModel;
fRestClient : TSQLRestClientURI;
fRestClientDB: TSQLRestClientDB;
fRestServer : TSQLRestServer;
fHTTPServer : TSQLHttpServer;
implementation
function DataModel(v_serverroot:RawUTF8): TSQLModel;
begin
Result := TSQLModel.Create([TSQLCPU_COMPANY,
TSQLCPU_USER,
TSQLCPU_PROCESS,
TSQLCPU_SYSTEM,
TSQLCPU_SYSTEMS,
TSQLCPU_PROGRAM,
TSQLCPU_FORM,
TSQLCPU_FORMFILTER,
TSQLCPU_FORMTABSHEET,
TSQLCPU_FTSSOURCE,
TSQLCPU_FORMSECCION,
TSQLCPU_FORMSECFIELD],
v_serverroot);
end;
In server side, i have this code:
procedure TfrmServAppRM.FormCreate(Sender: TObject);
begin
fService := TServiceRemoteSQL.Create;
fModel := DataModel(frmDMServer.fSettings.RootName);
try
fRestServer := TSQLRestServerFullMemory.Create(fModel,'users.json',false,True);
try
// registrar o servico IRemoteSQL do lado do servidor (metodos ServerInterface)
fRestServer.ServiceRegister(TServiceRemoteSQL,
[TypeInfo(IRemoteSQL)],
sicClientDriven).SetOptions([],
[optExecInMainThread,
optFreeInMainThread]);
//aServer.AuthenticationRegister(TSQLRestServerAuthenticationNone);
fRestServer.OnSessionCreate := fn_notifysessionC;
fRestServer.OnSessionClosed := fn_notifysessionD;
fHTTPServer := TSQLHttpServer.Create(frmDMServer.fSettings.Port,
[fRestServer],
'+',
useHttpApiRegisteringURI);
fHTTPServer.AccessControlAllowOrigin := '*'; // for AJAX requests to work
except
//
end;
except
//
end;
fService.Free;
end;
function TServiceRemoteSQL.fn_connectdb(const AServer,
AUserName,
APassword,
AServerName,
ADataBase: RawUTF8;
const AEngine: TRemoteSQLEngine): RawUTF8;
const // rseOleDB, rseODBC, rseOracle, rseSQlite3, rseJet, rseMSSQL, rseFirebird
TYPES: array[TRemoteSQLEngine] of TSQLDBConnectionPropertiesClass = (
TOleDBConnectionProperties,
TODBCConnectionProperties,
TSQLDBOracleConnectionProperties,
TSQLDBSQLite3ConnectionProperties,
{$ifdef WIN64}nil{$else}TOleDBJetConnectionProperties{$endif},
TOleDBMSSQL2008ConnectionProperties,
TSQLDBFireDACConnectionProperties);
begin
Result := '';
if fProps <> nil then
begin
Result := StringToUTF8(frmServAppRM.OLANG.fn_lerini('Mens',
'cpuMMensExistCon',
'cpuMMensExistCon'));
FreeAndNil(fProps);
end
else
begin
if TYPES[aEngine] = nil then
begin
Result := 'Error';
FreeAndNil(fProps);
end
else
begin
fProps := TYPES[aEngine].Create(aServerName,
aServer +
':' +
ADataBase,
AUserName,
aPassWord);
try
fProps.MainConnection.Connect;
VirtualTableExternalRegister(fModel,
TSQLCPU_USER,
fProps,
'CPU_USER');
fModel.Props[TSQLCPU_USER].ExternalDB.MapField('ID','IDUSER');
fServerDB := TSQLRestServerDB.Create(fModel, ':memory:',false); // authentication=false
fServerDB.CreateMissingTables;
except
on E: Exception do
begin
FreeAndNil(fProps);
Result :='Error';
end;
end;
end;
end;
end;
In client side, I have this code:
procedure TfrmMain.FormShow(Sender: TObject);
begin
fModel := DataModel(frmDM.fsettings.fRootName);
// Criar SQL client e conectar ao servidor
fRestClient := TSQLHttpClientWinHTTP.Create(frmDM.fsettings.fHost,
frmDM.fsettings.fPort,
fModel);
if not fRestClient.ServerTimeStampSynchronize then
begin
MessageDlg(Format(OLANG.fn_lerini('Mens',
'cpuMMensErrorSocket',
'cpuMMensErrorSocket'),
[#13,#13,#13,#13]),
TMsgDlgType.mtError,
[TMsgDlgBtn.mbOK],0);
Close;
exit;
end;
if (not fRestClient.SetUser('User','synopse')) or
(not fRestClient.ServiceRegisterClientDriven(TypeInfo(IRemoteSQL),frmDM.fService)) then
begin
MessageDlg(Format(OLANG.fn_lerini('Mens',
'cpuMMensErrorService',
'cpuMMensErrorService'),
[#13,#13]),
TMsgDlgType.mtError,
[TMsgDlgBtn.mbOK],0);
Close;
exit;
end;
procedure TfrmMain.btnLoginClick(Sender: TObject);
begin
fService.fn_connectdb(frmDM.fsettings.fDBs[cbDB.ItemIndex].fServer,
frmDM.fsettings.fDBs[cbDB.ItemIndex].fUserID,
frmDM.fsettings.fDBs[cbDB.ItemIndex].fPassword,
frmDM.fsettings.fDBs[cbDB.ItemIndex].fServerName,
frmDM.fsettings.fDBs[cbDB.ItemIndex].fDatabaseName,
TRemoteSQLEngine(frmDM.fsettings.fDBs[cbDB.ItemIndex].fEngine));
end;
In service side, when I call this code, work and I access the register from the table:
v_cpuuser:= TSQLCPU_USER.Create(fServerDB,'IDUSER>=?',[1]);
But, in client side, when i call this code, don't work and I can't access the register's from the table:
v_cpuuser:= TSQLCPU_USER.Create(fRestClient,'IDUSER>=?',[1]);
PLEASE, WHAT AM I DOING WRONG OR WHAT IS MISSING IN MY CODE?
Offline
What does "don't work" mean?
IMHO, it does work as expected.
But it does not do what you did expect.
fServerDB on the server side is a REST server pointing to the data.
fRestClient is a remote access not to fServerDB, but to fRestServer.
So TSQLCPU_USER.Create(fRestClient) will return the fRestServer content, which does not have any data.
You are confusing fRestServer and fServerDB.
Your code about multi-database is just broken.
You are using an unique each service has its own instance, but use a single fServerDB global variable.
What you could do is use a fServerDB in each service instance, then publish some "Repository" methods at the service level to the clients. But you won't be able to use direct CRUD/ORM operations as you do.
But even one fServerDB per instance is IMHO not satisfactory: if two clients access the same DB, you may have troubles. So a list of databases, at fRestServer level, is IMHO preferred.
BTW, some points:
- global variables are evil - this is just a demonstration of that;
- always run your server with ENableMemoryLeakReporting := true - you will find out that your are wrongly using fServerDB global;
- your query is surprising: you are creating one instance with IDUSER>=? condition - sounds like if CreateAndFillPrepare() is the constructor to use instead;
- fRestServer does not need to have all the tables of the model, just authentication.
You need a deep review of your application architecture.
Please use some peer review.
Sounds like if Moctes has the very same request at the same time - seehttp://synopse.info/forum/viewtopic.php?pid=11899#p11899 - but is a little bit less confused than you about how to implement it?
Perhaps you may collaborate, and create a simple sample project showing us the SOA repository pattern consuming several databases? We may then add it to our official source code repository.
Good coding!
Offline
Or we may introduce ORM routing between mORMot nodes, to implement your needs directly at framework level...
See http://synopse.info/forum/viewtopic.php … 907#p11907 and feature request http://synopse.info/fossil/info/3453f314d
Offline
I did so:
Server side:
TDBServerList = class
private
FDBServers : TRawUTF8List;
FPropsList : TRawUTF8List;
public
constructor Create;
destructor Destroy;override;
procedure AddServer(const ASessionID: Cardinal;
const AServerDB: TSQLRestServerDB);
procedure RemoveServer(const ASessionID: Cardinal);
function GetServer(const ASessionID: Cardinal): TSQLRestServerDB;
procedure AddProps(const ASessionID: Cardinal;
const AProps: TSQLDBConnectionProperties);
procedure RemoveProps(const ASessionID: Cardinal);
function GetProps(const ASessionID: Cardinal): TSQLDBConnectionProperties;
end;
{ TDBServerList }
procedure TDBServerList.AddProps(const ASessionID: Cardinal;
const AProps: TSQLDBConnectionProperties);
begin
FPropsList.AddObject(IntToStr(ASessionId), AProps);
end;
procedure TDBServerList.AddServer(const ASessionID: Cardinal;
const AServerDB: TSQLRestServerDB);
begin
FDBServers.AddObject(IntToStr(ASessionId), AServerDB);
end;
constructor TDBServerList.Create;
begin
FDBServers := TRawUTF8List.Create(True);
FPropsList := TRawUTF8List.Create(True);
end;
destructor TDBServerList.Destroy;
var
v_count: Integer;
begin
{for v_count := 0 to FDBServers.Count-1 do
TSQLRestServerDB(FDBServers.Objects[v_count]).Free;}
FDBServers.Free;
{for v_count := 0 to FPropsList.Count-1 do
TSQLDBConnectionProperties(FPropsList.Objects[v_count]).Free;}
FPropsList.Free;
inherited;
end;
function TDBServerList.GetProps(const ASessionID: Cardinal): TSQLDBConnectionProperties;
begin
Result := TSQLDBConnectionProperties(FPropsList.Objects[FPropsList.IndexOf(IntToStr(ASessionId))]);
end;
function TDBServerList.GetServer(const ASessionID: Cardinal): TSQLRestServerDB;
begin
Result := TSQLRestServerDB(FDBServers.Objects[FDBServers.IndexOf(IntToStr(ASessionId))]);
end;
procedure TDBServerList.RemoveProps(const ASessionID: Cardinal);
var
v_pt: PtrInt;
begin
v_pt := FPropsList.IndexOf(IntToStr(ASessionId));
if v_pt >= 0 then
FPropsList.Delete(v_pt);
end;
procedure TDBServerList.RemoveServer(const ASessionID: Cardinal);
var
v_pt: PtrInt;
begin
v_pt := FDBServers.IndexOf(IntToStr(ASessionId));
if v_pt >= 0 then
FDBServers.Delete(v_pt);
end;
function TServiceRemoteSQL.fn_connectdb(const AServer,
AUserName,
APassword,
AServerName,
ADataBase: RawUTF8;
const AEngine: TRemoteSQLEngine;
const ASessionID: Cardinal): RawUTF8;
const // rseOleDB, rseODBC, rseOracle, rseSQlite3, rseJet, rseMSSQL, rseFirebird
TYPES: array[TRemoteSQLEngine] of TSQLDBConnectionPropertiesClass = (
TOleDBConnectionProperties,
TODBCConnectionProperties,
TSQLDBOracleConnectionProperties,
TSQLDBSQLite3ConnectionProperties,
{$ifdef WIN64}nil{$else}TOleDBJetConnectionProperties{$endif},
TOleDBMSSQL2008ConnectionProperties,
TSQLDBFireDACConnectionProperties);
var
fProps : TSQLDBConnectionProperties;
aServerDB : TSQLRestServerDB;
fModel : TSQLModel;
begin
Result := '';
if TYPES[aEngine] = nil then
begin
Result := StringToUTF8(Format(frmServAppRM.OLANG.fn_lerini('Mens',
'cpuMMensEngineNotSup',
'cpuMMensEngineNotSup') +
' ',
[GetEnumName(TypeInfo(TRemoteSQLEngine),
ord(aEngine))^]));
FreeAndNil(fProps);
end
else
begin
// Conectando Firebird
fProps := TYPES[aEngine].Create(aServerName,
aServer +
':' +
ADataBase,
AUserName,
aPassWord);
try
fProps.MainConnection.Connect;
// clonando model
fModel := TSQLModel(frmServAppRM.aModel);
// registrar tabelas do banco
VirtualTableExternalRegister(fModel,
TSQLCPU_COMPANY,
fProps,
'CPU_COMPANY');
fModel.Props[TSQLCPU_COMPANY].ExternalDB.MapField('ID','IDCOMPANY');
VirtualTableExternalRegister(fModel,
TSQLCPU_USER,
fProps,
'CPU_USER');
fModel.Props[TSQLCPU_USER].ExternalDB.MapField('ID','IDUSER');
VirtualTableExternalRegister(fModel,
TSQLCPU_PROCESS,
fProps,
'CPU_PROCESS');
fModel.Props[TSQLCPU_PROCESS].ExternalDB.MapField('ID','IDPROCESS');
VirtualTableExternalRegister(fModel,
TSQLCPU_SYSTEM,
fProps,
'CPU_SYSTEM');
fModel.Props[TSQLCPU_SYSTEM].ExternalDB.MapField('ID','IDSYSTEM');
VirtualTableExternalRegister(fModel,
TSQLCPU_SYSTEMS,
fProps,
'CPU_SYSTEMS');
fModel.Props[TSQLCPU_SYSTEMS].ExternalDB.MapField('ID','IDSYSTEMS');
VirtualTableExternalRegister(fModel,
TSQLCPU_PROGRAM,
fProps,
'CPU_PROGRAM');
fModel.Props[TSQLCPU_PROGRAM].ExternalDB.MapField('ID','IDSYSTEM');
VirtualTableExternalRegister(fModel,
TSQLCPU_FORM,
fProps,
'CPU_FORM');
fModel.Props[TSQLCPU_FORM].ExternalDB.MapField('ID','IDFORM');
VirtualTableExternalRegister(fModel,
TSQLCPU_FORMFILTER,
fProps,
'CPU_FORMFILTER');
fModel.Props[TSQLCPU_FORMFILTER].ExternalDB.MapField('ID','IDFORM').
MapField('IDFILTER','IDFILTER');
VirtualTableExternalRegister(fModel,
TSQLCPU_FORMTABSHEET,
fProps,
'CPU_FORMTABSHEET');
fModel.Props[TSQLCPU_FORMTABSHEET].ExternalDB.MapField('ID','IDFORM').
MapField('IDTABSHEET','IDTABSHEET');
VirtualTableExternalRegister(fModel,
TSQLCPU_FTSSOURCE,
fProps,
'CPU_FTSSOURCE');
fModel.Props[TSQLCPU_FTSSOURCE].ExternalDB.MapField('ID','IDFORM').
MapField('IDTABSHEET','IDTABSHEET');
VirtualTableExternalRegister(fModel,
TSQLCPU_FORMSECCION,
fProps,
'CPU_FORMSECCION');
fModel.Props[TSQLCPU_FORMSECCION].ExternalDB.MapField('ID','IDFORM').
MapField('IDTABSHEET','IDTABSHEET').
MapField('IDSECCION','IDSECCION');
VirtualTableExternalRegister(fModel,
TSQLCPU_FORMSECFIELD,
fProps,
'CPU_FORMSECFIELD');
fModel.Props[TSQLCPU_FORMSECFIELD].ExternalDB.MapField('ID','IDFORM').
MapField('IDTABSHEET','IDTABSHEET').
MapField('IDSECCION','IDSECCION').
MapField('IDFIELD','IDFIELD');
aServerDB := TSQLRestServerDB.Create(fModel, ':memory:',false); // authentication=false
aServerDB.CreateMissingTables;
// iniciar o HTTP server
frmServAppRM.aHTTPServer := TSQLHttpServer.Create(frmDMServer.fSettings.Port,
[aServerDB],
'+',
useHttpApiRegisteringURI);
frmServAppRM. aHTTPServer.AccessControlAllowOrigin := '*'; // for AJAX requests to work
// adicionando a lista
frmDMServer.fDBServerList.AddServer(ASessionID,aServerDB);
frmDMServer.fDBServerList.AddProps(ASessionID,fProps);
//aServerDB.Free;
//fModel.Free;
//fProps.Free;
except
on E: Exception do
begin
FreeAndNil(fProps);
Result := StringToUTF8(Format(frmServAppRM.OLANG.fn_lerini('Mens',
'cpuMMensConerr',
'cpuMMensConerr') +
E.Message,
[#13]));
end;
end;
end;
end;
Works.
Offline
Thanks for sharing.
Why are you mapping the fields, if you create a blank database?
Why are you using one HTTP server per instance - you could share the same TSQLHttpServer with all TSQLRestServer?
I'm still confused by your use of the same model, with the same ROOT value, for all TSQLRestServer instances: I guess the TSQLHttpServer would refuse to run more than once with the same ROOT.
Offline
Pages: 1