source upload

contrib/mORMot/SQLite3/Samples/10 - Background Http service/httpservice.dpr

@@ -0,0 +1,133 @@
+/// 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.