Question

我有一个 Delphi 服务应用程序。 Indy TCP 服务器和许多客户端（最多 50 个），到 Firebird 的 ADO 连接和简单的网络交换。应用程序随机崩溃（可能会在 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

应用程序中的所有作业都在 anonimius 线程或 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;

Answer 1

错误处理

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

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

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

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

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

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

Answer 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 并且一切正常后移动了这条线

Answer 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 insteed ADO

Delphi 服务应用程序随机崩溃

3 个答案: