Windows Services in Delphi with database connection

Question

I would just like a tip about a situation.

I created a Windows service that does the task management of my application.

The service connect to the database (Firebird) and call a component that does the task management.

The process works fine, however, in Windows 10 the service does not start automatically after the computer is restarted. In other versions of Windows everything works perfectly. In testing, I have identified that if I comment on the method that calls the execution of the tasks, the service usually starts on Windows 10.

Procedure TDmTaskService.ServiceExecute(Sender: TService);
Begin
  Inherited;

  While Not Terminated Do
  Begin
    //Process;
    Sleep(3000);
    ServiceThread.ProcessRequests(False);
  End;

End;

The problem is that nothing exception is generated in component or service.

By analyzing the Windows Event Monitor, I have identified that the error that occurred with my service is Timeout, in which case the service was unable to connect to the service manager within the time limit. No more exceptions are generated.

Would anyone have any about Windows Services made in Delphi that connect to database?

Example of my source code:

**Base class:**

unit UnTaskServiceDmBase;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;

type
  TDmTaskServicosBase = class(TService)
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  DmTaskServiceBase: TDmTaskServicosBase;

implementation

{$R *.DFM}

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

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

end.    

**Service Class:**    

Unit UnTaskServiceDm;

    Interface

    Uses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,

      UnJBTask,
      UnJBReturnTypes,
      UnJBUtilsFilesLog,
      UnTaskServiceDmConfig,
      UnTaskServiceDmConnection,
      ExtCtrls,
      IniFiles;

    Type
      TDmTaskService = Class(TDmTaskServicosBase)
        Procedure ServiceExecute(Sender: TService);
        Procedure ServiceCreate(Sender: TObject);
        Procedure ServiceStop(Sender: TService; Var Stopped: Boolean);
      Private
        FTaskServiceConfig: TDmTaskServiceConfig;
        FStatus: TResultStatus;
        FDmConnection: TDmTaskServiceConnection;
        FJBTask: TJBTask;
        FLog: TJBUtilsFilesLog;

        Procedure ExecuteTasksSchedule;
        Procedure UpdateServiceInformation;
        Procedure Process;
        Procedure UpdateConnection;
      Public
        Function GetServiceController: TServiceController; Override;
      End;


    Implementation

    {$R *.DFM}

    Procedure ServiceController(CtrlCode: DWord); Stdcall;
    Begin
      DmTaskService.Controller(CtrlCode);
    End;

    Procedure TDmTaskService.UpdateConnection;
    Begin

      Try
        FDmConnection.SqcCon.Connected := False;
        FDmConnection.SqcCon.Connected := True;

        FLog.Adicionar('Conexão com banco restabelecida.');
        FLog.FinalizarLog;
      Except

        On E: Exception Do
        Begin
          FLog.Adicionar('Erro ao restabelecer conexão com o banco de dados.' +
            sLineBreak + sLineBreak + E.Message);
          FLog.FinalizarLog;
        End;

      End;

    End;

    Procedure TDmTaskService.UpdateServiceInformation;
    Begin
      Inherited;

      Try

        Try
          FTaskServiceConfig.Load;

          FLog.Adicionar('Dados registro serviço.');
          FLog.Adicionar('Nome: ' + FTaskServiceConfig.ServiceName);
          FLog.Adicionar('Descrição: ' + FTaskServiceConfig.ServiceDescription);

          If (FTaskServiceConfig.ServiceName <> EmptyStr) And
            (FTaskServiceConfig.ServiceDescription <> EmptyStr) Then
          Begin
            Name := FTaskServiceConfig.ServiceName ;
            DisplayName := FTaskServiceConfig.ServiceDescription;
          End;

          FTaskServiceConfig.Close;

        Except

          On E: Exception Do
          Begin
            FLog.Adicionar('Erro adicionar dados registro serviço.');
            FLog.Adicionar('Erro ocorrido: ' + sLineBreak + sLineBreak + E.Message);
          End;

        End;

      Finally
        FLog.Adicionar('Name: ' + Name);
        FLog.Adicionar('DisplayName: ' + DisplayName);
        FLog.FinalizarLog;
      End;

    End;

    Procedure TDmTaskService.Process;
    Begin

      Try

        If FDmConnection.SqcCon.Connected Then
        Begin

            ExecuteTasksSchedule;

        End
        Else
          UpdateConnection;

      Except

        On E: Exception Do
        Begin

          FLog.Adicionar('Ocorreu um erro ao checar as tarefas.' + sLineBreak +
            'Erro ocorrido: ' + sLineBreak + E.Message);
          FLog.FinalizarLog;

          UpdateConnection;

        End;

      End;

    End;

    Procedure TDmTaskService.ExecutarTarefasAgendadas;
    Begin

      If FJBTask.ExistTaskDelayed Then
      Begin

        Try
          FJBTask.ExecuteTasks;
        Except

          On E: Exception Do
          Begin
            FLog.Adicionar('Ocorreu um erro ao executar as tarefas agendadas.' +
              sLineBreak + 'Erro ocorrido: ' + sLineBreak + E.Message);
            FLog.FinalizarLog;

            UpdateConnection;
          End;

        End;

      End;

    End;

    Function TDmTaskService.GetServiceController: TServiceController;
    Begin
      Result := ServiceController;
    End;

    Procedure TDmTaskService.ServiceCreate(Sender: TObject);
    Begin
      Inherited;

      Try
        FLog := TJBUtilsFilesLog.Create;
        FLog.ArquivoLog := IncludeTrailingPathDelimiter(FLog.LogFolder) + 'TaksService.log';

        FDmConnection := TDmTaskServiceConexao.Create(Self);
        FDmConnection.Log := FLog;

        FJBTask := TJBTarefa.Create(Self);
        FJBTask.SQLConnection := FDmConnection.SqcConexao;

        FTaskServiceConfig := TDmTaskServiceConfig.Create(Self);
        FTaskServiceConfig.SQLConnection := FDmConnection.SqcConexao;

        FStatus := FDmConnection.ConfigurouConexao;

        If FStatus.ResultValue Then
        Begin
          UpdateServiceInformation;
        End
        Else
        Begin
          FLog.Adicionar(FStatus.MessageOut);
          FLog.FinalizarLog;
        End;

      Except

        On E: Exception Do
        Begin
          FLog.Adicionar('Não foi possível iniciar o serviço.' + sLineBreak +
            'Erro ocorrido: ' + sLineBreak + sLineBreak + E.Message);
          FLog.FinalizarLog;
          Abort;
        End;

      End;

    End;

    Procedure TDmTaskService.ServiceExecute(Sender: TService);
    Begin
      Inherited;

      While Not Terminated Do
      Begin
        Process;
        Sleep(3000);
        ServiceThread.ProcessRequests(False);
      End;

    End;

    Procedure TDmTaskService.ServiceStop(Sender: TService; Var Stopped: Boolean);
    Begin
      Inherited;

      If Assigned(FDmConnection) Then
      Begin

        FLog.Adicionar('Finalizando serviço.');
        FLog.Adicionar('Fechando conexão.');
        Try
          FDmConnection.SqcConexao.Close;
        Finally
          FLog.FinalizarLog;
        End;

      End;

    End;

    End.

Answer 1

By analyzing the Windows Event Monitor, I have identified that the error that occurred with my service is Timeout, in which case the service was unable to connect to the service manager within the time limit. No more exceptions are generated.

Do not connect to your database, or do any other lengthy operations, in the TService.OnCreate event. Such logic belongs in the TService.OnStart event instead. Or better, create a worker thread for it, and then start that thread in the TService.OnStart event and terminate it in the TService.On(Stop|Shutdown) events.

When the SCM starts your service process, it waits for only a short period of time for the new process to call StartServiceCtrlDispatcher(), which connects the process to the SCM so it can start receiving service requests. StartServiceCtrlDispatcher() is called by TServiceApplication.Run() after all TService objects have been fully constructed first. Since the OnCreate event is called while your process is trying to initialize itself, before StartServiceCtrlDispatcher() is called, any delay in service construction can cause the SCM to timeout and kill the process.

Also, you should get rid of your TService.OnExecute event handler completely. You shouldn't even be using that event at all, and what you currently have in it is no better than what TService already does internally when OnExecute is not assigned any handler.