source upload
This commit is contained in:
Razor12911
@@ -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.
|
||||
@@ -0,0 +1,76 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="httpservice"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="httpservice.dpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="HttpService"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="httpservice"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="..\..;..\..\..;$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\..;..\..\.."/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
@@ -0,0 +1,35 @@
|
||||
/// manage (install/start/stop/uninstall) HttpService sample
|
||||
program HttpServiceSetup;
|
||||
|
||||
uses
|
||||
{$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
|
||||
Windows,
|
||||
Classes,
|
||||
SysUtils,
|
||||
SynCommons,
|
||||
SynLog,
|
||||
mORMot,
|
||||
mORMotService;
|
||||
|
||||
/// if we will run the service with administrator rights
|
||||
// - otherwise, ensure you registered the URI /root:8080
|
||||
{$R ..\..\..\VistaAdm.res}
|
||||
|
||||
const
|
||||
HTTPSERVICE_NAME = 'mORMotHttpServerService';
|
||||
HTTPSERVICE_DISPLAYNAME = 'mORMot Http Server Service';
|
||||
HTTPSERVICE_DESCRIPTION = 'This is a sample mORMot HTTP Server running as Service';
|
||||
|
||||
begin
|
||||
ServiceLog := TSQLLog; // explicitely enable logging
|
||||
ServiceLog.Family.Level := LOG_VERBOSE;
|
||||
TServiceController.CheckParameters(ExeVersion.ProgramFilePath+'HttpService.exe',
|
||||
HTTPSERVICE_NAME,HTTPSERVICE_DISPLAYNAME,HTTPSERVICE_DESCRIPTION);
|
||||
TSQLLog.Add.Log(sllTrace,'Quitting command line');
|
||||
with TServiceController.CreateOpenService('','',HTTPSERVICE_NAME) do
|
||||
try
|
||||
State; // just to log the service state after handling the /parameters
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end.
|
||||
@@ -0,0 +1,76 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="httpserviceSetup"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="httpserviceSetup.dpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="HttpServiceSetup"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="httpserviceSetup"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="..\..;..\..\..;$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="..\..;..\..\.."/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
Reference in New Issue
Block a user