Implementing RTD in VB

[ajwillshire]

Hi,

 

I'm trying to implement the Ticking Clock RTD example in VB.NET and for some reason it's not working - the function just returns #N/A. I put the original C# code through a code converter and the only bit it couldn't figure out properly was the Event Handler in RefreshData so I wonder if I've fixed that properly. Here's the translated code, identically laid out to the original example. If anyone can tell me why it's going wrong, I'd be very grateful. I'm running it out of Visual Studio and I can make the C# version work immediately from a class library but I need VB for compatibility with other projects.

Thanks,

Andrew

 

Imports System
Imports System.Collections.Generic
Imports System.IO
Imports System.Text
Imports System.Net
Imports System.Xml
Imports System.Runtime.InteropServices
Imports System.Diagnostics
Imports System.Windows.Forms
Imports ExcelDna.Integration
Imports ExcelDna.Integration.Rtd

 

Public NotInheritable Class TestRtdFunctions
    Private Sub New()
    End Sub

 

    <ExcelFunction(Name:="Test")> _
    Public Shared Function Test(name As String) As Object(,)
        Dim result As Object = XlCall.RTD("MyRTDServers.TimeServer", Nothing, "NOW")
        Return New Object(,) {{result}}
    End Function

 

    Public Shared Function WhatTimeIsIt() As Object
        Return XlCall.RTD("MyRTDServers.TimeServer", Nothing, "NOW")
    End Function

    Shared _dataPath As String

    Shared Sub New()
        Dim xllDir As String = Path.GetDirectoryName(DirectCast(XlCall.Excel(XlCall.xlGetName), String))
        _dataPath = Path.Combine(xllDir, "Test.xml")
    End Sub

 

    Public Shared Function GetTestItem(itemPath As String) As Object
        Return XlCall.RTD("MyRTDServers.TestServer", Nothing, _dataPath, itemPath)
    End Function

 

    Public Shared Function GetEurOnd() As Object
        Return GetTestItem("EUR/OND")
    End Function

End Class

 

Namespace MyRTDServers

    ' Need Guid here to support direct =RTD(...).
    ' Call Regsvr32 <MyAddin>.xll
    ' or ComServer.DllRegisterServer()
    ' to register.
    ' [ProgId("TestComServer.TimeServer"),
    <Guid("069F88AB-840D-4149-A33F-286BDD69CE48")> _
    <ComVisible(True)> _
    Public Class TimeServer
        Implements IRtdServer
        Private _callback As IRTDUpdateEvent
        Private _timer As Timer
        Private _topicId As Integer

 

#Region "IRtdServer Members"

        Public Function ConnectData(topicId As Integer, ByRef Strings As Array, ByRef GetNewValues As Boolean) As Object Implements IRtdServer.ConnectData
            Console.Beep()
            _topicId = topicId
            _timer.Start()
            Return GetTime()
        End Function

 

        Public Sub DisconnectData(topicId As Integer) Implements IRtdServer.DisconnectData

            _timer.[Stop]()
        End Sub

 

        Public Function Heartbeat() As Integer Implements IRtdServer.Heartbeat
            Return 1
        End Function

 

        Public Function RefreshData(ByRef topicCount As Integer) As Array Implements IRtdServer.RefreshData
            Dim results As Object(,) = New Object(1, 0) {}
            results(0, 0) = _topicId
            results(1, 0) = GetTime()

            topicCount = 1
            _timer.Start()

            Return results
        End Function

 

        Public Function ServerStart(CallbackObject As IRTDUpdateEvent) As Integer Implements IRtdServer.ServerStart
            Console.Beep()
            Console.Beep()
            Console.Beep()
            _callback = CallbackObject
            _timer = New Timer()
            AddHandler _timer.Tick, New EventHandler(AddressOf Callback)
            _timer.Interval = 500
            Return 1
        End Function

 

        Public Sub ServerTerminate() Implements IRtdServer.ServerTerminate
            Console.Beep()
            Console.Beep()
            If _timer IsNot Nothing Then
                _timer.Dispose()
                _timer = Nothing
            End If
        End Sub

 

#End Region

        Private Sub Callback(sender As Object, e As EventArgs)
            _timer.Stop()
            _callback.UpdateNotify()
        End Sub

        Private Function GetTime() As String
            Return DateTime.Now.ToString("HH:mm:ss.fff")
        End Function
    End Class

 

    <ComVisible(True)> _
    Public Class TestServer
        Implements IRtdServer
        Private _topics As Dictionary(Of Integer, Topic)
        Private _callback As IRTDUpdateEvent
        Private _timer As System.Windows.Forms.Timer
        Private _xml As XmlDocument

 

#Region "IRtdServer Members"

        Public Function ConnectData(TopicID As Integer, ByRef Strings As Array, ByRef GetNewValues As Boolean) As Object Implements IRtdServer.ConnectData
            If Strings.Length <> 2 Then
                Throw New Exception("Expecting TICKER")
            End If

            Dim filename As String = TryCast(Strings.GetValue(0), String)
            If filename Is Nothing OrElse filename.Length = 0 Then
                Throw New Exception("Expecting FILENAME")
            End If
            Dim ticker As String = TryCast(Strings.GetValue(1), String)
            If ticker Is Nothing OrElse ticker.Length = 0 Then
                Throw New Exception("Expecting TICKER")
            End If

            _topics.Add(TopicID, New Topic(filename, ticker))

            Return "Queued"
        End Function

 

        Public Sub DisconnectData(TopicID As Integer) Implements IRtdServer.DisconnectData
            _topics.Remove(TopicID)
        End Sub

 

        Public Function Heartbeat() As Integer Implements IRtdServer.Heartbeat
            Return 1
        End Function

 

        Public Function RefreshData(ByRef TopicCount As Integer) As Array Implements IRtdServer.RefreshData
            Dim results As Object(,) = New Object(1, _topics.Count - 1) {}
            TopicCount = 0

            For Each topicID As Integer In _topics.Keys
                If _topics(topicID).Updated = True Then
                    results(0, TopicCount) = topicID
                    results(1, TopicCount) = _topics(topicID).Value + " : " + Convert.ToString(DateTime.Now)
                    TopicCount += 1
                End If
            Next

            Dim temp As Object(,) = New Object(1, TopicCount - 1) {}
            For i As Integer = 0 To TopicCount - 1
                temp(0, i) = results(0, i)
                temp(1, i) = results(1, i)
            Next

            Return temp
        End Function

 

        Public Function ServerStart(CallbackObject As IRTDUpdateEvent) As Integer Implements IRtdServer.ServerStart
            _topics = New Dictionary(Of Integer, Topic)()
            _callback = CallbackObject
            _timer = New System.Windows.Forms.Timer()
            AddHandler _timer.Tick, New EventHandler(AddressOf Callback)
            _timer.Interval = 2000
            _timer.Start()
            _xml = New XmlDocument()

            Return 1
        End Function

 

        Public Sub ServerTerminate() Implements IRtdServer.ServerTerminate
            _timer.Dispose()
            _topics = Nothing
            _xml = Nothing
        End Sub

 

#End Region

        Private Sub Callback(sender As Object, e As EventArgs)

            SyncLock _topics
                Try
                    For Each x As KeyValuePair(Of Integer, Topic) In _topics
                        GetDataFromXML(x.Value)
                    Next
                Catch generatedExceptionName As Exception
                End Try
            End SyncLock

            _callback.UpdateNotify()
        End Sub

 

        Private Sub GetDataFromXML(topic As Topic)
            _xml.Load(topic.FileName)
            Dim node As XmlNode = _xml.SelectSingleNode("//" + topic.Ticker)
            topic.Value = node.InnerText
        End Sub
    End Class

 

    Public Class Topic
        Private iFileName As String
        Private iTicker As String
        Private iValue As String
        Private iUpdated As Boolean

        Public Property FileName() As String
            Get
                Return iFileName
            End Get
            Set(value As String)
                iFileName = value
            End Set
        End Property

        Public Property Ticker() As String
            Get
                Return iTicker
            End Get
            Set(value As String)
                iTicker = value
            End Set
        End Property

        Public Property Value() As String
            Get
                Return iValue
            End Get
            Set(value As String)
                If iValue <> value Then
                    iValue = value
                    iUpdated = True
                Else
                    iUpdated = False
                End If
            End Set
        End Property

        Public Property Updated() As Boolean
            Get
                Return iUpdated
            End Get
            Set(value As Boolean)
                iUpdated = value
            End Set
        End Property

      Public Sub New(File As String, TickerName As String)
            iFileName = File
            iTicker = TickerName
            iValue = ""
        End Sub
    End Class
End Namespace

 

 

[Govert van Drimmelen]

Hi Andrew,

One possible issue is how the namespaces work in VB.NET projects. In the Project Properties page you'll see a 'Root Namespace' setting. If this is set (by default to the project name) then that namespace is used as the root, even when you specify a namespace. Then the RTD activation fails. For example, if your project is called "MyProject" with the code you post in, then you need to make the RTD call as:

Return XlCall.RTD("MyProject.MyRTDServers.TimeServer", Nothing, "NOW")

Perhaps best is to make sure there is no 'Root Namespace' for the project - then things will be more explicit.

I would anyway strongly suggest you rather use the thread-safe ExcelRtdServer base class, rather than implementing IRtdServer yourself. As a start, I paste some code below (which again needs a VB project with no 'Root Namespace' set up).

Regards,

Govert

'''''''''''''''''''''''

' The exported functions

Imports ExcelDna.Integration

Public Module MyFunctions

    <ExcelFunction(Description:="My first .NET function")> _

    Public Function HelloDna(name As String) As String

        Return "Hello " & name

    End Function

    Public Function GetTheTime()

        Return XlCall.RTD("RtdTest.MyRtdServer", Nothing, "NOW")

    End Function

End Module

'''''''''''''''''''''''

' The RTD server using the ExcelRtdServer base class.

Imports ExcelDna.Integration.Rtd

Imports System.Threading

Imports System.Runtime.InteropServices

Namespace RtdTest

    <ComVisible(True)> _

    Public Class MyRtdServer

        Inherits ExcelRtdServer

        Dim myTimer As Timer

        Dim myTopic As Topic

        Protected Overrides Function ServerStart() As Boolean

            myTimer = New Timer(AddressOf Tick, Nothing, 1000, 1000)

            Return True

        End Function

        Protected Overrides Sub ServerTerminate()

            myTimer = Nothing

        End Sub

        Protected Overrides Function ConnectData(topic As Topic, topicInfo As IList(Of String), ByRef newValues As Boolean) As Object

            ' For test just keeping track of the last one connected, and ignoring the topicInfo strings.

            myTopic = topic

            Return GetTime()

        End Function

        Protected Overrides Sub DisconnectData(topic As Topic)

            If myTopic.Equals(topic) Then

                myTopic = Nothing

            End If

        End Sub

        Private Sub Tick(ByVal state As Object)

            If Not myTopic Is Nothing Then

                myTopic.UpdateValue(GetTime())

            End If

        End Sub

        Private Function GetTime() As String

            Return DateTime.Now.ToString("HH:mm:ss.fff")

        End Function

    End Class

End Namespace

[ajwillshire]

Hi Govert,

 

Thanks for the quick response. You were right about the Namespaces in VB and also right that the ExcelRtdServer is definitely the way to go!

 

How can I change the refresh rate? I'm trying to connect to some electronics through the serial port and it would be great if I could get it updating in 10ths of seconds rather than 2 seconds.

 

Thanks a lot for your help,

 

Andrew

[ajwillshire]

Hi,

 

Don't worry - I found it!

 

Application.RTD.ThrottleInterval = 1000 ' / whatever

 

from the VBA immediate window.

 

Thanks

Andrew

 

 

On Sunday, 23 June 2013 19:58:30 UTC+1, Govert van Drimmelen wrote:

[Govert van Drimmelen]

Hi Andrew,

I'm glad it's sorted out.

You just need to be a bit careful with the ThrottleInterval:

* It is a global setting

* It is persistent across sessions

* If too low, Excel can become unstable because the recalculation doesn't catch up to the RTD updates. I think the ExcelRtdServer base class helps a bit in this case too.

It might be a good idea to reset the ThrottleInterval to a fairly large value, or the default of 200 ms, when your add-in starts. And then have a way to decrease it explicitly.

There is a sample in the Distribution\Samples\RTD\RealTimeManager.dna which does something like this.

Cheers,

Govert

[Govert van Drimmelen]

Sorry - the default ThrottleInterval is 2000 ms.

-Govert