0

オフラインの (または応答していない) DB サーバーへの非同期 ADO 接続をキャンセルしようとすると、設定されたタイムアウト時間の間Cancel、オブジェクトのメソッドがブロックされます。ADODB.Connection

私は次のように非同期接続を行います：

Set Connection = New ADODB.Connection
Connection.Provider = "SQLOLEDB"
Connection.ConnectionTimeout = 60
Connection.ConnectionString = "Initial Catalog=" & RTrim(DBName) & _
                                ";Data Source=" & RTrim(DBServerName) & ";Integrated Security = SSPI"

Connection.Open , , , adAsyncConnect

その後、次を呼び出して接続をキャンセル/閉じます。

If (Connection.State And adStateConnecting) = adStateConnecting Then
    ' ==== CONNECTION BLOCKS HERE ======
    Connection.Cancel
End If

If (Connection.State And adStateOpen) = adStateOpen Then
    Connection.Close
End If

Set Connection = Nothing

Cancelメソッドをブロックさせない方法はありますか?

4

1 に答える 1

1

最後に独自の解決策を見つけました。まあ、少なくとも許容できる回避策です。

最初に、タイマーで接続をキャンセル/閉じることができるモジュールを作成しました (コード プロジェクトの記事のアイデアのおかげです)。

Option Explicit

' Timer API:
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
    ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) _
    As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
    ByVal nIDEvent As Long) As Long

' Collection of connections to cancel
Private m_connections As Collection

' The ID of our API Timer:
Private m_lTimerID As Long

Private Sub TimerProc(ByVal lHwnd As Long, ByVal lMsg As Long, _
    ByVal lTimerID As Long, ByVal lTime As Long)

On Error GoTo ErrH:
    Dim cnx As ADODB.Connection

    ' Remove the timer
    KillTimer 0, lTimerID

    If Not m_connections Is Nothing Then
        With m_connections
            Do While .Count > 0
                Set cnx = .Item(1)
                .Remove 1

                TryCancelOrCloseConnection cnx
            Loop
        End With

        If m_connections.Count = 0 Then
            Set m_connections = Nothing
        End If
    End If

   ' Let the next call to CancelOrCloseAsync create a new timer
   m_lTimerID = 0
   Exit Sub
ErrH:
   ' Let the next call to CancelOrCloseAsync create a new timer
   m_lTimerID = 0
   Debug.Print "Error closing connetions timer: " & Err.Description
End Sub

Private Sub TryCancelOrCloseConnection(cnx As ADODB.Connection)
On Error GoTo ErrH
    If Not cnx Is Nothing Then
        If (cnx.State And adStateConnecting) = adStateConnecting Then
            ' The call to Cancel here blocks this execution path (until connection time-out),
            ' but we assume it internally calls DoEvents, because (even though it blocks here) messages get pumped.
            cnx.Cancel
        End If

        ' If the connection actually made it to an open state, we make sure it is closed
        If (cnx.State And adStateOpen) = adStateOpen Then
            cnx.Close
        End If
    End If
    Exit Sub
ErrH:
    Debug.Print "ADO Connection Cancel/Close error " & Err.Description
    ' We deliberately suppress the error here.
    ' The reason is that accessing the Connection.State property, while there was an error when
    ' connecting, will raise an error. The idea of this method is simply to make sure we close/cancel
    ' the pending connection if there was no connection error.
End Sub

Public Sub CancelOrCloseAsync(cnx As ADODB.Connection)
    If Not cnx Is Nothing Then
        ' Add cnx to the collection of connections to cancel
        If m_connections Is Nothing Then
           Set m_connections = New Collection
        End If

        m_connections.Add cnx

        ' Create a timer to start cancelling the connection(s), but only if one is not already busy
        ' We need to cast the process off to a timer because the Connection.Cancel blocks the
        ' normal execution path.
        If m_lTimerID = 0 Then
           m_lTimerID = SetTimer(0, 0, 1, AddressOf TimerProc)
        End If
    End If
End Sub

次に、接続サロゲート クラスを作成しました。clsADOAsyncConn

Private WithEvents Connection As ADODB.Connection
Private m_Pending As Boolean
Public Event ConnectComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)

Public Property Get Provider() As String
    Provider = Connection.Provider
End Property

Public Property Let Provider(ByVal val As String)
    Connection.Provider = val
End Property

Public Property Get ConnectionTimeout() As Long
    ConnectionTimeout = Connection.ConnectionTimeout
End Property

Public Property Let ConnectionTimeout(ByVal val As Long)
    Connection.ConnectionTimeout = val
End Property

Public Property Get ConnectionString() As String
    ConnectionString = Connection.ConnectionString
End Property

Public Property Let ConnectionString(ByVal val As String)
    Connection.ConnectionString = val
End Property

Public Sub OpenAsync(Optional ByVal UserID As String = "", Optional ByVal Password As String = "")
    Connection.Open , UserID, Password, adAsyncConnect
    m_Pending = True
End Sub

Private Sub Class_Initialize()
    Set Connection = New ADODB.Connection
End Sub

Private Sub Class_Terminate()
    If Not Connection Is Nothing And m_Pending Then
        ' While the connection is still pending, when the user of this class reminates the refernce
        ' of this class, we need to cancel it in its own timer loop or else the caller's code will
        ' block at the point where the refernce to this object is de-referenced.
        CancelOrCloseAsync Connection
    End If
End Sub

Private Sub Connection_ConnectComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
    m_Pending = False

    ' Notify the object client of the connection state
    RaiseEvent ConnectComplete(pError, adStatus, pConnection)
End Sub

次に、元の接続コードを次のように更新します。

Set Connection = New clsADOAsyncConn
Connection.Provider = "SQLOLEDB"
Connection.ConnectionTimeout = 60
Connection.ConnectionString = "Initial Catalog=" & RTrim(DBName) & _
                                ";Data Source=" & RTrim(DBServerName) & ";Integrated Security = SSPI"

Connection.OpenAsync

実際の接続は、clsADOAsyncConn.ConnectCompleteイベントによって返されます。

このソリューションの唯一の既知の問題は、コードの通常の実行でブロックを防ぐのに役立ちますが、プロセスが終了すると (少なくとも最後の保留中の接続がタイムアウトするまで) ブロックが発生することです。

于 2013-07-18T07:55:18.953 に答える