VBA - 在引发异常之前检查System.ServiceModel.Channels.ServiceChannel发生故障状态

Question

我正在被迫连接到正在开发的VBA工具中的某些.net服务。我使用一个函数返回缓存的实例，或者创建一个新的函数，如果它尚未创建。

如果出现任何错误与对象（如连接超时），下一次我尝试使用它，我得到的错误

通信对象，System.ServiceModel.Channels.ServiceChannel ，因为它处于Faulted状态，所以不能用于通信。

我已经看到这个错误在网络上弹出，但所有的都有适当的语言，有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