CODEWITHSUNDEEP
vbscriptdatabase-connectionadoadodb
mountainclimber11
mountainclimber11

Reputation: 1400

Test ADO connection and reconnect prior to execution if needed, in VBScript

I have the following 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

At the first message box I would like to simulate losing a connection to our database. Possible causes could be that the database is down or the LAN is down, etc. In other words, I want to test if the connection is in good order so a valid execute statement will succeed. The msgboxes above never change after I disconnect from the network.

The only way I can currently do it is to Execute after a On Error Resume Next, then look at the Err.Number. Is there a way to test the connection prior to the execute so I can reconnect then execute like this:

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: I also tried setting the recordset after disconnect, but that didn't change the message box result in the first code snippet.

Upvotes: 0

Views: 2750

Answers (2)

mountainclimber11
mountainclimber11

Reputation: 1400

Using Ansgar's suggestion I am posting code that will "try at least a couple times". The function will return the connection object if it successfully reconnects or the connection is already good, else nothing after trying a user input number of times and waiting a user input number of seconds between tries:

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

This answer isn't necessary to the central question I asked, but I thought it would be useful to people viewing this in the future. Probably could use some cleaning up.

Upvotes: 0

Ansgar Wiechers
Ansgar Wiechers

Reputation: 200193

The State property indicates just the state of the connection on the client side. AFAIK you need to execute a query in order to detect whether or not the server is still available.

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

Note that you may need to re-assign the re-opened connection to the object using it.

Note also that the above does just the most basic reconnect by closing and re-opening the connection. In real-world scenarios you may want to be able to retry at least a couple times if the reconnect fails as well (e.g. because the network or server hasn't come back up yet).

Upvotes: 2

Related Questions