Delphi服务应用程序随机崩溃答案

【问题标题】：Delphi service app crashes at a random timeDelphi服务应用程序随机崩溃
【发布时间】：2021-06-24 17:14:37
【问题描述】：

我有一个 Delphi Service 应用程序。 Indy TCP 服务器和许多客户端（最多 50 个），ADO 连接到 Firebird 和简单的网络交换。应用程序随机崩溃（可能在 7 天内工作，可能是 1 小时）并出现下一个事件（例如）：

Имя сбойного приложения: rollcontrol.exe, версия: 1.1.20.2, метка времени: 0x60acd5f2 Имя сбойного модуля: ntdll.dll, версия: 6.3.9600.19678, метка времени: 0x5e82c0f7 Код исключения: 0xc0000005 Смещение ошибки: 0x00058def Идентификатор сбойного процесса: 0x4178

或：

Имя сбойного приложения: rollcontrol.exe, версия: 1.1.1.9, метка времени: 0x607b239c Имя сбойного модуля: msvcrt.dll, версия: 7.0.9600.16384, метка времени: 0x52158ff5 Код исключения: 0xc0000005 Смещение ошибки: 0x00009e80

应用程序中的所有作业都在匿名线程或 tcp/ip 连接线程中进行。每个线程中的所有代码都在 try 中执行，除了语句。没有内存泄漏或增加的线程数。服务线程的主要代码很简单：

procedure TRollControl_Svc.ServiceExecute(Sender: TService);
begin

  while not Terminated do
  try
    ServiceThread.ProcessRequests(False);
    ServiceThread.Sleep(100);
  except
    on e : exception do LogException('ServiceExecute', E);
  end;

end;

如何处理此异常并防止应用崩溃？怎么可能用两行简单的代码让服务线程崩溃？

谢谢

更新：与数据库的连接示例：

function TRollControl_Svc.GetNodeIdByIP(ip: string): integer;
Var
    SQLConnection : TADOConnection;
    SQLQuery : TADOQuery;
    Thread : TThread;
    fResult : integer;
begin

    fResult := 0;

    try
      Thread := nil;
      Thread := TThread.CreateAnonymousThread(
      procedure
      begin

        try

          SQLConnection := nil;
          SQLQuery := nil;

          CoInitialize(nil);

          SQLConnection := TADOConnection.Create(nil);
          SQLConnection.ConnectionString := 'Provider=MSDASQL.1;Password=' + Psw + ';Persist Security Info=True;User ID=' + Usr + ';Data Source=' + Srv ;
          SQLConnection.LoginPrompt := false;

          SQLQuery := TADOQuery.Create(nil);
          SQLQuery.Connection := SQLConnection;
          SQLQuery.LockType := ltReadOnly;

          try SQLConnection.Open; except SQLConnection.Open; end;
          SQLConnection.BeginTrans;

          SQLQuery.Close;
          SQLQuery.SQL.Text := 'select nodes.* from nodes where nodes.ip = :ip';
          SQLQuery.Parameters.ParamByName('ip').Value := ip;
          try SQLQuery.Open; except SQLQuery.Open; end;

          if SQLQuery.IsEmpty then exit;

          fResult := SQLQuery.FieldByName('ID').AsInteger;

          if SQLConnection.InTransaction then
            SQLConnection.CommitTrans;

        finally

          TryFree(SQLQuery);
          TryFree(SQLConnection);

          CoUninitialize;
        end;

      end
      );
      Thread.FreeOnTerminate := false;
      Thread.Start;
      Thread.WaitFor;
    finally
      TryFree(Thread);
    end;

    result := fResult;

end;

【问题讨论】：

你在这里显示的代码很好，实际上你可以省略那段代码，最好不要实现 OnServiceexecute 因为它会做完全一样的事情。 0xc0000005 是一个外部异常，很可能在 ADO COM 层，但我们在这里看不到该代码...
到 ADO 的所有连接都在 TIDTCPServerExecute 过程中的 TThread.CreateAnonymousThread 等单独线程中执行。 try/except 语句中的所有代码。我不明白为什么主线程崩溃以及如何在进程终止之前捕获异常
如果没有 minimal reproducible example 来证明实际存在的错误，任何人都无法为您诊断。您只需要调试您的服务以在错误发生时捕获它们。在您提到的简单描述中，有很多地方可能会出错
我没有看到那些匿名线程的附加值，每个 TCP 连接都已经发生在它自己的线程上下文中，我猜你在某处破坏内存导致一般崩溃。如果您无法调试服务，请添加一些日志记录。

标签： delphi service crash ado indy

【解决方案1】：

错误处理

这不是关于导致您问题的原因的答案，但我认为在评论中可能不清楚。

在支持结构化异常处理的语言中，该语言为程序员提供了在事情不正常时优雅地失败的机会。这不是你使用它的方式。从您的示例匿名线程中，您有：

  try SQLConnection.Open; except SQLConnection.Open; end;

因此，您被告知无法建立连接，您没有响应这种情况，而是继续尝试再次连接。连接可能无法正常工作的原因有很多，其中一些是暂时的，因此尝试可能会稍晚一些，但如果您只是尝试再次尝试而没有任何暂停，那么预计它会再次失败似乎是合理的。

捕获错误显然很重要，但您必须有适当的故障路径。

我无法知道这是否与实际发生的问题有关。

【讨论】：

我与数据库有许多“短”连接，并且经常在 ADO 中因错误而无法打开查询。重试以 99.9% 的时间解决了这些问题，我认为在这种情况下没有理由重新创建连接和新线程。现在我设置 System.NeverSleepOnMMThreadContention := false 并将 TADOConnection.Create(nil) 移到 try/finally 块之外，等待结果...
@НиколайНевзоров Rob 的意思是，当使用 except 子句时，尝试捕获特定异常（例如 Ado 特定异常）并引发其他与 ADO 无关的异常，因此您肯定知道那是您要解决的实际问题。这样你就可以确定在这种情况下你没有遇到 0.1% 的其他失败......

【解决方案2】：

我找到了原因。问题出在 ADO 源代码（Data.Win.ADODB.pas）中：

  procedure RefreshFromOleDB;
  var
    I: Integer;
    ParamCount: ULONG_PTR;
    ParamInfo: PDBParamInfoArray;
    NamesBuffer: POleStr;
    Name: WideString;
    Parameter: _Parameter;
    Direction: ParameterDirectionEnum;
    OLEDBCommand: ICommand;
    OLEDBParameters: ICommandWithParameters;
    CommandPrepare: ICommandPrepare;
  begin
    OLEDBCommand := (Command.CommandObject as ADOCommandConstruction).OLEDBCommand as ICommand;
    OLEDBCommand.QueryInterface(ICommandWithParameters, OLEDBParameters);
    OLEDBParameters.SetParameterInfo(0, nil, nil); // ----- Error here
    if Assigned(OLEDBParameters) then
    begin
      ParamInfo := nil;
      NamesBuffer := nil;
      try
        OLEDBCommand.QueryInterface(ICommandPrepare, CommandPrepare);
        if Assigned(CommandPrepare) then CommandPrepare.Prepare(0);
        if OLEDBParameters.GetParameterInfo(ParamCount, PDBPARAMINFO(ParamInfo), @NamesBuffer) = S_OK then
          for I := 0 to ParamCount - 1 do//
          begin
            { When no default name, fabricate one like ADO does }
            if ParamInfo[I].pwszName = nil then
              Name := 'Param' + IntToStr(I+1) else { Do not localize }
              Name := ParamInfo[I].pwszName;
            { ADO maps DBTYPE_BYTES to adVarBinary }
            if ParamInfo[I].wType = DBTYPE_BYTES then ParamInfo[I].wType := adVarBinary;
            { ADO maps DBTYPE_STR to adVarChar }
            if ParamInfo[I].wType = DBTYPE_STR then ParamInfo[I].wType := adVarChar;
            { ADO maps DBTYPE_WSTR to adVarWChar }
            if ParamInfo[I].wType = DBTYPE_WSTR then ParamInfo[I].wType := adVarWChar;
            Direction := ParamInfo[I].dwFlags and $F;
            { Verify that the Direction is initialized }
            if Direction = adParamUnknown then Direction := adParamInput;
            Parameter := Command.CommandObject.CreateParameter(Name, ParamInfo[I].wType, Direction, ParamInfo[I].ulParamSize, EmptyParam);
            Parameter.Precision := ParamInfo[I].bPrecision;
            Parameter.NumericScale := ParamInfo[I].bScale;
            //if ParamInfo[I].dwFlags and $FFFFFFF0 <= adParamSigned + adParamNullable + adParamLong then
            Parameter.Attributes := ParamInfo[I].dwFlags and $FFFFFFF0; { Mask out Input/Output flags }
            AddParameter.FParameter := Parameter;
          end;
      finally
        if Assigned(CommandPrepare) then CommandPrepare.Unprepare;
        if (ParamInfo <> nil) then GlobalMalloc.Free(ParamInfo);
        if (NamesBuffer <> nil) then GlobalMalloc.Free(NamesBuffer);
      end;
    end;
  end;

线

OLEDBParameters.SetParameterInfo(0, nil, nil)

之前执行过

if Assigned(OLEDBParameters)

在检查 nil 并且一切正常后，我移动了这条线

【讨论】：

您使用的是哪个 Delphi 版本？我检查了当前的 Delphi 版本（10.4.2），您发现的违规行位于正确的位置。
我有 Delphi XE3 :(
哎呀，非常旧的版本，2012 年发布。您可能应该升级到最新版本 (10.4.2) 以获得自 XE3 以来的所有错误修复。这是有代价的，但你会花更多的钱来解决这些错误。
很高兴您发现了这个问题 :)

【解决方案3】：

我设法隔离了问题。使用 ADO 时会定期发生错误。如果我再次尝试使用 TADOQuery 对象，应用程序更容易崩溃。我做了什么：

System.NeverSleepOnMMThreadContention: = false; 使用 ADO 时显着减少错误
TADOQuery 的所有用途都是一次性使用。

例如是：

            for ii := 0 to SettingsXML.Root.NamedItem['sql_clear_base'].NamedItem['XML'].Count - 1 do
            begin

                try
                  SQLQuery.Close;
                  SQLQuery.SQL.Text := SettingsXML.Root.NamedItem['sql_clear_base'].NamedItem['XML'][ii].AsString;
                  SQLQuery.ExecSQL;
                except
                  on e : exception do LogException('ClearBase', '', E);
                end;

            end;

成为：

            for ii := 0 to SettingsXML.Root.NamedItem['sql_clear_base'].NamedItem['XML'].Count - 1 do
            begin

              SQLQuery := nil;
              try
                SQLQuery := TADOQuery.Create(nil);
                SQLQuery.Connection := SQLConnection;
                try
                  SQLQuery.Close;
                  SQLQuery.SQL.Text := SettingsXML.Root.NamedItem['sql_clear_base'].NamedItem['XML'][ii].AsString;
                  SQLQuery.ExecSQL;
                except
                  on e : exception do LogException('ClearBase', '', E);
                end;
              finally
                TryFree(SQLQuery);
              end;

            end;

我自制：

主进程作为 Windows 服务启动（进程 A）
进程 A 以 B 的身份启动自身的副本
每分钟一个 A 检查 B 是否活着，如果没有则重新启动
每分钟一个 B 检查 A 是否活着，如果没有则重新启动
检查 - 简单的 TCP 数据包和应答

例如：

TThread.CreateAnonymousThread(
procedure
var tcpClient : TidTCPClient;
begin

  tcpClient := nil;
  LastKeepAlive := Date + Time;

  while ServerMode do
  begin

    try
      if not Assigned(tcpClient) then
      begin
        tcpClient := TIdTCPClient.Create(nil);
        tcpClient.Host := '127.0.0.1';
        tcpClient.Port := RollControl_Svc.TCPServer.Bindings[0].Port;
        tcpClient.Connect;
        tcpClient.IOHandler.ReadTimeout := 1000;
      end;
      tcpClient.IOHandler.Write(START_PACKET + #0 + END_PACKET);
      tcpClient.IOHandler.ReadString(3);
      LastKeepAlive := Date + Time;
    except
      TryFree(tcpClient);
    end;

    sleep(15 * 1000);
  end;

end).Start;

TThread.CreateAnonymousThread(
procedure
Var Res: TRequestResult;
begin

  while ServerMode do
  begin
    if Date + Time - LastKeepAlive > OneMinute then
    begin
      Res.Clear('', '');
      Res.Nodes_ID := -1;
      Res.Data_In := 'KeepAlive';
      Res.Data_Out := 'Exception: ExitProcess(1)';
      try
        Log(Res, true);
      finally
        ExitProcess(1);
      end;
    end;

    sleep(1000);
  end;

end).Start;

附：本地测试从未使应用程序崩溃。该程序只需处理一百万个请求（连接、请求、断开连接），没有内存泄漏或故障。在几个客户端服务器崩溃。将来我想移植到 Lazarus 直接使用 ODBC 而不是 ADO

【讨论】：