Windows Delphi 中的服务具有数据库连接
Windows Services in Delphi with database connection
我想知道一个情况。
我创建了一个 Windows 服务来管理我的应用程序的任务。
服务连接到数据库 (Firebird) 并调用执行任务管理的组件。
进程运行正常，但是，在Windows10 中，服务不会在计算机重新启动后自动启动。在 Windows 的其他版本中，一切都完美无缺。在测试中，我发现如果我评论调用任务执行的方法，该服务通常会在 Windows 10.
开始
Procedure TDmTaskService.ServiceExecute(Sender: TService);
Begin
Inherited;
While Not Terminated Do
Begin
//Process;
Sleep(3000);
ServiceThread.ProcessRequests(False);
End;
End;
问题是在组件或服务中没有产生任何异常。
通过分析 Windows 事件监视器，我确定我的服务发生的错误是超时，在这种情况下，服务无法在时限内连接到服务管理器。不再生成异常。
有人会在 Delphi 中提供连接到数据库的 Windows 服务吗？
我的源代码示例：
**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.
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.
不要在 TService.OnCreate 事件中连接到您的数据库，或执行任何其他冗长的操作。这种逻辑属于 TService.OnStart 事件。或者更好的是，为它创建一个工作线程，然后在 TService.OnStart 事件中启动该线程并在 TService.On(Stop|Shutdown) 事件中终止它。
当 SCM 启动您的服务进程时，它只会等待一小段时间让新进程调用 StartServiceCtrlDispatcher()，这会将进程连接到 SCM，以便它可以开始接收服务请求。 StartServiceCtrlDispatcher() 由 TServiceApplication.Run() 在所有 TService 对象首先完全构建之后调用。由于 OnCreate 事件是在您的进程尝试初始化自身时调用的，因此在调用 StartServiceCtrlDispatcher() 之前，服务构建中的任何延迟都可能导致 SCM 超时并终止进程。
此外，您应该完全摆脱 TService.OnExecute 事件处理程序。您甚至根本不应该使用该事件，并且当 OnExecute 未分配任何处理程序时，您当前拥有的内容并不比 TService 内部已经做的更好。
在您的服务代码中：
- 您可以尝试在您的 Firebird 服务上添加依赖项
- 你可以增加 WaitHint
如果仍然无效：您可以自动启动，但 "Delayed"
我发现不是这样解决的，不过还是谢谢大家的指点，因为你们会及时改进我的服务。
解决方案是通过 Windows ServicesPipeTimeout 注册表项延长服务启动超时。
就我而言，它工作得很好。
我将 ServicesPipeTimeout 的值增加到 120000（2 分钟）。
默认情况下，该值为 30000（30 秒）或更短。
手动编辑：
1) 打开Windows Regedit App；
2) 找到并单击以下注册表子项：
- HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control
在面板值中，找到 ServicesPipeTimeout 条目。
** Note **:
If the ServicesPipeTimeout entry does not exist, you must create it. To do
this, follow these steps:
- 在“编辑”菜单上，指向“新建”，然后单击“DWORD 值”。
- 键入 ServicesPipeTimeout，然后按 ENTER。
3) 右键单击ServicesPipeTimeout，然后单击修改。
4) 单击“十进制”，键入 120000，然后单击“确定”。
** 120000 毫秒 = 2 分钟
5) 重启电脑。
In Delphi（示例注册表值）：
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;
注意：具有注册表更新代码的delphi应用程序需要运行在Windows Vista / Server或Superior的管理员模式下版本；
我想知道一个情况。
我创建了一个 Windows 服务来管理我的应用程序的任务。
服务连接到数据库 (Firebird) 并调用执行任务管理的组件。
进程运行正常，但是，在Windows10 中，服务不会在计算机重新启动后自动启动。在 Windows 的其他版本中，一切都完美无缺。在测试中，我发现如果我评论调用任务执行的方法，该服务通常会在 Windows 10.
开始Procedure TDmTaskService.ServiceExecute(Sender: TService);
Begin
Inherited;
While Not Terminated Do
Begin
//Process;
Sleep(3000);
ServiceThread.ProcessRequests(False);
End;
End;
问题是在组件或服务中没有产生任何异常。
通过分析 Windows 事件监视器，我确定我的服务发生的错误是超时，在这种情况下，服务无法在时限内连接到服务管理器。不再生成异常。
有人会在 Delphi 中提供连接到数据库的 Windows 服务吗？
我的源代码示例：
**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.
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.
不要在 TService.OnCreate 事件中连接到您的数据库，或执行任何其他冗长的操作。这种逻辑属于 TService.OnStart 事件。或者更好的是，为它创建一个工作线程，然后在 TService.OnStart 事件中启动该线程并在 TService.On(Stop|Shutdown) 事件中终止它。
当 SCM 启动您的服务进程时，它只会等待一小段时间让新进程调用 StartServiceCtrlDispatcher()，这会将进程连接到 SCM，以便它可以开始接收服务请求。 StartServiceCtrlDispatcher() 由 TServiceApplication.Run() 在所有 TService 对象首先完全构建之后调用。由于 OnCreate 事件是在您的进程尝试初始化自身时调用的，因此在调用 StartServiceCtrlDispatcher() 之前，服务构建中的任何延迟都可能导致 SCM 超时并终止进程。
此外，您应该完全摆脱 TService.OnExecute 事件处理程序。您甚至根本不应该使用该事件，并且当 OnExecute 未分配任何处理程序时，您当前拥有的内容并不比 TService 内部已经做的更好。
在您的服务代码中： - 您可以尝试在您的 Firebird 服务上添加依赖项 - 你可以增加 WaitHint
如果仍然无效：您可以自动启动，但 "Delayed"
我发现不是这样解决的，不过还是谢谢大家的指点，因为你们会及时改进我的服务。
解决方案是通过 Windows ServicesPipeTimeout 注册表项延长服务启动超时。
就我而言，它工作得很好。 我将 ServicesPipeTimeout 的值增加到 120000（2 分钟）。 默认情况下，该值为 30000（30 秒）或更短。
手动编辑：
1) 打开Windows Regedit App； 2) 找到并单击以下注册表子项： - HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control 在面板值中，找到 ServicesPipeTimeout 条目。
** Note **:
If the ServicesPipeTimeout entry does not exist, you must create it. To do
this, follow these steps:
- 在“编辑”菜单上，指向“新建”，然后单击“DWORD 值”。 - 键入 ServicesPipeTimeout，然后按 ENTER。 3) 右键单击ServicesPipeTimeout，然后单击修改。 4) 单击“十进制”，键入 120000，然后单击“确定”。 ** 120000 毫秒 = 2 分钟 5) 重启电脑。
In Delphi（示例注册表值）：
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;
注意：具有注册表更新代码的delphi应用程序需要运行在Windows Vista / Server或Superior的管理员模式下版本；