在VBScript中测试ADO连接并在执行之前重新连接（如果需要）

我有以下VBScript（vbs）：

在第一个消息框中，我想模拟丢失与数据库的连接。可能的原因可能是数据库关闭或LAN关闭等。换句话说，我想测试连接是否处于良好状态，以便有效的execute语句将成功。在我断开网络连接后，上面的msgboxes从未更改

目前我唯一能做的就是在下一次出现

错误后执行
，然后查看
错误号。是否有办法在执行之前测试连接，以便我可以重新连接，然后执行
execute
，如下所示：

Option Explicit

Dim cn, cmDB, rs
Set cn = CreateObject("ADODB.Connection")

cn.ConnectionString = "DSN=PostgreSQLDNSHere"
cn.Open
cn.CommandTimeout = 28800
Set cmDB = CreateObject("ADODB.Command")
cmDB.CommandTimeout = 28800

Set rs = CreateObject("ADODB.recordset")
rs.CursorType = 2

MsgBox "disconnected network here then clicked ok to proceed"

If cn.State = ?? Then
   'reconnect here
End If
Set rs = cn.Execute("select * from test;")

WScript.Quit

编辑1：
我还尝试在断开连接后设置记录集，但这并没有改变第一个代码段中的消息框结果。
属性
State
仅指示客户端连接的状态。好的，您需要执行一个查询来检测服务器是否仍然可用

Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = cn
cmd.CommandText = "SELECT 1;"

On Error Resume Next
Set rs = cmd.Execute
If Err Then
  If Err.Number = &h80004005 Then
    'server side disconnected -> re-open
    cn.Close
    cn.Open
  Else
    WScript.Echo "Unexpected error 0x" & Hex(Err.Number) & ": " & Err.Description
    WScript.Quit 1
  End If
End If

请注意，您可能需要将重新打开的连接重新分配给使用它的对象

还请注意，上述操作只是通过关闭和重新打开连接来进行最基本的重新连接。在现实场景中，如果重新连接失败，您可能希望能够至少重试几次（例如，因为网络或服务器尚未恢复）。
根据Ansgar的建议，我发布了“至少重试几次”的代码。如果成功重新连接或连接已经良好，则函数将返回连接对象，否则在尝试用户输入次数并在两次尝试之间等待用户输入秒数后，函数将返回
nothing
：

Option Explicit

dim cn, cmDB, rs
set cn = CreateObject("ADODB.Connection")  

cn.ConnectionString= "DSN=PostgreSQLDsn" 
cn.open 
cn.CommandTimeout = 28800
Set cmDB = CreateObject("ADODB.Command")
cmDB.CommandTimeout = 28800

set rs = CreateObject("ADODB.recordset")
rs.CursorType = 2

msgbox "disconnected internet here then clicked ok to proceed"    

set cn = TestReOpenConnection(cn,"DSN=PostgreSQLDsn",28800,2,100)

if cn is nothing then
    msgbox "not good"
    WScript.Quit
end if

set rs = cn.execute("select * from test;")
msgbox "all good: " & rs.fields("x")

WScript.Quit

function TestReOpenConnection(cn,sDsn,iConnTimeOut,iWaitSecs,iTimesToTry)

    dim iWaitMilSecs 
    iWaitMilSecs = iWaitSecs * 1000
    dim bConnected  
    bConnected = false
    dim iTries
    iTries = 0
    dim rsTest
    set rsTest = CreateObject("ADODB.recordset")

    do while bConnected = false 

        On Error Resume Next

        Set rsTest = cn.execute("select 1;")
        If Err Then

            if iTries <> 0 then
                WScript.Sleep iWaitMilSecs 'if we tried once already, then wait 
            end if

            cn.Close
            set cn = CreateObject("ADODB.Connection")  
            cn.ConnectionString= sDsn

            On Error Resume Next
            cn.open 
            cn.CommandTimeout = iConnTimeOut
        else

            bConnected = true
            set TestReOpenConnection = cn
        End If
        iTries = iTries + 1
        if iTries > iTimesToTry then
            set TestReOpenConnection = nothing
            exit do
        end if
    loop

end function

选项显式
dim cn、cmDB、rs
set cn=CreateObject（“ADODB.Connection”）
cn.ConnectionString=“DSN=PostgreSQLDsn”
中国公开
cn.CommandTimeout=28800
Set cmDB=CreateObject（“ADODB.Command”）
cmDB.CommandTimeout=28800
set rs=CreateObject（“ADODB.recordset”）
rs.CursorType=2
msgbox“此处已断开internet连接，然后单击“确定”继续”
设置cn=TestReconnection（cn，“DSN=PostgreSQLDsn”，28800,2100）
如果cn什么都不是，那么
msgbox“不好”
WScript.Quit
如果结束
设置rs=cn.execute（“从测试中选择*”）
msgbox“一切正常：&rs.fields（“x”）
WScript.Quit
函数TestReconnection（cn、sDsn、iConnTimeOut、iWaitSecs、ITimestory）
昏暗的伊瓦特米尔斯
iWaitMilSecs=iWaitSecs*1000
暗B连接
b连接=错误
昏暗的
iTries=0
暗RST
set rsTest=CreateObject（“ADODB.recordset”）
B连接时执行=错误
出错时继续下一步
设置rsTest=cn.execute（“选择1；”）
如果有错误，那么
如果是0，那么
如果我们已经尝试过一次，请等待
如果结束
cn.Close
set cn=CreateObject（“ADODB.Connection”）
cn.ConnectionString=sDsn
出错时继续下一步
中国公开
cn.CommandTimeout=IConTimeout
其他的
b连接=真
设置TestReconnection=cn
如果结束
iTries=iTries+1
如果iTries>iTimesToTry，则
设置TestReconnection=nothing
退出do
如果结束
环
端函数

对于我所问的核心问题，这个答案是不必要的，但我认为这对将来看到这个问题的人是有用的。可能需要清理一下。
谢谢！我补充了另一个答案，它符合你的建议。如果你想从答案中删除我的代码并输入你的答案，请随意，我会删除我的答案。
Option Explicit

dim cn, cmDB, rs
set cn = CreateObject("ADODB.Connection")  

cn.ConnectionString= "DSN=PostgreSQLDsn" 
cn.open 
cn.CommandTimeout = 28800
Set cmDB = CreateObject("ADODB.Command")
cmDB.CommandTimeout = 28800

set rs = CreateObject("ADODB.recordset")
rs.CursorType = 2

msgbox "disconnected internet here then clicked ok to proceed"    

set cn = TestReOpenConnection(cn,"DSN=PostgreSQLDsn",28800,2,100)

if cn is nothing then
    msgbox "not good"
    WScript.Quit
end if

set rs = cn.execute("select * from test;")
msgbox "all good: " & rs.fields("x")

WScript.Quit

function TestReOpenConnection(cn,sDsn,iConnTimeOut,iWaitSecs,iTimesToTry)

    dim iWaitMilSecs 
    iWaitMilSecs = iWaitSecs * 1000
    dim bConnected  
    bConnected = false
    dim iTries
    iTries = 0
    dim rsTest
    set rsTest = CreateObject("ADODB.recordset")

    do while bConnected = false 

        On Error Resume Next

        Set rsTest = cn.execute("select 1;")
        If Err Then

            if iTries <> 0 then
                WScript.Sleep iWaitMilSecs 'if we tried once already, then wait 
            end if

            cn.Close
            set cn = CreateObject("ADODB.Connection")  
            cn.ConnectionString= sDsn

            On Error Resume Next
            cn.open 
            cn.CommandTimeout = iConnTimeOut
        else

            bConnected = true
            set TestReOpenConnection = cn
        End If
        iTries = iTries + 1
        if iTries > iTimesToTry then
            set TestReOpenConnection = nothing
            exit do
        end if
    loop

end function