Hi!
We are trying to create an APACHE based Echo Server but we are having some problems.
At first we create a WebBroker project for APACHE 2.4, and follow the documentation of TMS Sparkle, but it crash when we retrieve the NodeManager and ask if it’s defined.
We take references from TMS Echo Server demo.
Here is the code.
wuModule:
unit wuModule;
interface
uses System.SysUtils, System.Classes, Web.HTTPApp,
Sparkle.WebBroker.Server,
Sparkle.WebBroker.Adapter,
Sparkle.HttpServer.Module,
Echo.Server, Echo.Main, Echo.Entities,
Aurelius.Drivers.Interfaces,
Aurelius.Engine.DatabaseManager,
uConnectionModule,
Common,
Sparkle.Sys.Timer,
XData.Server.Module,
Aurelius.Json.DataSnap,
System.JSON,
Server,
FireDAC.UI.Intf,
FireDAC.ConsoleUI.Wait,
FireDAC.Stan.Intf,
FireDAC.Comp.UI,
FireDAC.VCLUI.Wait;
type
TWebModule1 = class(TWebModule)
FDGUIxWaitCursor1: TFDGUIxWaitCursor;
procedure WebModule1DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure WebModuleException(Sender: TObject; E: Exception;
var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
procedure AEchoRoute(Log: TEchoLog; Node: TEchoNode; var Route :Boolean);
procedure Log( sLinea : string );
var
WebModuleClass: TComponentClass = TWebModule1;
implementation
{%CLASSGROUP 'System.Classes.TPersistent'}
{$R *.dfm}
procedure Log( sLinea : string );
var
A : TextFile;
begin
AssignFile(A, 'C:\SEGURO\Test.txt');
if FileExists('C:\SEGURO\Test.txt') then
Append(A)
else
ReWrite(A);
WriteLn(A, DateTimeToStr(Now) + ' ' + sLinea);
CloseFile(A);
end;
procedure AEchoRoute(Log: TEchoLog; Node: TEchoNode;
var Route: Boolean);
var
Deserializer : TDataSnapJsonDeserializer;
Factura : Tocfacpro;
DetFact : TocFacProArt;
JsonValue: TJsonValue;
begin
Deserializer := TDataSnapJsonDeserializer.Create;
JSonValue := TJSonValue.Create;
JSonValue := TJSonObject.ParseJSONValue(Log.Entity);
if SameText(Log.EntityClass, 'Common.Tocfacpro') then
Factura := Deserializer.FromJson<Tocfacpro>(JSonValue) else
begin
if SameText(Log.EntityClass, 'Common.Tocfacproart') then
DetFact := Deserializer.FromJson<Tocfacproart>(JSonValue);
end;
if SameText(Log.EntityClass, 'Common.Tocfacpro') then
begin
Route := (Pos(Factura.Almacen.ToString, Node.Id)) > 0;
end
else if SameText(Log.EntityClass, 'Common.Tocfacproart') then
begin
Route := (Pos(DetFact.Almacen.ToString, Node.Id)) > 0;
end
else
Route := True;
end;
procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
Adapter: IWebBrokerAdapter;
begin
Adapter := TWebBrokerAdapter.Create(Request, Response);
ApacheServer.DispatchRequest(Adapter);
end;
procedure TWebModule1.WebModuleException(Sender: TObject; E: Exception;
var Handled: Boolean);
begin
Log(E.Message);
end;
initialization
StartServer
finalization
StopServer;
Server unit:
unit Server;
interface
uses
uConnectionModule,
Aurelius.Drivers.Interfaces,
Aurelius.Engine.DatabaseManager,
XData.Server.Module,
System.SysUtils,
Sparkle.HttpSys.Server,
Sparkle.HttpServer.Context,
Sparkle.HttpServer.Module,
Sparkle.Sys.Timer,
Sparkle.WebBroker.Server,
Sparkle.WebBroker.Adapter,
Echo.Server, Echo.Main;
procedure StartServer;
procedure StopServer;
var
ApacheServer: TWebBrokerServer;
Echo: TEcho;
Timer: TSparkleTimer;
implementation
uses
System.IOUtils,
wuModule;
procedure StartServer;
var
EchoModule: TEchoServerModule;
Pool: IDBConnectionPool;
NodeManager: IEchoNodeManager;
Conn: IDBConnection;
dmConnectionModule : TConnectionModule;
begin
try
if Assigned(ApacheServer) then
Exit;
Log('Creo el servidor');
ApacheServer := TWebBrokerServer.Create;
Log('DataModule creado, creo Pool');
dmConnectionModule := TConnectionModule.Create(nil);
Pool := dmConnectionModule.CreatePool(1000);
Log('Pool creada, creo EchoModule');
EchoModule := TEchoServerModule.Create(
'http://localhost:2001/tms/echo', Pool
);
Log('EchoModule creado, añado EchoModule al Dispatcher');
ApacheServer.Dispatcher.AddModule(EchoModule);
Log('Añadido EchoModule, creo Echo');
Echo := TEcho.Create(Pool);
Log('Echo creado, obtengo Conn');
// Create regular tables and fields of the application
Conn := Echo.Pool.GetConnection;
Log('Conn correcta, actualizo estructura BBDD');
//CRASH!
//First CRASH here when apache loads the module
//If i comment his group then crash down
TDatabaseManager.Update(Conn);
Log('Estructura BBDD modificado, Mapping ECHO');
// Create tables and fields for TMS Echo usage
TDatabaseManager.Update(Conn, TEcho.Explorer);
Log('Mapping ECHO OK, Con = nil');
Conn := nil; // Free reference
Log('Obtengo NodeManager');
// Get the NodeManager instance
NodeManager := Echo.GetNodeManager;
//Log('Compruebo si ya estoy registrado como UNIT SERVER');
if not Assigned(NodeManager) then
Log('No rula NODEMANAGER');
//If i comment the TDatabaseManager, then crash here...
Log(NodeManager.SelfNode.Name);
// If SelfNode is already defined, no need to define it again
if not Assigned(NodeManager.SelfNode) then
begin
// SelfNode is not defined, so let's create a Node instance with the name
// specified by the DBName property ("client1", "client2", "server" in the case
// of our demo application. It can be any string value, it just needs
// to be unique among all other databases being replicated.
Log('Me registro como SERVER');
NodeManager.CreateNode('server');
// Now define this newly created node as the SelfNode
Log('Pongo como SelfNode -> SERVER');
NodeManager.DefineSelfNode('server');
end;
Log('Inicializo TIMER');
Timer := TSparkleTimer.Create(
procedure(Echo: TObject)
begin
TEcho(Echo).BatchLoad;
TEcho(Echo).Route(AEchoRoute);
end,
Echo, 2000, TTimerType.Periodic);
except
on E : Exception do Log(E.Message);
end;
end;
procedure StopServer;
begin
FreeAndNil(ApacheServer);
FreeAndNil(Echo);
FreeAndNil(Timer);
end;
initialization
ApacheServer := nil;
Echo := nil;
Timer := nil;
finalization
StopServer;
end.
uConnectionModule unit:
unit uConnectionModule;
interface
uses
Aurelius.Drivers.Interfaces,
Aurelius.SQL.MSSQL,
Aurelius.Schema.MSSQL,
Aurelius.Drivers.FireDac,
System.SysUtils, System.Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option,
FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,
FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MSSQL,
FireDAC.Phys.MSSQLDef, FireDAC.FMXUI.Wait, Data.DB, FireDAC.Comp.Client,
FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.DApt,
FireDAC.Comp.DataSet, FireDAC.Comp.UI, FireDAC.ConsoleUI.Wait,
FireDAC.VCLUI.Wait;
type
TConnectionModule = class(TDataModule)
oConn2: TFDConnection;
qyFlag: TFDQuery;
FDConnection1: TFDConnection;
FDGUIxWaitCursor1: TFDGUIxWaitCursor;
procedure DataModuleCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function CreateConnection: IDBConnection;
function CreateFactory: IDBConnectionFactory;
function CreatePool(APoolSize: Integer): IDBConnectionPool;
end;
implementation
{%CLASSGROUP 'FMX.Controls.TControl'}
{$R *.dfm}
uses
XData.Aurelius.ConnectionPool,
Aurelius.Drivers.Base;
{ TConnectionModule }
function TConnectionModule.CreateConnection: IDBConnection;
begin
Result := TFireDacConnectionAdapter.Create(oConn2, False);
end;
function TConnectionModule.CreateFactory: IDBConnectionFactory;
begin
Result := TDBConnectionFactory.Create(
function: IDBConnection
begin
Result := CreateConnection;
end
);
end;
function TConnectionModule.CreatePool(
APoolSize: Integer): IDBConnectionPool;
begin
Result := TDBConnectionPool.Create(APoolSize, CreateFactory);
end;
procedure TConnectionModule.DataModuleCreate(Sender: TObject);
begin
oConn2 := TFDConnection.Create(nil);
oConn2.LoginPrompt := False;
oConn2.ResourceOptions.SilentMode := True;
oConn2.Params.Values['Database'] := 'TIENDA';
oConn2.Params.Values['DriverID'] := 'MSSQL';
oConn2.Params.Values['OSAutent'] := 'NO';
oConn2.Params.Values['User_name'] := 'SA';
oConn2.Params.Values['Password'] := '';
oConn2.Params.Values['Server'] := 'TIENDAS';
end;
Any idea what i'm doing wrong?