database - 带有数据库连接的 Delphi 中的 Windows 服务

Question

我只想知道一个情况。

我创建了一个 Windows 服务来管理我的应用程序的任务。

服务连接到数据库 (Firebird) 并调用执行任务管理的组件。

该过程运行正常，但是，在 Windows 10 中，该服务不会在计算机重新启动后自动启动。在其他版本的 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.

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.

不要在 TService.OnCreate 事件中连接到您的数据库，或执行任何其他冗长的操作。这种逻辑属于 TService.OnStart 事件。或者更好的是，为它创建一个工作线程，然后在 TService.OnStart 事件中启动该线程并在 TService.On(Stop|Shutdown) 事件中终止它。

当 SCM 启动您的服务进程时，它只会等待很短的时间让新进程调用 StartServiceCtrlDispatcher() ，它将流程连接到 SCM，以便它可以开始接收服务请求。 StartServiceCtrlDispatcher() 由 TServiceApplication.Run() 在首先完全构建所有 TService 对象之后调用。由于 OnCreate 事件是在您的进程尝试初始化自身时调用的，因此在 StartServiceCtrlDispatcher() 被调用之前，服务构建中的任何延迟都可能导致 SCM 超时并终止过程。

此外，您应该完全摆脱 TService.OnExecute 事件处理程序。您甚至根本不应该使用该事件，并且当 OnExecute 未分配任何处理程序时，您当前拥有的内容并不比 TService 已经在内部执行的操作好。