none
求VB.net可以转成VB6吗 RRS feed

  • 常规讨论

  • 谁能帮我转一段程序。

    Imports System.Reflection
    Imports System.Threading

    Namespace MyRTD
    '''
    ''' This console application is a client for an
    ''' Excel real-time data (RTD) server. It works
    ''' by emulating the low level method calls
    ''' and interactions that Excel makes when
    ''' using a RTD.
    '''
    Class Program
    ' ProgIDs for COM components.
    Private Const RTDProgID As [String] = "MyRTD.RTD"
    Private Const RTDUpdateEventProgID As [String] = "MyRTD.UpdateEvent"
    Private Const RTDEXEProgID As [String] = "MyRTDEXE.RTD"
    Private Const RTDEXEUpdateEventProgID As [String] = "MyRTDEXE.UpdateEvent"

    ' Dummy topic.
    Private Const topicID As Integer = 12345
    Private Const topic As [String] = "topic"

    ' Test both in-process (DLL) and out-of-process (EXE)
    ' RTD servers.
    Private Shared Sub Main(args As String())
    Console.WriteLine("Test in-process (DLL) RTD server.")
    TestMyRTD(RTDProgID, RTDUpdateEventProgID)

    Console.WriteLine("Test out-of-process (EXE) RTD server.")
    TestMyRTD(RTDEXEProgID, RTDEXEUpdateEventProgID)

    Console.WriteLine("Press enter to exit ...")
    Console.ReadLine()
    End Sub

    ' Test harness that emulates the interaction of
    ' Excel with an RTD server.
    Private Shared Sub TestMyRTD(rtdID As [String], eventID As [String])
    Try
    ' Create the RTD server.
    Dim rtd As Type
    Dim rtdServer As [Object] = Nothing
    rtd = Type.GetTypeFromProgID(rtdID)
    rtdServer = Activator.CreateInstance(rtd)
    Console.WriteLine("rtdServer = {0}", rtdServer.ToString())

    ' Create a callback event.
    Dim update As Type
    Dim updateEvent As [Object] = Nothing
    update = Type.GetTypeFromProgID(eventID)
    updateEvent = Activator.CreateInstance(update)
    Console.WriteLine("updateEvent = {0}", updateEvent.ToString())

    ' Start the RTD server passing in the callback
    ' object.
    Dim param As [Object]() = New [Object](0) {}
    param(0) = updateEvent
    Dim method As MethodInfo = rtd.GetMethod("ServerStart")
    Dim ret As [Object]
    ' Return value.
    ret = method.Invoke(rtdServer, param)
    Console.WriteLine("ret for 'ServerStart()' = {0}", ret.ToString())

    ' Request data from the RTD server.
    Dim topics As [Object]() = New [Object](0) {}
    topics(0) = topic
    Dim newData As [Boolean] = True
    ' Request new data, not cached data.
    param = New [Object](2) {}
    param(0) = topicID
    param(1) = topics
    param(2) = newData
    method = rtd.GetMethod("ConnectData")
    ret = method.Invoke(rtdServer, param)
    Console.WriteLine("ret for 'ConnectData()' = {0}", ret.ToString())

    ' Loop and wait for RTD to notify (via callback) that
    ' data is available.
    Dim count As Integer = 0
    Do
    count += 1

    ' Check that the RTD server is still alive.
    Dim status As [Object]
    param = Nothing
    method = rtd.GetMethod("Heartbeat")
    status = method.Invoke(rtdServer, param)
    Console.WriteLine("status for 'Heartbeat()' = {0}", status.ToString())

    ' Get data from the RTD server.
    Dim topicCount As Integer = 0
    param = New [Object](0) {}
    param(0) = topicCount
    method = rtd.GetMethod("RefreshData")
    Dim retval As [Object](,) = New [Object](1, 0) {}
    retval = DirectCast(method.Invoke(rtdServer, param), [Object](,))
    Console.WriteLine("retval for 'RefreshData()' = {0}", retval(1, 0).ToString())

    ' Wait for 2 seconds before getting
    ' more data from the RTD server. This
    ' it the default update period for Excel.
    ' This client can requested data at a
    ' much higher frequency if wanted.

    Thread.Sleep(2000)
    Loop While count < 5
    ' Loop 5 times for test.
    ' Disconnect from data topic.
    param = New [Object](0) {}
    param(0) = topicID
    method = rtd.GetMethod("DisconnectData")
    method.Invoke(rtdServer, param)

    ' Shutdown the RTD server.
    param = Nothing
    method = rtd.GetMethod("ServerTerminate")
    method.Invoke(rtdServer, param)
    Catch e As Exception
    Console.WriteLine("Error: {0} ", e.Message)
    End Try
    End Sub
    End Class
    End Namespace
    2011年7月4日 9:05

全部回复