在VBScript中测试ADO连接，如果需要，可以在执行之前重新连接。

Question

我有以下VBScript (vbs)：

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"
MsgBox cn.State
MsgBox cmDB.State
MsgBox rs.State

Set rs = cn.Execute("select * from test;")

WScript.Quit

在第一个消息框中，我想模拟失去与数据库的连接。可能的原因可能是数据库关闭或LAN关闭，等等。换句话说，我想测试连接是否正常，以便有效的execute语句成功。在我断开网络连接后，上面的msgboxes不会改变。

目前我唯一能做到的方法是在On Error Resume Next之后执行Execute，然后查看Err.Number。有没有一种方法可以在执行之前测试连接，这样我就可以像这样重新连接然后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

EDIT1:我还尝试在断开连接后设置记录集，但这并没有改变第一个代码片段中的消息框结果。

Answer 1

State属性仅指示客户端上的连接状态。AFAIK您需要执行一个查询，以检测服务器是否仍然可用。

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

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

还请注意，上面只通过关闭和重新打开连接来执行最基本的重新连接。在实际场景中，如果重新连接也失败(例如，因为网络或服务器尚未恢复)，您可能希望能够重试至少几次。

Answer 2

根据Ansgar的建议，我将发布“至少尝试几次”的代码。如果函数成功重新连接或连接已经良好，则函数将返回connection对象，否则在尝试用户输入多次并在两次尝试之间等待用户输入的秒数后返回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

对于我问的核心问题，这个答案并不是必须的，但我认为它对将来查看这篇文章的人会很有用。可能需要清理一下。