Windows Services in Delphi with database connection - database

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.

Answer 2

In your service code :
- you can try to add Dependencies on your Firebird Service
- you can increase WaitHint
if it still not work : you can start as automatic but "Delayed"

Answer 3

I found it otherwise to solve, however, I thank everyone for the tips, because in a timely manner you will make improvements to my service.
The solution was to extend the service startup timeout through the Windows ServicesPipeTimeout registry key.
For my case it worked perfectly.
I increased the value of ServicesPipeTimeout to 120000 (2 minutes).
By default the value is 30000 (30 seconds) or less.
To manual Edit:
1) Open the Windows Regedit App;
2) Locate and then click the following registry subkey:
  - HKEY_LOCAL_MACHINE \ SYSTEM \ CurrentControlSet \ Control
In the panel values, locate the ServicesPipeTimeout entry.
** Note **:
If the ServicesPipeTimeout entry does not exist, you must create it. To do
this, follow these steps:
 - On the Edit menu, point to New, and then click DWORD Value.
 - Type ServicesPipeTimeout, and then press ENTER.
3) Right-click ServicesPipeTimeout, and then click Modify.
4) Click Decimal, type 120000, and then click OK.
** 120000 miliseconds = 2 minutes
5) Restart the computer.
In Delphi (Sample registry value):
Procedure TForm3.JBButton3Click(Sender: TObject);
Const
CKeyConfigTimeout = 'SYSTEM\CurrentControlSet\Control';
CValueConfigTimeout = 'ServicesPipeTimeout';
Var
LReg: TRegistry;
Begin
LReg := TRegistry.Create;
Try
LReg.RootKey := HKEY_LOCAL_MACHINE;
LReg.OpenKey(CKeyConfigTimeout, False);
LReg.WriteInteger(CValueConfigTimeout, 120000);
Finally
LReg.CloseKey;
FreeAndNil(LReg);
End;
End;
Note: The delphi application with the registry update code needs to run in administrator mode for Windows Vista / Server or Superior versions;