📄 csdemoserver.frm
字号:
VERSION 5.00
Begin VB.Form CsDemoServer
Caption = "CsDemoServer"
ClientHeight = 6765
ClientLeft = 60
ClientTop = 450
ClientWidth = 9030
LinkTopic = "Form1"
ScaleHeight = 6765
ScaleWidth = 9030
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtreceiver
Height = 360
Left = 1440
TabIndex = 21
Top = 6240
Width = 1815
End
Begin VB.TextBox txtFilterRequestTy
Height = 270
Left = 1800
TabIndex = 20
Text = "Tencent.RTX.CsDemoClient"
Top = 1320
Width = 2535
End
Begin VB.TextBox txtAppAction
Height = 270
Left = 6360
TabIndex = 19
Text = "distill"
Top = 1200
Width = 2535
End
Begin VB.CommandButton btnSendMsg
Caption = "发送"
Height = 375
Left = 4200
TabIndex = 18
Top = 6240
Width = 2415
End
Begin VB.TextBox txtSendData
Height = 855
Left = 240
TabIndex = 17
Text = "服务器应用发给插件的数据"
Top = 5160
Width = 8535
End
Begin VB.TextBox txtReceiverData
Height = 1095
Left = 240
TabIndex = 15
Top = 3240
Width = 8535
End
Begin VB.CommandButton btnRegApp
Caption = "注册应用"
Height = 375
Left = 360
TabIndex = 7
Top = 2040
Width = 1575
End
Begin VB.CommandButton btnUnRegApp
Caption = "注销应用"
Height = 375
Left = 2355
TabIndex = 6
Top = 2040
Width = 1575
End
Begin VB.CommandButton btnStartApp
Caption = "启动应用"
Height = 375
Left = 4605
TabIndex = 5
Top = 2040
Width = 1575
End
Begin VB.CommandButton btnStopApp
Caption = "停止应用"
Height = 375
Left = 6840
TabIndex = 4
Top = 2040
Width = 1575
End
Begin VB.TextBox txtSvrIP
Height = 285
Left = 1800
TabIndex = 3
Text = "127.0.0.1"
Top = 120
Width = 2535
End
Begin VB.TextBox txtSvrPort
Height = 285
Left = 6360
TabIndex = 2
Text = "8006"
Top = 120
Width = 2535
End
Begin VB.TextBox txtAppGuid
Height = 285
Left = 1800
TabIndex = 1
Text = "{16F8F6DB-EB21-4520-8371-421DD76A9148}"
Top = 720
Width = 2535
End
Begin VB.TextBox txtAppName
Height = 285
Left = 6360
TabIndex = 0
Text = "CsDemoServer"
Top = 720
Width = 2535
End
Begin VB.Label Label9
Caption = "接收者:"
Height = 255
Left = 360
TabIndex = 22
Top = 6240
Width = 975
End
Begin VB.Label Label8
Caption = "发送数据给插件:"
Height = 375
Left = 240
TabIndex = 16
Top = 4800
Width = 2055
End
Begin VB.Label Label5
Caption = "接收插件发过来的数据:"
Height = 375
Left = 240
TabIndex = 14
Top = 2880
Width = 2295
End
Begin VB.Label Label1
Caption = "RTXApp Server IP:"
Height = 255
Left = 120
TabIndex = 13
Top = 120
Width = 1695
End
Begin VB.Label Label2
Caption = "RTXApp Server Port:"
Height = 255
Left = 4560
TabIndex = 12
Top = 120
Width = 1935
End
Begin VB.Label Label3
Caption = "应用标示:"
Height = 255
Left = 120
TabIndex = 11
Top = 720
Width = 1695
End
Begin VB.Label Label4
Caption = "应用名:"
Height = 255
Left = 4560
TabIndex = 10
Top = 720
Width = 1095
End
Begin VB.Label Label6
Caption = "过滤动作:"
Height = 255
Left = 4560
TabIndex = 9
Top = 1320
Width = 1695
End
Begin VB.Label Label7
Caption = "过滤消息类型:"
Height = 255
Left = 120
TabIndex = 8
Top = 1320
Width = 1695
End
End
Attribute VB_Name = "CsDemoServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RootObj As RTXSAPIRootObj '声明一个根对象
Dim WithEvents APIObj As RTXSAPIObj '声明一个应用对象
Attribute APIObj.VB_VarHelpID = -1
Dim MsgObj As RTXSAPIMessage ' 声明一个消息对象
Dim SDataObj As RTXSData ' 声明一个SData对象
Private Sub Form_Load()
Set RootObj = CreateObject("RTXSAPIRootObj.RTXSAPIRootObj") '创建根对象
Set APIObj = RootObj.CreateAPIObj '通过根对象创建应用对象
End Sub
Private Sub APIObj_OnRecvMessage(ByVal Message As RTXSAPILib.IRTXSAPIMessage) ' 接收到客户端发过来的数据将触发该事件
txtReceiverData.Text = Message.Sender + "发送" + Message.Content + "到" + Message.Receivers
txtreceiver.Text = Message.Sender
'拆开协议包,把Message.Content赋值给一个SData对象,通过SData对象的方法获取里面字段的值
Dim ReceiverData As RTXSData ' 声明一个SData对象
Set ReceiverData = RootObj.CreateRTXSData ' 创建它
ReceiverData.XML = Message.Content ' 把Message.Content赋值给ReceiverData.XML
'MsgBox ReceiverData.GetString("Sender")
End Sub
Private Sub btnRegApp_Click()
On Error GoTo errorhandler
APIObj.ServerIP = txtSvrIP.Text ' 设置服务器IP
APIObj.ServerPort = txtSvrPort.Text ' 设置服务器端口
APIObj.AppGUID = Trim(txtAppGuid.Text) ' 设置应用GUID,必填参数
APIObj.AppName = txtAppName.Text ' 设置应用名称,必填参数
If txtAppAction.Text = "copy" Then ' 设置过滤动作,,必填参数,如果多个应用关注同一种消息类型,需要留意一下该参数的设置
APIObj.AppAction = AA_COPY ' 当过滤动作为AA_COPY时,ConServer把消息拷贝一份给应用,但不会删除原来的消息。
ElseIf txtAppAction.Text = "distill" Then
APIObj.AppAction = AA_DISTILL ' 当过滤动作为AA_DISTILL时,ConServer把消息拷贝给应用后删除原来的消息。
Else
MsgBox "无效过滤动作"
Exit Sub
End If
APIObj.FilterAppName = "All" ' 表示过滤所有应用,必填参数
APIObj.FilterRequestType = txtFilterRequestTy.Text ' 过滤消息类型,必填参数
APIObj.FilterResponseType = "none" ' 无回复消息类型,必填参数
APIObj.FilterSender = "anyone" '过滤所有发送人的该类消息,必填参数
APIObj.FilterReceiver = "anyone" '过滤所有接收人的该类消息,必填参数
APIObj.FilterReceiverState = "anystate" ' 关注所有状态,必填参数
APIObj.FilterKey = "" '为空表示过滤所有
APIObj.RegisterApp
MsgBox "注册成功"
Exit Sub
errorhandler:
MsgBox "Error # " & Str(Err.Number) & Chr(13) & Err.Description
End Sub
Private Sub btnStartApp_Click()
On Error GoTo errorhandler
APIObj.StartApp "", 4
MsgBox "启动成功"
Exit Sub
errorhandler:
MsgBox "Error # " & Str(Err.Number) & Chr(13) & Err.Description
End Sub
Private Sub btnStopApp_Click()
On Error GoTo errorhandler
APIObj.StopApp
MsgBox "停止成功"
Exit Sub
errorhandler:
MsgBox "Error # " & Str(Err.Number) & Chr(13) & Err.Description
End Sub
Private Sub btnUnRegApp_Click()
On Error GoTo errorhandler
APIObj.UnRegisterApp
MsgBox "注销成功"
Exit Sub
errorhandler:
MsgBox "Error # " & Str(Err.Number) & Chr(13) & Err.Description
End Sub
Private Sub btnSendMsg_Click()
On Error GoTo errorhandler
Set MsgObj = APIObj.CreateMessage '创建一个消息对象
Set SDataObj = RootObj.CreateRTXSData ' 他建一个SData对象
'封装协议包,可理解SDataObj是一个协议包,该协议包被封装进消息对象MsgObj,然后调用应用对象的SendMessage方法把MsgObj发送给客户端
SDataObj.SetString "Sender", "{16F8F6DB-EB21-4520-8371-421DD76A9148}" ' 设置发送者
SDataObj.SetString "Content", txtSendData.Text ' 设置消息内容
'为了容易理解,本示例协议包只有两个字段,这些字段名称可以自行名称。
MsgObj.Sender = "{16F8F6DB-EB21-4520-8371-421DD76A9148}" '设置发送者,该GUID为应用的GUID。
MsgObj.Receivers = txtreceiver.Text '设置接收者
MsgObj.MsgType = "Tencent.RTX.CsDemoClient" '设置消息类型,该消息类型可以在客户端插件查看
MsgObj.AppName = "Tencent.RTX.CsDemoClient" '该名为客户端插件的名称,插件名称一般与消息类型一致
MsgObj.Content = SDataObj.XML ' 把SData导出为xml格式后赋值给Content
MsgObj.MessageFlag = RTXSAPI_MESSAGE_FLAG_DEFAULT '默认的处理方式,允许其它应用过滤消息,也允许以抽取的方式对消息进行过滤
APIObj.SendMessage MsgObj, False '把MsgObj发给客户端
Exit Sub
errorhandler:
MsgBox "Error # " & Str(Err.Number) & Chr(13) & Err.Description
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -