Delphi中TADOConnection连接SQL Server实时连接状态检测实现咨询

问题根因 #

你当前使用的BeforeConnect、AfterDisconnect事件仅在主动执行连接、主动关闭连接操作时才会触发，数据库服务异常中断、网络断连这类被动断开场景，ADO原生不会主动触发这两个事件，因此达不到实时检测的效果。
另外你现有创建连接的代码中with ADOSQL do属于笔误，如果你没有定义名为ADOSQL的变量，需要修正为with ADOConnectionSQL do，否则连接字符串赋值不会生效。

可行实现方案 #

核心逻辑为新增独立的后台心跳检测线程，定时对数据库连接做轻量存活校验，根据校验结果更新圆形控件颜色：

• 心跳检测采用低消耗的校验逻辑，比如执行SELECT 1语句，超时设置为3秒即可，不会给数据库造成额外压力
• 心跳间隔可设置为10~30秒，可根据业务对断连感知的灵敏度要求调整
• ADO属于COM对象，跨线程操作时需要切到主线程执行，避免COM线程模型兼容问题

优化后代码示例 #

首先在窗体类中新增两个全局变量：

private
  FStopHeartBeat: Boolean;
  FHeartBeatThread: TThread;

心跳线程逻辑 #

procedure TForm1.StartHeartBeat;
begin
  FStopHeartBeat := False;
  FHeartBeatThread := TThread.CreateAnonymousThread(
    procedure
    var
      LIsConnected: Boolean;
      LQuery: TADOQuery;
    begin
      while not FStopHeartBeat do
      begin
        LIsConnected := False;
        try
          // 切到主线程操作ADO组件和更新UI
          TThread.Synchronize(nil,
            procedure
            begin
              if not Assigned(ADOConnectionSQL) then Exit;
              if ADOConnectionSQL.Connected then
              begin
                try
                  LQuery := TADOQuery.Create(nil);
                  try
                    LQuery.Connection := ADOConnectionSQL;
                    LQuery.SQL.Text := 'SELECT 1';
                    LQuery.CommandTimeout := 3;
                    LQuery.ExecSQL;
                    LIsConnected := True;
                  finally
                    LQuery.Free;
                  end;
                except
                  LIsConnected := False;
                  // 异常则主动清理连接状态
                  ADOConnectionSQL.Connected := False;
                end;
              end;
              // 更新状态控件
              if LIsConnected then
                Circle1.Fill.Color := $FF00FF00
              else
                Circle1.Fill.Color := $FFFF0000;
            end);
        except
          // 捕获线程内部异常避免崩溃
        end;
        // 10秒检测一次，可自行调整间隔
        TThread.Sleep(10000);
      end;
    end);
  FHeartBeatThread.FreeOnTerminate := True;
  FHeartBeatThread.Start;
end;

连接逻辑调整 #

连接成功后启动心跳线程即可，不需要再绑定BeforeConnect、AfterDisconnect事件：

procedure TForm1.Button2Click(Sender: TObject);
var
  Thread : TThread;
begin
  Thread := TThread.CreateAnonymousThread(
    procedure
    begin
      TThread.Synchronize(TThread.CurrentThread,
      procedure
        begin
        try
          ADOConnectionSQL.Connected := True;
          // 连接成功后启动心跳，避免重复启动
          if not Assigned(FHeartBeatThread) then
            StartHeartBeat;
        except
          on E: Exception do
          begin
            ShowMessage('Exception message = '+E.Message);
            Circle1.Fill.Color := $FFFF0000;
          end;
        end;
        ADOQuerySQL := TADOQuery.Create(nil);
      end);
    end);
  Thread.OnTerminate := FinishConnected;
  Thread.Start;
end;

窗体关闭资源回收 #

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // 停止心跳线程
  FStopHeartBeat := True;
  if Assigned(FHeartBeatThread) then
    FHeartBeatThread.WaitFor;
  // 释放数据库资源
  if Assigned(ADOQuerySQL) then
    ADOQuerySQL.Free;
  if Assigned(ADOConnectionSQL) then
  begin
    ADOConnectionSQL.Connected := False;
    ADOConnectionSQL.Free;
  end;
end;

如果需要断连后自动重连，只需要在心跳检测到LIsConnected=False时，补充执行重连逻辑即可。

内容的提问来源于stack exchange，提问作者Wellington Telles Cunha