Search This Blog

Monday, May 7, 2012

Example of a COM Dll developed in VB.NET with the COM template

You can find here the code. It is a VS2008 solution file. Just use the .vb classes if you don't have VS2008 to open up the solution

I have already shown in my previous post how to create COM interop assembly in VB.NET and in C#.

You can have a look here and here. For More more detailed info please look also here
where you will find plenty of details on the how COM dll development and deployment works.

I will try to summarize some important point relevant to the VB.NET developer using the COM template here

1) The COM template automatically ticks for you
    Compile / Register for COM interop
    Application / Assembly Infomation... / Make assembly COM Visible
   
The second option is actually a bed idea, becuase it will register for COM all the types you declare in the assembly. If you have some assembly without the GUID it will create them for you generating a registry bloat.
So each time you add a COM Template, go and untick Make assembly COM-Visible.
Once you have done that you need to add as class attributes. (see the code)

2) If you define a Default Property, this will become a default property for your COM object as well. You can also have indexed properties. The ComClassAttribute will associate to it a DispId(0)

3) if you define a GeEnumerator() function that return a IEnumerator than you will enable the For Each ... Next
    loop in VBA. ComClassAttribute will associate to it a DispId(-4)

Public Function GetEnumerator() As System.Collections.IEnumerator Implements              System.Collections.IEnumerable.GetEnumerator
End Function

4) Also public events are exposed.


The code will show you how to create a Collection with a default property and the For Each ... Next loop enabled and how to expose and event.

Employee Class

Imports System.Runtime.InteropServices

<ComClass(Employee.ClassId, Employee.InterfaceId, Employee.EventsId), _
 ComVisible(True)> _
Public Class Employee

#Region "COM GUIDs"
    ' These  GUIDs provide the COM identity for this class 
    ' and its COM interfaces. If you change them, existing 
    ' clients will no longer be able to access the class.
    Public Const ClassId As String = "dd3ef2f6-261f-477d-af54-10abc39a07d9"
    Public Const InterfaceId As String = "a0680708-b5ca-4679-8e8e-1b012479b8ee"
    Public Const EventsId As String = "d7361527-7a80-4e47-9aff-4e603a26812b"
#End Region

    ' A creatable COM class must have a Public Sub New() 
    ' with no parameters, otherwise, the class will not be 
    ' registered in the COM registry and cannot be created 
    ' via CreateObject.
    Public Sub New()
        MyBase.New()
    End Sub

    Private _Name As String
    Public Property Name() As String
        Get
            Return _Name
        End Get
        Set(ByVal value As String)
            _Name = value
        End Set
    End Property
End Class 
 


 
Employer Class

Imports System.Runtime.InteropServices

<ComClass(Employer.ClassId, Employer.InterfaceId, Employer.EventsId), _
ComVisible(True)> _
Public Class Employer

#Region "COM GUIDs"
    ' These  GUIDs provide the COM identity for this class 
    ' and its COM interfaces. If you change them, existing 
    ' clients will no longer be able to access the class.
    Public Const ClassId As String = "a0513ce8-fac4-4187-8190-0584f59cda1e"
    Public Const InterfaceId As String = "2c55f846-2dc9-4f0f-9b82-5e16dfefee52"
    Public Const EventsId As String = "2f99d8e4-afe8-46ef-a4e0-d62b4db18a4d"
#End Region

    ' A creatable COM class must have a Public Sub New() 
    ' with no parameters, otherwise, the class will not be 
    ' registered in the COM registry and cannot be created 
    ' via CreateObject.
    Public Sub New()
        MyBase.New()
    End Sub

    Public Event OnNameChange(ByRef newName As String)

    Private _Name As String
    Public Property Name() As String
        Get
            Return _Name
        End Get
        Set(ByVal value As String)
            RaiseEvent OnNameChange(value)
            _Name = value

        End Set
    End Property

End Class

Collection Class


Imports System.Runtime.InteropServices


<ComClass(MyCol.ClassId, MyCol.InterfaceId, MyCol.EventsId), _
ComVisible(True)> _
Public Class MyCol
    Implements IEnumerable

#Region "COM GUIDs"
    ' These  GUIDs provide the COM identity for this class 
    ' and its COM interfaces. If you change them, existing 
    ' clients will no longer be able to access the class.
    Public Const ClassId As String = "994ba5ce-1301-455b-9334-409e28aea0c3"
    Public Const InterfaceId As String = "87280e58-8be8-40f8-8987-d3fac317c6c3"
    Public Const EventsId As String = "11d12ead-4562-4ab1-a04b-5ef7fa9fba4c"
#End Region

    ' A creatable COM class must have a Public Sub New() 
    ' with no parameters, otherwise, the class will not be 
    ' registered in the COM registry and cannot be created 
    ' via CreateObject.
    Dim _SortedList As SortedList
    Public Sub New()
        MyBase.New()
        _SortedList = New SortedList
    End Sub

    Default Public Property Item(ByVal key As Object)
        Get
            Return _SortedList(key)
        End Get
        Set(ByVal value)
            _SortedList(key) = value

        End Set
    End Property

    Public ReadOnly Property Count()
        Get
            Return _SortedList.Count
        End Get
    End Property


    Public Sub Remove(ByVal key As Object)
        _SortedList.Remove(key)
    End Sub


    Public Sub Add(ByVal key As Object, ByVal value As Object)
        _SortedList.Add(key, value)
    End Sub


    Public Function GetEnumerator() As System.Collections.IEnumerator Implements System.Collections.IEnumerable.GetEnumerator
        'Return _SortedList.GetEnumerator()
        Dim keys As ICollection = _SortedList.Keys
        Return CType(keys.GetEnumerator, IEnumerator)
    End Function
End Class



VBA Code to test the class


Option Explicit
Dim WithEvents a As TestCOMVisible01.Employer


Sub prova()
If a Is Nothing Then
   Set a = New TestCOMVisible01.Employer
End If
a.Name = "Gino"

Debug.Print a.Name

Dim emp1 As New TestCOMVisible01.Employee
Dim emp2 As New TestCOMVisible01.Employee
Dim col As New TestCOMVisible01.MyCol

emp1.Name = "mario"
emp2.Name = "pluto"
Call col.Add("1", emp1)
Call col.Add("2", emp2)

Dim key As Variant
For Each key In col
 Debug.Print col(key).Name
 Next




End Sub

Private Sub a_OnNameChange(newName As String)
   newName = "ho cambiato il nome"
End Sub

No comments:

Post a Comment