opcsync.frm

使用VB的OPC客户访问的最简单程序,本程序为同步访问程序,需要异步的查找ASync-VB.rar

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "OPC同步例子"
   ClientHeight    =   3165
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6270
   LinkTopic       =   "Form1"
   ScaleHeight     =   3165
   ScaleWidth      =   6270
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Edit_ReadTS 
      Enabled         =   0   'False
      Height          =   375
      Left            =   4560
      TabIndex        =   10
      Top             =   960
      Width           =   1455
   End
   Begin VB.TextBox Edit_WriteRes 
      Enabled         =   0   'False
      Height          =   615
      Left            =   3240
      MultiLine       =   -1  'True
      TabIndex        =   7
      Top             =   1680
      Width           =   2775
   End
   Begin VB.TextBox Edit_ReadQu 
      Enabled         =   0   'False
      Height          =   375
      Left            =   3240
      TabIndex        =   6
      Top             =   960
      Width           =   1215
   End
   Begin VB.TextBox Edit_ReadVal 
      Enabled         =   0   'False
      Height          =   375
      Left            =   2040
      TabIndex        =   5
      Top             =   960
      Width           =   1095
   End
   Begin VB.CommandButton Command_Exit 
      Caption         =   "停止"
      Enabled         =   0   'False
      Height          =   375
      Left            =   360
      TabIndex        =   4
      Top             =   2400
      Width           =   1335
   End
   Begin VB.CommandButton Command_Write 
      Caption         =   "写"
      Enabled         =   0   'False
      Height          =   375
      Left            =   360
      TabIndex        =   3
      Top             =   1680
      Width           =   1335
   End
   Begin VB.CommandButton Command_Read 
      Caption         =   "读"
      Enabled         =   0   'False
      Height          =   375
      Left            =   360
      TabIndex        =   2
      Top             =   960
      Width           =   1335
   End
   Begin VB.CommandButton Command_Start 
      Caption         =   "启动例子"
      Height          =   375
      Left            =   360
      TabIndex        =   1
      Top             =   240
      Width           =   1335
   End
   Begin VB.TextBox Edit_WriteVal 
      Height          =   375
      Left            =   2040
      TabIndex        =   0
      Top             =   1680
      Width           =   1095
   End
   Begin VB.Label Label4 
      Caption         =   "时间戳"
      Height          =   255
      Left            =   4920
      TabIndex        =   11
      Top             =   600
      Width           =   855
   End
   Begin VB.Label Label3 
      Caption         =   "品质/写结果"
      Height          =   375
      Left            =   3360
      TabIndex        =   9
      Top             =   600
      Width           =   1095
   End
   Begin VB.Label Label2 
      Caption         =   "值"
      Height          =   255
      Left            =   2280
      TabIndex        =   8
      Top             =   600
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'----------------------------------------------------------------------------
' OPC 自动化 2.0 例子
' 同步读

'
'----------------------------------------------------------------------------

Option Explicit
Option Base 1
              
'----------------------------------------------------------------------------
' 接口对象
'----------------------------------------------------------------------------
Dim WithEvents ServerObj As OPCServer
Attribute ServerObj.VB_VarHelpID = -1
Dim WithEvents GroupObj As OPCGroup
Attribute GroupObj.VB_VarHelpID = -1
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 ("Matrikon.OPC.Simulation")
    
    OutText = "添加组"
    Set GroupObj = ServerObj.OPCGroups.Add("MyOPCGroup")
    
    OutText = "为组添加Item"
    Set ItemObj = GroupObj.OPCItems.AddItem("Random.Real4", 1)
    
    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()
    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