OPC客户程序（VB篇——同步）
2024-07-21 02:20:56
供稿：网友
建立如下窗体：
引用如下：
代码如下：
option explicit
dim withevents serverobj as opcserver
dim withevents groupobj as opcgroup
dim itemobj as opcitem
private sub command_start_click()
dim outtext as string
on error goto errorhandler
command_start.enabled = false
command_read.enabled = true
command_write.enabled = true
command_exit.enabled = true
outtext = "连接opc服务器"
set serverobj = new opcserver
serverobj.connect ("xxxserver")'xxxserver为某opc服务器名称
outtext = "添加组"
set groupobj = serverobj.opcgroups.add("group")
outtext = "adding an item to the group"
set itemobj = groupobj.opcitems.additem("xxxitem", 1)'xxxitem为添加的item名称
exit sub
errorhandler: '如果出现异常，则报出错误。
msgbox err.description + chr(13) + _
outtext, vbcritical, "error"
end sub
private sub command_read_click()'同步读
dim outtext as string
dim myvalue as variant
dim myquality as variant
dim mytimestamp as variant
on error goto errorhandler
outtext = "读item值"
itemobj.read opcdevice, myvalue, myquality, mytimestamp
edit_readval = myvalue
edit_readqu = getqualitytext(myquality)
edit_readts = mytimestamp
exit sub
errorhandler:
msgbox err.description + chr(13) + _
outtext, vbcritical, "error"
end sub
private sub command_write_click()'同步写
dim outtext as string
dim serverhandles(1) as long
dim myvalues(1) as variant
dim myerrors() as long
outtext = "写值"
on error goto errorhandler
serverhandles(1) = itemobj.serverhandle
myvalues(1) = edit_writeval
groupobj.syncwrite 1, serverhandles, myvalues, myerrors
edit_writeres = serverobj.geterrorstring(myerrors(1))
exit sub
errorhandler:
msgbox err.description + chr(13) + _
outtext, vbcritical, "error"
end sub
private sub command_exit_click()'停止，删除item,删除group，删除server。
dim outtext as string
on error goto errorhandler
command_start.enabled = true
command_read.enabled = false
command_write.enabled = false
command_exit.enabled = false
outtext = "删除对象"
set itemobj = nothing
serverobj.opcgroups.removeall
set groupobj = nothing
serverobj.disconnect
set serverobj = nothing
exit sub
errorhandler:
msgbox err.description + chr(13) + _
outtext, vbcritical, "error"
end sub
private function getqualitytext(quality) as string
select case quality
case 0: getqualitytext = "bad"
case 64: getqualitytext = "uncertain"
case 192: getqualitytext = "good"
case 8: getqualitytext = "not_connected"
case 13: getqualitytext = "device_failure"
case 16: getqualitytext = "sensor_failure"
case 20: getqualitytext = "last_known"
case 24: getqualitytext = "comm_failure"
case 28: getqualitytext = "out_of_service"
case 132: getqualitytext = "last_usable"
case 144: getqualitytext = "sensor_cal"
case 148: getqualitytext = "egu_exceeded"
case 152: getqualitytext = "sub_normal"
case 216: getqualitytext = "local_override"
case else: getqualitytext = "unknown error"
end select
end function
