Delphi中的Windows服务与数据库连接

3

我想请您提供一些建议,关于一个问题。

我创建了一个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.

1
在 Windows 启动时,假设您的服务启动数据库服务启动之前,因此使得您的服务无法连接。当发生这种情况时,它会引发异常。如果未处理该异常,服务将停止。编辑 我刚刚仔细查看了一下,有一些异常处理可以捕获到这种情况。 - Jerry Dodge
1
什么是问题? - David Heffernan
2
顺便提一下,Sleep(3000);容易引起麻烦——在服务和线程中绝对不推荐这样做。至少应该用循环实现,并持续检查是否已终止。 - Jerry Dodge
2
我有一种不好的预感,你没有提供所有的代码。由于每个代码中都有 Inherited;,这告诉我你的整个服务数据模块是从另一个继承而来的,可能有更多的代码。你的问题可能在那个祖先代码中。但是,它并没有被继承,直接在那里有 TService,所以我不知道为什么你到处都有 Inherited; - Jerry Dodge
@JerryDodge。你说得对,我的服务继承自另一个类。但是这个基类没有任何可能干扰情况的代码。我只是修改了这个类以便更好地为你举例说明。 - Delphiman
显示剩余2条评论
3个回答

9
通过分析Windows事件监视器,我已经确定了我的服务出现的错误是超时,在这种情况下,服务无法在时间限制内连接到服务管理器。不会产生更多的异常。
不要在TService.OnCreate事件中连接数据库或执行任何其他耗时操作。这样的逻辑应该放在TService.OnStart事件中。或者更好的方法是为其创建一个工作线程,然后在TService.OnStart事件中启动该线程,并在TService.On(Stop|Shutdown)事件中终止它。
当SCM启动你的服务进程时,它只等待短时间以便新进程调用StartServiceCtrlDispatcher(),该函数将进程连接到SCM以便开始接收服务请求。在所有TService对象都被完全构造之后,StartServiceCtrlDispatcher()TServiceApplication.Run()调用。由于在调用StartServiceCtrlDispatcher()之前,进程正在尝试初始化自身时会调用OnCreate事件,因此服务构建中的任何延迟都可能导致SCM超时并终止进程。
另外,你应该完全摆脱TService.OnExecute事件处理程序。你根本不应该使用该事件,而你当前在其中所做的与TService内部未分配任何处理程序时所做的没有什么区别。

1
事实上,适当的服务设计永远不应该在主服务线程中执行工作。实际上,我总是先在测试应用程序中的线程中编写每个服务,然后将其迁移到服务中。我有一个模板,可以让我在服务的启动/停止中简单地启动/停止线程。如果Borland从一开始就没有提供OnExecute事件就好了 :-) - Jerry Dodge
如果你说OnExecute根本不应该被使用,那么替代方案是什么?而OnExecute有什么问题吗? - Alec
1
@Fero:另一种选择是按照我已经解释的方式 - 创建一个线程来执行你的工作,在OnStart事件中启动它,在On(Stop|Shutdown)事件中停止它。不应使用OnExecute事件,因为很容易出错。太多的新手会弄错它,然后想知道为什么他们的服务不起作用。TService可以很好地处理SCM请求,而不需要分配OnExecute,所以就让它自己处理吧。 - Remy Lebeau
1
@Fero,为了进一步解释Remy的答案,在这里你可以找到如何在Delphi中正确实现服务的方法。 - whosrdaddy
@RemyLebeau,Remy,感谢您的建议,非常重要。我使用OnCreate事件进行连接,因为我的服务可以有多个实例,也就是说,我可以有相同的服务,连接到不同的数据库。所以在启动之前,我需要给它一个不同的名称。这个名称在数据库中。在向您展示之前,我尝试了几种可能性,最终得到了现在的服务,它可以正常工作,但在Windows 10中无法自动启动。我将根据您的提示和示例重新制定流程,并在此确认返回。 - Delphiman
显示剩余2条评论

1
在您的服务代码中: - 您可以尝试添加对Firebird服务的依赖项 - 您可以增加WaitHint
如果仍然不起作用:您可以将其设置为自动但“延迟启动”

1
另一个答案是正确的修复方法。这只是一个权宜之计,甚至不能保证有效。 - Jerry Dodge
@HuguesVanLandeghem,就我的情况而言,我将Firebird添加为依赖服务,但仍然无法正常工作。问题在于该服务在Windows 10中只是不能自动启动。在其他Windows版本中,它可以正常工作。我将尝试使用您的WaitHint提示,并确认是否有效。我无法使用延迟启动选项,因为它不适用于Windows 2000、2003和XP版本。而这些版本恰好是我们客户所使用的。 - Delphiman
@HuguesVanLandeghem,仅仅增加WaitHint并没有起作用。只是给你一个回应。解决方案就是我刚刚发布的答案。 - Delphiman
@Delphiman 我认为你想要使用的词是“反馈”。 “comeback” 是一个负面的东西,通常是一种报复。 - Jerry Dodge
@JerryDodge,你是对的。抱歉,我的英文表达有误。我想说的是反馈。 - Delphiman

1
我找到了其他解决方法,但是我感谢每个人提供的提示,因为及时的建议可以改进我的服务。
解决方案是通过Windows ServicesPipeTimeout注册表键扩展服务启动超时时间。
对于我的情况,它完美地起作用了。 我将ServicesPipeTimeout的值增加到120000(2分钟)。 默认情况下,该值为30000(30秒)或更少。
手动编辑: 1)打开Windows Regedit应用程序; 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) 重新启动计算机。

在 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 或更高版本中以管理员模式运行;

这只是另一个解决方法,并不能保证有效。正确的修复方法是重新设计服务,在启动时停止执行任何可能延迟服务连接到SCM并导致超时的操作。 - Remy Lebeau
@RemyLebeau,我同意你的观点。这个超时时间的更改(ServicesPipeTimeout)将使我有时间重构进程。这只是一个临时解决方案。非常感谢你宝贵的建议。 - Delphiman

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接