建立如下窗体: 引用如下:
代码如下: 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
[VB.NET程序]OPC客户程序(VB篇——异步)
|