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.
