PRB: CallByName Fails to Return the Correct Error Information (194418)

MORE INFORMATION

Create a Test Server

1. Start Visual Basic and create a new ActiveX DLL project. Class1 is created by default.
2. Rename the project TestSvr.
3. Add the following code to Class1:

         Option Explicit
   
         Private strObjName As String
   
         Private Sub Class_Initialize()
            strObjName = "Default Name"
         End Sub
   
         Public Property Get ObjectName() As String
            ObjectName = strObjName
         End Property
   
         Public Property Let ObjectName(s As String)
            strObjName = s
         End Property
   
         Public Property Get ObjectNameWithErr() As String
            ObjectNameWithErr = strObjName
            ' User-defined error numbers should be between 513 and 65535
            ' plus vbObjectError Numbers below 513 are reserved.
            ' The vbObjectError is equivalent to FACILITY_ITF (&H80040000).
            ' You need to add this constant because everything made public
            ' in VB is on an interface.
            ' We are arbitrarily choosing 1000 below.
            Err.Raise vbObjectError + 1000, _
               "Error in " & App.EXEName & ".ObjectNameWithErr", _
               "User defined error"
         End Property
   
         Public Property Let ObjectNameWithErr(s As String)
            strObjName = s
   
            Err.Raise vbObjectError + 1000, _
               "Error in " & App.EXEName & ".ObjectNameWithErr", _
               "User defined error"
         End Property
   
         Public Function ConcatString _
            (s1 As String, s2 As String) As String
            ConcatString = s1 & s2
         End Function
   
         Public Function ConcatStringWithErr _
            (s1 As String, s2 As String) As String
            ConcatStringWithErr = s1 & s2
   
            Err.Raise vbObjectError + 1000, _
               "Error in " & App.EXEName & ".ConcatStringWithErr", _
               "User defined error"
         End Function
   
   						

4. Compile the project. If you want to run the server in the IDE, select Options from the Tools menu, and select "Break on Unhandled Errors" under "Error Trapping" on the General Tab.

Create a Test Client

1. Create a new Standard EXE project in Microsoft Visual Basic. Form1 is created by default.
2. Select References from the Project menu, and add "TypeLib Information" (TLBINF32.DLL) to the reference list.
3. Add a ComboBox, two CommandButtons, a Frame, and two OptionButtons inside the frame to Form1.
4. Add the following code to Form1's code window:

         Option Explicit
   
         Private objServer As Object
         Private IFaceInfo As TLI.InterfaceInfo
   
         Private Sub Command1_Click()
            ' This subroutine demonstrates the problem with returned errors
            ' when CallByName() is used.
            On Error GoTo Command1Handler
            Select Case Combo1.ListIndex
            Case 0, 2
               If Option1.Value Then
                  Call CallByName(objServer, _
                                  Combo1.Text, _
                                  VbLet, _
                                  App.EXEName)
               Else
                  MsgBox CallByName(objServer, _
                                    Combo1.Text, _
                                    VbGet)
               End If
            Case 1, 3
                MsgBox CallByName(objServer, _
                                  Combo1.Text, _
                                  VbMethod, _
                                  "Parameter1", _
                                  "Parameter2")
            End Select
            Exit Sub
         Command1Handler:
            MsgBox Err.Number & vbCrLf & Err.Source & vbCrLf & Err.Description
         End Sub
   
         Private Sub Command2_Click()
            ' This subroutine demonstrates a workaround for the problem
            ' shown in the Command1_Click subroutine.
            Dim sResults As TLI.SearchResults
            Dim sItem As TLI.SearchItem
            On Error GoTo Command2Handler
            Set IFaceInfo = TLI.InterfaceInfoFromObject(objServer)
            Set sResults = IFaceInfo.Members.GetFilteredMembers
   
            With sResults
               For Each sItem In sResults
                  If sItem.Name = Combo1.Text Then
                     Select Case Combo1.ListIndex
                        Case 0, 2
                           If Option1.Value = True Then
                               Call TLI.InvokeHook(objServer, _
                                                   sItem.MemberId, _
                                                   INVOKE_PROPERTYPUT, _
                                                   App.EXEName)
                           Else
                               MsgBox TLI.InvokeHook(objServer, _
                                                     sItem.MemberId, _
                                                     INVOKE_PROPERTYGET)
                           End If
                        Case 1, 3
                           Dim vArg(1) As Variant
                           vArg(0) = "Parameter2": vArg(1) = "Parameter1"
                           ' The variant array elements are passed in reverse
                           ' order, that is the 0th element first
                           MsgBox TLI.InvokeHookArray(objServer, _
                                                      sItem.MemberId, _
                                                      INVOKE_FUNC, _
                                                      vArg)
                     End Select
                  End If
               Next
            End With
            Exit Sub
         Command2Handler:
            ' Please note that the error number will be the raw error number
            ' raised in the server.
            ' To get the equivalent error number of VB, subtract vbObjectError
            ' from Err.Number.
            MsgBox (Err.Number - vbObjectError) & vbCrLf & Err.Source & _
                  vbCrLf & Err.Description
         End Sub
   
         Private Sub Form_Load()
             Command1.Caption = "&CallByName"
             Command2.Caption = "&InvokeHook"
             Option1.Caption = "Property &Let"
             Option2.Value = True
             Option2.Caption = "Property &Get"
             With Combo1
                 .AddItem "ObjectName"
                 .AddItem "ConcatString"
                 .AddItem "ObjectNameWithErr"
                 .AddItem "ConcatStringWithErr"
                 .ListIndex = 0
             End With
             Set objServer = CreateObject("TestSvr.Class1")
         End Sub
   
         Private Sub Form_Unload(Cancel As Integer)
             Set objServer = Nothing
         End Sub
   						

5. Run the project.
   
   When you access the ObjectNameWithErr property or call the ConcatStringWithErr function using CallByName(), the error object you received has the following error information regardless of the error raised in the server:

            Number: 440
            Source: Name of the application
            Description: Automation error
   
   						

   To get the correct error object, use the InvokeHook set of functions as shown in the Click event of Command2.