vb求救,RTD (real_time_data )客户端

suqing2005 2011-06-30 04:32:58
我想用VB做一个类似于excel的RTD (real_time_data )客户端。


有服务端的代码范例,来自微软。


建立範例 RealTimeData 伺服器
下列範例將告訴您,如何利用 Microsoft Excel 2002 建立和使用 RealTimeData 伺服器。此伺服器只會在工作表上提供每 10 秒更新一次的計數器。伺服器最多可接受兩個主題字串。第一個主題字串可以是 AAA、BBB 和 CCC,而任何其他主題字串會被視為無效,並且伺服器會傳回 #VALUE! 至 RTD 函數。第二個字串是數值,表示傳回值該如何遞增。如果省略第二個字串,遞增值會預設為 1;如果第二個字串不是數值,則伺服器會傳回 #NUM! 至 RTD 函數。
在 Visual Basic 中開啟新的 ActiveX DLL 專案。
在 [專案] 功能表上,按一下 [參考],選取 Excel 的物件程式庫,然後按一下 [確定]。
在 Microsoft Excel 2002 中:[Microsoft Excel 10.0 物件程式庫]
在 Microsoft Office Excel 2003 中:[Microsoft Excel 11.0 物件程式庫]
在 [專案] 功能表上,按一下 [Project1 屬性]。將 [專案名稱] 變更為 ExcelRTD,然後按一下 [確定]。
將 Class1 類別模組的 Name 屬性變更為 RTDFunctions。將下列程式碼加入至 RTDFunctions:
Option Explicit

Implements IRtdServer 'Interface allows Excel to contact this RealTimeData server

Private m_colTopics As Collection

Private Function IRtdServer_ConnectData(ByVal TopicID As Long, Strings() As Variant, GetNewValues As Boolean) As Variant
'** ConnectData is called whenever a new RTD topic is requested

'Create a new topic class with the given TopicId and string and add it to the
'm_colTopics collection
Dim oTopic As New Topic
m_colTopics.Add oTopic, CStr(TopicID)
oTopic.TopicID = TopicID
oTopic.TopicString = Strings(0)
If UBound(Strings) >= 1 Then oTopic.SetIncrement Strings(1)

'For this example, the initial value for a new topic is always 0
IRtdServer_ConnectData = oTopic.TopicValue

Debug.Print "ConnectData", TopicID
End Function

Private Sub IRtdServer_DisconnectData(ByVal TopicID As Long)
'** DisconnectData is called whenever a specific topic is not longer needed

'Remove the topic from the collection
m_colTopics.Remove CStr(TopicID)

Debug.Print "DisconnectData", TopicID
End Sub

Private Function IRtdServer_Heartbeat() As Long
'** Called by Excel if the heartbeat interval has elapsed since the last time
' Excel was called with UpdateNotify.
Debug.Print "HeartBeat"
End Function

Private Function IRtdServer_RefreshData(TopicCount As Long) As Variant()
'** Called when Excel is requesting a refresh on topics. RefreshData will be called
' after an UpdateNotify has been issued by the server. This event should:
' - supply a value for TopicCount (number of topics to update)
' - return a two dimensional variant array containing the topic ids and the
' new values of each.

Dim oTopic As Topic, n As Integer
ReDim aUpdates(0 To 1, 0 To m_colTopics.Count - 1) As Variant
For Each oTopic In m_colTopics
oTopic.Update
aUpdates(0, n) = oTopic.TopicID
aUpdates(1, n) = oTopic.TopicValue
n = n + 1
Next
TopicCount = m_colTopics.Count
IRtdServer_RefreshData = aUpdates

Debug.Print "RefreshData", TopicCount & " topics updated"
End Function

Private Function IRtdServer_ServerStart(ByVal CallbackObject As Excel.IRTDUpdateEvent) As Long
'** ServerStart is called when the first RTD topic is requested

Set oCallBack = CallbackObject
Set m_colTopics = New Collection
g_TimerID = SetTimer(0, 0, TIMER_INTERVAL, AddressOf TimerCallback)
If g_TimerID > 0 Then IRtdServer_ServerStart = 1 'Any value <1 indicates failure.

Debug.Print "ServerStart"
End Function

Private Sub IRtdServer_ServerTerminate()
'** ServerTerminate is called when no more topics are needed by Excel.

KillTimer 0, g_TimerID

'** Cleanup any remaining topics. This is done here since
' IRtdServer_DisconnectData is only called if a topic is disconnected
' while the book is open. Items left in the collection when we terminate
' are those topics left running when the workbook was closed.

Dim oTopic As Topic
For Each oTopic In m_colTopics
m_colTopics.Remove CStr(oTopic.TopicID)
Set oTopic = Nothing
Next

Debug.Print "ServerTerminate"

End Sub



在 [專案] 功能表上,按一下 [加入類別模組]。將類別模組 Name 屬性變更為 Topic,並將 Instancing 屬性變更為 Private。將下列程式碼加入至 Topic 類別模組:
Option Explicit

Private m_TopicID As Long
Private m_TopicString As String
Private m_Value As Variant
Private m_IncrementVal As Long

Private Sub Class_Initialize()
m_Value = 0
m_IncrementVal = 1
End Sub

Friend Property Let TopicID(ID As Long)
m_TopicID = ID
End Property

Friend Property Get TopicID() As Long
TopicID = m_TopicID
End Property

Friend Property Let TopicString(s As String)
s = UCase(s)
If s = "AAA" Or s = "BBB" Or s = "CCC" Then
m_TopicString = s
Else
m_Value = CVErr(xlErrValue) 'Return #VALUE if not one of the listed topics
End If
End Property

Friend Sub Update()
On Error Resume Next 'the next operation will fail if m_Value is an error (like #NUM or #VALUE)
m_Value = m_Value + m_IncrementVal
End Sub

Friend Sub SetIncrement(v As Variant)
On Error Resume Next
m_IncrementVal = CLng(v)
If Err <> 0 Then
m_Value = CVErr(xlErrNum) 'Return #NUM if Increment value is not numeric
End If
End Sub

Friend Property Get TopicValue() As Variant
If Not (IsError(m_Value)) Then
TopicValue = m_TopicString & ": " & m_Value
Else
TopicValue = m_Value
End If
End Property


在 [專案] 功能表上,選取 [加入模組]。將下列程式碼加入至新的模組:
Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long

Public Const TIMER_INTERVAL = 5000
Public oCallBack As Excel.IRTDUpdateEvent
Public g_TimerID As Long

Public Sub TimerCallback(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
oCallBack.UpdateNotify
End Sub


在 [檔案] 功能表上,按一下 [建立 ExcelRTD.dll] 以建置元件。










...全文
432 2 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
2 条回复
切换为时间正序
请发表友善的回复…
发表回复
suqing2005 2011-07-01
  • 打赏
  • 举报
回复
求救,請大家幫助
suqing2005 2011-06-30
  • 打赏
  • 举报
回复
以上范例可以执行,在EXCEL里可以自动加上数据。


现在想求哪位高手可以帮我写一段“客户端”的代码,不要调用EXCEL的RTD(),而是用COM在底层调用相关方法。

有一段用python写的代码,可以参考:



import pythoncom

from win32com import client, universal
from win32com.server.util import wrap

# Thanks to Chris Nilsson for these constants.
# Typelib info for Excel 2007.
EXCEL_TLB_GUID = '{00020813-0000-0000-C000-000000000046}'
EXCEL_TLB_LCID = 0
EXCEL_TLB_MAJOR = 1
EXCEL_TLB_MINOR = 6

# Register the two RTD interfaces defined in the Excel typelib.
universal.RegisterInterfaces(EXCEL_TLB_GUID,
EXCEL_TLB_LCID, EXCEL_TLB_MAJOR, EXCEL_TLB_MINOR,
['IRtdServer','IRTDUpdateEvent'])
MAX_REGISTERED_TOPICS = 1024

class RTDClient(object):
"""
Implements a Real-Time-Data (RTD) client for accessing
COM datasources that provide an IRtdServer interface.

- Implements the IRTDUpdateEvent interface and if used
in event driven mode only calls RefreshData when
new data is available.

"""

_com_interfaces_ = ['IRTDUpdateEvent']
_public_methods_ = ['Disconnect', 'UpdateNotify']
_public_attrs_ = ['HeartbeatInterval']

def __init__(self, classid):
self._classid = classid
self._rtd = None

self._data_ready = False

self._topic_to_id = {}
self._id_to_topic = {}
self._topic_values = {}
self._last_topic_id = 0

def connect(self, event_driven=True):
"""
Connects to the RTD server.

Set event_driven to false if you to disable update notifications.
In this case you'll need to call refresh_data manually.

"""

dispatch = client.Dispatch(self._classid)
self._rtd = client.CastTo(dispatch, 'IRtdServer')
if event_driven:
self._rtd.ServerStart(wrap(self))
else:
self._rtd.ServerStart(None)

def update(self):
"""
Check if there is data waiting and call RefreshData if
necessary. Returns True if new data has been received.

Note that you should call this following a call to
pythoncom.PumpWaitingMessages(). If you neglect to
pump the message loop you'll never receive UpdateNotify
callbacks.

"""
if self._data_ready:
self._data_ready = False
self.refresh_data()
return True
else:
return False

def refresh_data(self):
"""
Grabs new data from the RTD server.

"""

(ids, values), count = self._rtd.RefreshData(MAX_REGISTERED_TOPICS)
for id, value in zip(ids, values):
assert id in self._id_to_topic
topic = self._id_to_topic[id]
self._topic_values[topic] = value

def get(self, topic):
"""
Gets the value of a registered topic. Returns None
if no value is available. Throws an exception if
the topic isn't registered.

"""

assert topic in self._topic_to_id, 'Topic %s not registered.' % (topic,)
return self._topic_values.get(topic)

def register_topic(self, topic):
"""
Registers a topic with the RTD server. The topic's value
will be updated in subsequent data refreshes.

"""

if topic not in self._topic_to_id:
id = self._last_topic_id
self._last_topic_id += 1

self._topic_to_id[topic] = id
self._id_to_topic[id] = topic

self._rtd.ConnectData(id, (topic,), True)

# Implementation of IRTDUpdateEvent.
HeartbeatInterval = -1

def UpdateNotify(self):
self._data_ready = True

def Disconnect(self):
pass

864

社区成员

发帖
与我相关
我的任务
社区描述
VB COM/DCOM/COM+
c++ 技术论坛(原bbs)
社区管理员
  • COM/DCOM/COM+社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧