134 lines
3.5 KiB
ObjectPascal
134 lines
3.5 KiB
ObjectPascal
/// implements a background Service serving HTTP pages
|
|
program HttpService;
|
|
|
|
uses
|
|
{$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
|
|
Windows,
|
|
Classes,
|
|
SysUtils,
|
|
SynCommons,
|
|
SynTable,
|
|
SynLog,
|
|
mORMotService,
|
|
mORMot,
|
|
mORMotSQLite3, SynSQLite3Static,
|
|
mORMotHTTPServer,
|
|
SampleData in '..\01 - In Memory ORM\SampleData.pas';
|
|
|
|
|
|
|
|
/// if we will run the service with administrator rights
|
|
// - otherwise, ensure you registered the URI /root:8080
|
|
{$R ..\..\..\VistaAdm.res}
|
|
|
|
type
|
|
/// class implementing the background Service
|
|
TSQLite3HttpService = class(TServiceSingle)
|
|
public
|
|
/// the associated database model
|
|
Model: TSQLModel;
|
|
/// the associated DB
|
|
DB: TSQLRestServerDB;
|
|
/// the background Server processing all requests
|
|
Server: TSQLHttpServer;
|
|
|
|
/// event triggered to start the service
|
|
// - e.g. create the Server instance
|
|
procedure DoStart(Sender: TService);
|
|
/// event triggered to stop the service
|
|
// - e.g. destroy the Server instance
|
|
procedure DoStop(Sender: TService);
|
|
|
|
/// initialize the background Service
|
|
constructor Create; reintroduce;
|
|
/// launch as Console application
|
|
constructor CreateAsConsole; reintroduce;
|
|
/// release memory
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
const
|
|
HTTPSERVICENAME = 'mORMotHttpServerService';
|
|
HTTPSERVICEDISPLAYNAME = 'mORMot Http Server Service';
|
|
|
|
|
|
{ TSQLite3HttpService }
|
|
|
|
constructor TSQLite3HttpService.Create;
|
|
begin
|
|
inherited Create(HTTPSERVICENAME,HTTPSERVICEDISPLAYNAME);
|
|
TSQLLog.Family.Level := LOG_VERBOSE;
|
|
TSQLLog.Family.PerThreadLog := ptIdentifiedInOnFile;
|
|
TSQLLog.Enter(self);
|
|
OnStart := {$ifdef FPC}@{$endif}DoStart;
|
|
OnStop := {$ifdef FPC}@{$endif}DoStop;
|
|
OnResume := {$ifdef FPC}@{$endif}DoStart; // trivial Pause/Resume actions
|
|
OnPause := {$ifdef FPC}@{$endif}DoStop;
|
|
end;
|
|
|
|
constructor TSQLite3HttpService.CreateAsConsole;
|
|
begin
|
|
// manual switch to console mode
|
|
AllocConsole;
|
|
// define the log level
|
|
with TSQLLog.Family do begin
|
|
Level := LOG_VERBOSE;
|
|
EchoToConsole := LOG_STACKTRACE;
|
|
end;
|
|
end;
|
|
|
|
destructor TSQLite3HttpService.Destroy;
|
|
begin
|
|
TSQLLog.Enter(self);
|
|
if Server<>nil then
|
|
DoStop(nil); // should not happen
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TSQLite3HttpService.DoStart(Sender: TService);
|
|
begin
|
|
TSQLLog.Enter(self);
|
|
if Server<>nil then
|
|
DoStop(nil); // should never happen
|
|
Model := CreateSampleModel;
|
|
DB := TSQLRestServerDB.Create(Model,ChangeFileExt(ExeVersion.ProgramFileName,'.db3'));
|
|
DB.CreateMissingTables;
|
|
Server := TSQLHttpServer.Create('8080',[DB],'+',useHttpApiRegisteringURI);
|
|
TSQLLog.Add.Log(sllInfo,'Server % started by %',[Server.HttpServer,Server]);
|
|
end;
|
|
|
|
procedure TSQLite3HttpService.DoStop(Sender: TService);
|
|
begin
|
|
TSQLLog.Enter(self);
|
|
if Server=nil then
|
|
exit;
|
|
TSQLLog.Add.Log(sllInfo,'Server % stopped by %',[Server.HttpServer,Server]);
|
|
FreeAndNil(Server);
|
|
FreeAndNil(DB);
|
|
FreeAndNil(Model);
|
|
end;
|
|
|
|
begin
|
|
if (ParamCount<>0) and
|
|
(SameText(ParamStr(1),'-c') or SameText(ParamStr(1),'/c')) then
|
|
with TSQLite3HttpService.CreateAsConsole do
|
|
try
|
|
DoStart(nil);
|
|
TextColor(ccLightGray);
|
|
writeln(#10'Background server is running.'#10);
|
|
writeln('Press [Enter] to close the server.'#10);
|
|
ConsoleWaitForEnterKey; // ReadLn if you do not use main thread execution
|
|
exit;
|
|
finally
|
|
Free;
|
|
end else
|
|
with TSQLite3HttpService.Create do
|
|
try
|
|
// launches the registered Services execution = do all the magic
|
|
ServicesRun;
|
|
finally
|
|
Free;
|
|
end;
|
|
end.
|