sample 10 - background http service

esmondb · 2012-04-10 10:49:13

I'm having trouble running sample 10 - background http service. It seems to install ok, coming up in the list of services in the Computer Management Control panel, but trying to start it gives this error:

Could not start the mORMot Server Service service on Local Computer.
Error 1053: The service did not respond to the start or control request in a timely fashion.

Any suggestions on what could be going wrong? I'm using Delphi 2007 and get the problem on both windows XP and 7.

Thanks

Leander007 · 2012-04-10 11:08:40

This was already discussed and I did provide solution. I think Arnaud missed this answer and did not yet integrate this in source.

esmondb · 2012-04-10 12:04:34

Thanks, that solved it. I should have checked the older posts.

ab · 2012-04-10 13:18:13

I effectively did forget to integrate this in Sample source code.

This is now corrected.
See http://synopse.info/fossil/info/215e44e66b

Thanks

Leander007 · 2012-04-10 21:07:54

Arnaud, I saw your corrections of code, but this was not enough in my case (and I think in many other cases too, newer compilers).
I don't know why, but global constants (line 50) SERVICENAME and SERVICEDISPLAYNAME where not set (they were blank '') on class creation, so I moved them to the class section as already discussed and this works well (they are set as expected):

TSQLite3HttpService = class(TService)
  public
    const
    SERVICENAME = 'mORMotHttpServerService';
    SERVICEDISPLAYNAME = 'mORMot Http Server Service';
  var
(...)
if param='/install' then
          TServiceController.CreateNewService('','',TSQLite3HttpService.SERVICENAME,
              TSQLite3HttpService.SERVICEDISPLAYNAME, paramstr(0),'','','','',

Last edited by Leander007 (2012-04-10 21:27:50)

ab · 2012-04-11 07:30:50

In fact, the error was that there was already a property of TService named SERVICENAME (ServiceName).

I renamed those, and it worked as expected:

const
  HTTPSERVICENAME = 'mORMotHttpServerService';
  HTTPSERVICEDISPLAYNAME = 'mORMot Http Server Service';

See http://synopse.info/fossil/info/13be8e5a4c

Using const within class is not compatible with all versions of Delphi handled by the framework.

In fact, the trick of ServiceControlHandler() with a global was not even necessary.

Leander007 · 2012-04-11 07:34:58

ab wrote:

In fact, the error was that there was already a property of TService named SERVICENAME (ServiceName).

I didn't notice this . For me it looked better anyway, because I don't care about old compilers .

ab wrote:

In fact, the trick of ServiceControlHandler() with a global was not even necessary.

For me it was necessary because stopping of service didn't worked well (didn't worked at all) as I said already.

ab · 2012-04-11 07:49:06

Stopping the service was working as expected in my tests.

Leander007 · 2012-04-11 08:30:53

This is the most "dangerous case" when something is working in one situation and not for other.
Implementation with pure pascal (no assembler magic) is just playing safe and works in all cases.

Leander007 · 2012-04-11 08:53:34

As I see you reverted again to the "unsafe version" (my opinion, because your example app and my example app without global assignment do not work properly on my computer).
Definitely some user will ask for solution again.

It would be better to at least put the safe version code in comments (e.g. If it does not work uncomment this...).

Last edited by Leander007 (2012-04-11 08:57:00)

lestat · 2012-04-11 15:18:54

Hi,
i have a service running using the jedi library svcmgr

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  SynCommons, SQLite3Commons, StrUtils, FileServer;
  
  type
  TMyService = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  public
    function GetServiceController: TServiceController; override;
  end;

var
  MyService: TMyService;
implementation

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  MyService.Controller(CtrlCode);
end;

function TMyService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TMyService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Server := TFileServer.Create('localhost','8080','c:\mydb.db');
end;

do you think it's a correct implementation of the service or something can go wrong?

tanx

Last edited by lestat (2012-04-11 15:34:31)

ab · 2012-04-11 15:32:04

I do not understand what is the content of your TFileServer class.
Is the Server instance released on service stop?
etc...

But the general implementation sounds fine.
You can embed a mORMot HTTP server in service, whatever your service implementation uses.
Our Services classes are just one proposal. mORMot is decoupled from the Windows service part.

lestat · 2012-04-11 15:40:54

TFileServer is defined in the unit fileserver.pas

esmondb · 2012-04-12 10:29:35

Here's another delphi service implementation based on an example I found on the web. servFunctions.pas contains a TSQLRestServerDB derived class and the model. Works without a problem but not tested much.

{
  NT Service  model based completely on API calls. Version 0.1
  Inspired by NT service skeleton from Aphex
  Adapted by Runner
}
 
program myserv;
 
{$APPTYPE CONSOLE}
 
uses
  Windows,
  SysUtils,
  WinSvc,
  SQLite3,
  SQLite3Commons,
  SynCommons,
  SQLite3HttpServer,
  SynCrtSock,
  servFunctions in 'servFunctions.pas';

const
  ServiceName     = 'MyServ';
  DisplayName     = 'My Server';
  NUM_OF_SERVICES = 2;
 
var
  ServiceStatus : TServiceStatus;
  StatusHandle  : SERVICE_STATUS_HANDLE;
  ServiceTable  : array [0..NUM_OF_SERVICES] of TServiceTableEntry;
  Stopped       : Boolean;
  Paused        : Boolean;

var
  ghSvcStopEvent: Cardinal;

 
procedure ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD);
begin
  // fill in the SERVICE_STATUS structure.
  ServiceStatus.dwCurrentState := dwCurrentState;
  ServiceStatus.dwWin32ExitCode := dwWin32ExitCode;
  ServiceStatus.dwWaitHint := dwWaitHint;

  case dwCurrentState of
    SERVICE_START_PENDING: ServiceStatus.dwControlsAccepted := 0;
    else
      ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP;
  end;
 
  case (dwCurrentState = SERVICE_RUNNING) or (dwCurrentState = SERVICE_STOPPED) of
    True: ServiceStatus.dwCheckPoint := 0;
    False: ServiceStatus.dwCheckPoint := 1;
  end;

  // Report the status of the service to the SCM.
  SetServiceStatus(StatusHandle, ServiceStatus);
end;
 
procedure MainProc;
begin
  // we have to do something or service will stop
  ghSvcStopEvent := CreateEvent(nil, True, False, nil);
 
  if ghSvcStopEvent = 0 then begin
    ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
    Exit;
  end;
 
  // Report running status when initialization is complete.
  ReportSvcStatus( SERVICE_RUNNING, NO_ERROR, 0 );

  Model := CreateModel;
  DB := TEsServiceServer.Create(Model,'C:\DATA\ew3.db3',true);
  DB.CreateMissingTables(0);
  Server := TSQlite3HttpServer.Create('80',[DB]);
  THttpApiServer(Server.HttpServer).AddUrl('','80',false,'+');
  try
  // Perform work until service stops.
  while True do begin
    // Check whether to stop the service.
    WaitForSingleObject(ghSvcStopEvent, INFINITE);
    ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
    
    Exit;
  end;
  finally
    Server.Free;
    DB.Free;
    Model.Free;
  end;
end;
 
procedure ServiceCtrlHandler(Control: DWORD); stdcall;
begin
  case Control of
    SERVICE_CONTROL_STOP:
      begin
        Stopped := True;
        SetEvent(ghSvcStopEvent);
        ServiceStatus.dwCurrentState := SERVICE_STOP_PENDING;
        SetServiceStatus(StatusHandle, ServiceStatus);
      end;
    SERVICE_CONTROL_PAUSE:
      begin
        Paused := True;
        ServiceStatus.dwcurrentstate := SERVICE_PAUSED;
        SetServiceStatus(StatusHandle, ServiceStatus);
      end;
    SERVICE_CONTROL_CONTINUE:
      begin
        Paused := False;
        ServiceStatus.dwCurrentState := SERVICE_RUNNING;
        SetServiceStatus(StatusHandle, ServiceStatus);
      end;
    SERVICE_CONTROL_INTERROGATE: SetServiceStatus(StatusHandle, ServiceStatus);
    SERVICE_CONTROL_SHUTDOWN: Stopped := True;
  end;
end;
 
procedure RegisterService(dwArgc: DWORD; var lpszArgv: PChar); stdcall;
begin
  ServiceStatus.dwServiceType := SERVICE_WIN32_OWN_PROCESS;
  ServiceStatus.dwCurrentState := SERVICE_START_PENDING;
  ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE;
  ServiceStatus.dwServiceSpecificExitCode := 0;
  ServiceStatus.dwWin32ExitCode := 0;
  ServiceStatus.dwCheckPoint := 0;
  ServiceStatus.dwWaitHint := 0;
 
  StatusHandle := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
 
  if StatusHandle <> 0 then begin
    ReportSvcStatus(SERVICE_RUNNING, NO_ERROR, 0);
    try
      Stopped := False;
      Paused  := False;
      MainProc;
    finally
      ReportSvcStatus(SERVICE_STOPPED, NO_ERROR, 0);
    end;
  end;
end;
 
procedure UninstallService(const ServiceName: PChar; const Silent: Boolean);
const
  cRemoveMsg = 'Your service was removed sucesfuly!';
var
  SCManager: SC_HANDLE;
  Service: SC_HANDLE;
begin
  SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SCManager = 0 then
    Exit;
  try
    Service := OpenService(SCManager, ServiceName, SERVICE_ALL_ACCESS);
    ControlService(Service, SERVICE_CONTROL_STOP, ServiceStatus);
    DeleteService(Service);
    CloseServiceHandle(Service);
    if not Silent then
      MessageBox(0, cRemoveMsg, ServiceName, MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
  finally
    CloseServiceHandle(SCManager);
    //AfterUninstall;
  end;
end;
 
procedure InstallService(const ServiceName, DisplayName, LoadOrder: PChar;
  const FileName: string; const Silent: Boolean);
const
  cInstallMsg = 'Your service was Installed sucesfuly!';
  cSCMError = 'Error trying to open SC Manager';
var
  SCMHandle  : SC_HANDLE;
  SvHandle   : SC_HANDLE;
begin
  SCMHandle := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
 
  if SCMHandle = 0 then begin
    MessageBox(0, cSCMError, ServiceName, MB_ICONERROR or MB_OK or MB_TASKMODAL or MB_TOPMOST);
    Exit;
  end;

  THttpApiServer.AddUrlAuthorize('','8080',false,'+');

  try
    SvHandle := CreateService(SCMHandle,
                              ServiceName,
                              DisplayName,
                              SERVICE_ALL_ACCESS,
                              SERVICE_WIN32_OWN_PROCESS,
                              SERVICE_AUTO_START,
                              SERVICE_ERROR_IGNORE,
                              pchar(FileName),
                              LoadOrder,
                              nil,
                              nil,
                              nil,// pchar('NT AUTHORITY\NetworkService'),  // NT AUTHORITY\NetworkService
                              nil);
    CloseServiceHandle(SvHandle);
 
    if not Silent then
      MessageBox(0, cInstallMsg, ServiceName, MB_ICONINFORMATION or MB_OK or MB_TASKMODAL or MB_TOPMOST);
  finally
    CloseServiceHandle(SCMHandle);
  end;
end;
 
procedure WriteHelpContent;
begin
  WriteLn('To install your service please type  /install');
  WriteLn('To uninstall your service please type  /remove');
  WriteLn('For help please type  /? or /h');
end;
 
begin
  if (ParamStr(1) = '/h') or (ParamStr(1) = '/?') then
    WriteHelpContent
  else if ParamStr(1) = '/install' then
    InstallService(ServiceName, DisplayName, 'System Reserved', ParamStr(0), ParamStr(2) = '/s')
  else if ParamStr(1) = '/remove' then
    UninstallService(ServiceName, ParamStr(2) = '/s')
  else if ParamCount = 0 then begin
    //OnServiceCreate;
 
    ServiceTable[0].lpServiceName := ServiceName;
    ServiceTable[0].lpServiceProc := @RegisterService;
    ServiceTable[1].lpServiceName := nil;
    ServiceTable[1].lpServiceProc := nil;
 
    StartServiceCtrlDispatcher(ServiceTable[0]);
  end else
    WriteLn('Wrong argument!');
end.

Leander007 · 2012-04-12 10:57:28

This is more or less the same stuff (about core functionality) as Arnaud implementation of service when you use global assign of service handler (what I explained in previous posts).
But this is done in procedural way.
Nice for quick and dirty job, but I liked more when this is wrapped (and easily enhanced) in class .

mORMot Open Source

#1 2012-04-10 10:49:13

sample 10 - background http service

#2 2012-04-10 11:08:40

Re: sample 10 - background http service

#3 2012-04-10 12:04:34

Re: sample 10 - background http service

#4 2012-04-10 13:18:13

Re: sample 10 - background http service

#5 2012-04-10 21:07:54

Re: sample 10 - background http service

#6 2012-04-11 07:30:50

Re: sample 10 - background http service

#7 2012-04-11 07:34:58

Re: sample 10 - background http service

#8 2012-04-11 07:49:06

Re: sample 10 - background http service

#9 2012-04-11 08:30:53

Re: sample 10 - background http service

#10 2012-04-11 08:53:34

Re: sample 10 - background http service

#11 2012-04-11 15:18:54

Re: sample 10 - background http service

#12 2012-04-11 15:32:04

Re: sample 10 - background http service

#13 2012-04-11 15:40:54

Re: sample 10 - background http service

#14 2012-04-12 10:29:35

Re: sample 10 - background http service

#15 2012-04-12 10:57:28

Re: sample 10 - background http service

Board footer