Retrieving an array of objects from COM object.

[karlmdv]

Hi all,

I'm trying to pass an array of objects from a COM dll written in VB.Net, to a VB6 app. The point of this excersize is that's it's analogous to the behaviour of a web service client I'm writing to make web services available to a vb6 app.

This snippet illustrates the problem I'm having. Full code below.

    Dim Tester As New DotNetCOMTest.Class2
    Dim TesterObjectArray() As TestClass
    
    ' Attempt to get an array of objects
    TesterObjectArray = Tester.GetTestClasses ' Type Mismatch
    Set TesterObjectArray = Tester.GetTestClasses ' Can't assign to array
    Set TesterObjectArray() = Tester.GetTestClasses ' Can't assign to array

Is what I'm trying to do possible and I'm simply doing it wrong? If not I'll fall back to holding the array in the COM object and pulling out the items one at a time (which works ok).


VB.Net COM Class definition:

Imports System
Imports System.Runtime.InteropServices

Namespace Tester

    <Guid("89439AD1-756F-4f9c-BFB4-18236F63251E"), InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
        Public Interface _Class2
        <DispId(5)> Function LoopBack(ByRef b() As Integer) As Integer()
        <DispId(3)> Function GetTestClass() As TestClass
        <DispId(4)> Function GetTestClasses() As TestClass()
    End Interface

    <Guid("1376DE24-CC2D-46cb-8BF0-887A9CAF3014"), _
     ClassInterface(ClassInterfaceType.None), _
     ProgId("Tester.Test1")> Public Class Class2
        Implements _Class2

        Public Function GetTestClass() As TestClass Implements _Class2.GetTestClass
            Return New TestClass
        End Function
        Public Function GetTestClasses() As TestClass() Implements _Class2.GetTestClasses
            Dim Classes(2) As TestClass
            Classes(1) = New TestClass
            Classes(2) = New TestClass
            Return Classes
        End Function

        Public Function LoopBack(ByRef b() As Integer) As Integer() Implements _Class2.LoopBack
            Return b
        End Function
    End Class

    <Guid("89439AD1-756F-4f9c-BFB4-18236F63251F"), _
        InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
        Public Interface _TestClass

        <DispId(1)> Property TestInt() As Integer
        <DispId(2)> Property TestString() As String
        <DispId(3)> Property TestDouble() As Double
        <DispId(4)> Sub DumpVars()
    End Interface


    <Guid("1376DE24-CC2D-46cb-8BF0-887A9CAF3015"), _
     ClassInterface(ClassInterfaceType.None), _
     ProgId("Tester.TestClass")> Public Class TestClass
        Implements _TestClass
        Dim lString As String
        Dim lInt As Integer
        Dim lDouble As Double

        Public Property TestInt() As Integer Implements _TestClass.TestInt
            Get
                Return lInt
            End Get
            Set(ByVal value As Integer)
                lInt = value
            End Set
        End Property
        Public Property TestString() As String Implements _TestClass.TestString
            Get
                Return lString
            End Get
            Set(ByVal value As String)
                lString = value
            End Set
        End Property
        Public Property TestDouble() As Double Implements _TestClass.TestDouble
            Get
                Return lDouble
            End Get
            Set(ByVal value As Double)
                lDouble = value
            End Set
        End Property
        Public Sub DumpVars() Implements _TestClass.DumpVars
            MsgBox("String = " + lString + " Int = " + lInt.ToString + " Double = " + lDouble.ToString)
        End Sub
    End Class
End Namespace 

VB6 Client form:

Private Sub Form_Load()
    Dim TesterObject As TestClass
    Dim y() As Long
    Dim z() As Long
    Dim i As Integer
    
    ReDim y(5) As Long
    y(0) = 123
    y(1) = 222
    y(2) = 333
    
    ' Receiving a primative array from a COM object.
    z = Tester.LoopBack(y)
    
    ' See if our values have been preserved
    For i = 0 To UBound(z) - 1
        Debug.Print "Z" & i & " = " & z(i)
    Next i
    
    ' Get an instance of a UDT
    Set TesterObject = Tester.GetTestClass
    
    TesterObject.DumpVars
    
    Dim Tester As New DotNetCOMTest.Class2
    Dim TesterObjectArray() As TestClass
    
    ' Attempt to get an array of objects
    TesterObjectArray = Tester.GetTestClasses ' Type Mismatch
    Set TesterObjectArray = Tester.GetTestClasses ' Can't assign to array
    Set TesterObjectArray() = Tester.GetTestClasses ' Can't assign to array
    
    For i = 0 To UBound(d) - 1
        d(i).DumpVars
    Next i
End Sub