OPC客戶程序（VB篇——同步）
2024-07-21 02:20:56
供稿：網(wǎng)友
建立如下窗體：
引用如下：
代碼如下：
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服務(wù)器"
set serverobj = new opcserver
serverobj.connect ("xxxserver")'xxxserver為某opc服務(wù)器名稱
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: '如果出現(xiàn)異常，則報出錯誤。
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
