opc客户程序（vb篇——同步）.txt

一个可以直接调用的条码扫描仪VB源码

建立如下窗体：
 
引用如下：

代码如下：
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