VBA - проверить наличие сбойного состояния System.ServiceModel.Channels.ServiceChannel, прежде чем возникнет исключение

Question

Я вынужден подключиться к какой-то службе .net в инструменте VBA, который я разрабатываю. Я использую функцию для возврата кэшированного экземпляра или создания нового, если он еще не создан.

Если с объектом что-то не так (например, истекло время ожидания соединения), в следующий раз, когда я пытаюсь его использовать, я получаю сообщение об ошибке

Объект связи, System.ServiceModel.Channels.ServiceChannel, не может использоваться для связи, поскольку он находится в состоянии Failed.

Я видел эту ошибку, всплывающую по всей сети, но на всех языках, в которых есть блоки try-catch.

Вместо того, чтобы ждать появления этой ошибки при использовании кэшированного экземпляра и обрабатывать его в операторе «On Error Goto», я бы хотел предотвратить возникновение этой ошибки при извлечении кэшированного объекта для использования. Я нигде не мог найти объектную модель для этой вещи, и установка часов на инициализированный объект просто показывает. Какое свойство или тест я могу использовать во время поиска, чтобы определить, находится ли объект в неисправном состоянии?

Private Function GetMRLDIntegrationService() As Object
    Const ServiceAddress = "service:mexAddress=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/Mex""," & _
            "address=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/""," & _
            "contract=""IMrldSimplexIntegration"", contractNamespace=""http://tempuri.org/""," & _
            "binding=""SimplexIntegration"", bindingNamespace=""http://tempuri.org/"""
    Static cachedInstance As Object
    If Not cachedInstance Is Nothing Then
        ''//If *DETECT ERROR STATE HERE* Then Set cachedInstance = Nothing
    End If
    If cachedInstance Is Nothing Then Set cachedInstance = GetObject(ServiceAddress)
    If cachedInstance Is Nothing Then Err.Raise 1, , _
        "The MRLD server did not respond to the request to provide the service object."
    Set GetMRLDIntegrationService = cachedInstance
End Function

В другом месте, в другом методе, это место, где возникает ошибка, и это когда слишком поздно, чтобы элегантно разобраться с ошибкой:

Private Sub FillFromRiskID(ByVal riskID As String)
    ...
    Process_MRLD_Result GetMRLDIntegrationService().GetSerializedRisk(riskID, "1", uName, pWord)
    ...
End Sub

Спасибо за помощь

Answer 1

Это альтернативное решение дает функции GetService возможность сброса кэшированного объекта (т. Е. Если произошла ошибка), проблема в том, что я не могу найти способ использовать эту функцию так, чтобы ошибка состояния ошибки легко могла быть сброшена, нодругие ошибки не приводят к избыточным ошибочным запросам до обработки фактической ошибки.

Private Function GetMRLDIntegrationService(Optional ByVal reset As Boolean = False) As Object
    Const ServiceAddress = "service:mexAddress=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/Mex""," & _
            "address=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/""," & _
            "contract=""IMrldSimplexIntegration"", contractNamespace=""http://tempuri.org/""," & _
            "binding=""SimplexIntegration"", bindingNamespace=""http://tempuri.org/"""
    Static cachedInstance As Object
    If reset Then Set cachedInstance = Nothing
    If cachedInstance Is Nothing Then Set cachedInstance = GetObject(ServiceAddress)
    If cachedInstance Is Nothing Then Err.Raise 1, , _
        "The MRLD server did not respond to the request to provide the service object."
    Set GetMRLDIntegrationService = cachedInstance
End Function

И вызывающая функция:

''/*If the cached object is in an error state there's no way to detect it without making a request, but
'making even a dummy request each use just to check would waste dozens of precious seconds per request,
'so this routine carefully makes the intended request, catches the error that might occur, then resets
'the connection and tries the request again. The upside is that a service object in an error state
'will be resolved immediately and transparently by opening a new connection as needed. The downside
'is that if any other error occurs (such as a 1 minute timeout error), the first occurrence will
'be a non-breaking error and it will actually repeat the error a second time before notifying the user,
'doubling the amount of time it takes any error to propogate. (In the case of a 1 minute time-out
'occurring, the request would occur twice for a total of 2 minutes delay until the application becomes
'responsive again.)*/
Private Sub FillFromRiskID(ByVal riskID As String)
    Const uName As String = "perftest1"
    Const pWord As String = "****"
    Dim result As String

    On Error GoTo retryGet
    Process_MRLD_Result GetMRLDIntegrationService().GetSerializedRisk(riskID, "1", uName, pWord)
    GoTo finally
retryGet:
    Resume retryGet2: 'Resets the error state so that a new error can be thrown
retryGet2:
    On Error GoTo invalidConnection
    Process_MRLD_Result GetMRLDIntegrationService(reset:=True).GetSerializedRisk(riskID, "1", uName, pWord)
finally:
    Exit Sub
invalidConnection:
    MsgBox "Error connecting to MRLD: " & Err.Description, vbCritical, "Fill From MRLD"
End Sub

Answer 2

Это решение работает, но я стараюсь его избегать, потому что оно некрасиво и трата времени в большинстве случаев, когда нет ничего плохого в кэшированном объекте.В некоторых случаях для возврата GetSerializedRisk требуется 15 секунд, даже если возвращаемым значением является неверный логин или неверный идентификатор запроса.

Private Function GetMRLDIntegrationService() As Object
    Const ServiceAddress = "service:mexAddress=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/Mex""," & _
            "address=""net.tcp://hydfwdvweb001/Integration/MrldIntegrationService.svc/""," & _
            "contract=""IMrldSimplexIntegration"", contractNamespace=""http://tempuri.org/""," & _
            "binding=""SimplexIntegration"", bindingNamespace=""http://tempuri.org/"""
    Static cachedInstance As Object
    If Not cachedInstance Is Nothing Then
        ''If *DETECT ERROR STATE HERE* Then Set cachedInstance = Nothing
        On Error GoTo errorStateDetected
        cachedInstance.GetSerializedRisk "1", "1", "dummyrequest", "dummyrequest"
        GoTo everythingIsFine
errorStateDetected:
        Set cachedInstance = Nothing
        Resume everythingIsFine
everythingIsFine:
        ''//I just wasted a bunch of time
    End If
    If cachedInstance Is Nothing Then Set cachedInstance = GetObject(ServiceAddress)
    If cachedInstance Is Nothing Then Err.Raise 1, , _
        "The MRLD server did not respond to the request to provide the service object."
    Set GetMRLDIntegrationService = cachedInstance
End Function