本文共 2781 字，大约阅读时间需要 9 分钟。

建立如下窗体： 详见相册OPC技术。引用如下：详见相册OPC技术。代码如下：Option ExplicitDim WithEvents ServerObj As OPCServerDim WithEvents GroupObj As OPCGroupDim 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

 

转载地址：http://nkini.baihongyu.com/