OPC客户程序（VB篇——异步）-白红宇

OPC客户程序（VB篇——异步）

阅读量：4077 次

发布时间：2019-05-25

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

建立如下窗体：

详见相册OPC技术。

引用如下：

详见相册OPC技术。

代码如下：

Option Explicit

Option Base 1

Const WRITEASYNC_ID = 1

Const READASYNC_ID = 2

Const REFRESHASYNC_ID = 3

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

' Interface Objects

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

Public WithEvents ServerObj As OPCServer

Public WithEvents GroupObj As OPCGroup

Dim ItemObj1 As OPCItem

Dim ItemObj2 As OPCItem

Dim Serverhandle(2) As Long

Private Sub chkGroupActive_Click()

If chkGroupActive = 1 Then

GroupObj.IsActive = 1

Else

GroupObj.IsActive = 0

End If

End Sub

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

chkGroupActive.Enabled = True

OutText = "连接OPC服务器"

Set ServerObj = New OPCServer

ServerObj.Connect ("XXXSERVER")

OutText = "添加组"

Set GroupObj = ServerObj.OPCGroups.Add("Group")

GroupObj.IsSubscribed = True

chkGroupActive_Click

OutText = "添加ITEM"

Set ItemObj1 = GroupObj.OPCItems.AddItem("XXXITEM1", 1)

Set ItemObj2 = GroupObj.OPCItems.AddItem("XXXITEM2", 2)

Serverhandle(1) = ItemObj1.Serverhandle

Serverhandle(2) = ItemObj2.Serverhandle

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

Dim ClientID As Long

Dim ServerID As Long

Dim ErrorNr() As Long

Dim ErrorString As String

On Error GoTo ErrorHandler

OutText = "读值"

ClientID = READASYNC_ID

GroupObj.AsyncRead 1, Serverhandle, ErrorNr, ClientID, ServerID

If ErrorNr(1) <> 0 Then

ErrorString = ServerObj.GetErrorString(ErrorNr(1))

MsgBox ErrorString, vbCritical, "Error AsyncRead()"

End If

Erase ErrorNr

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 ErrorNr() As Long

Dim ErrorString As String

Dim Cancel_id As Long

OutText = "Writing Value"

On Error GoTo ErrorHandler

MyValues(1) = Edit_WriteVal

GroupObj.AsyncWrite 1, Serverhandle, MyValues, ErrorNr, WRITEASYNC_ID, Cancel_id

If ErrorNr(1) <> 0 Then

ErrorString = ServerObj.GetErrorString(ErrorNr(1))

MsgBox ErrorString, vbCritical, "Error AsyncRead()"

End If

Erase ErrorNr

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

chkGroupActive.Enabled = False

OutText = "Removing Objects"

Set ItemObj1 = Nothing

Set ItemObj2 = 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 Sub GroupObj_AsyncReadComplete(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date, Errors() As Long)

Dim ErrorString As String

If (TransactionID = READASYNC_ID) Then

If Errors(1) = 0 Then

Edit_ReadVal = ItemValues(1)

Edit_ReadQu = GetQualityText(Qualities(1))

Edit_ReadTS = TimeStamps(1)

Else

ErrorString = ServerObj.GetErrorString(Errors(1))

MsgBox ErrorString, vbCritical, "Error AsyncReadComplete()"

End If

End Sub

'异步写回调

Private Sub GroupObj_AsyncWriteComplete(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, Errors() As Long)

Dim ErrorString As String

If (TransactionID = WRITEASYNC_ID) Then

If Errors(1) = 0 Then

Edit_WriteRes = ServerObj.GetErrorString(Errors(1))

Else

ErrorString = ServerObj.GetErrorString(Errors(1))

MsgBox ErrorString, vbCritical, "Error AsyncWriteComplete()"

End If

End Sub

'回调

Private Sub GroupObj_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)

Dim i As Long

For i = 1 To NumItems

Edit_OnDataVal(i - 1) = ItemValues(i)

Edit_OnDataQu(i - 1) = GetQualityText(Qualities(i))

Edit_OnDataTS(i - 1) = TimeStamps(i)

Next i

End Sub

Private Function GetQualityText(Quality) As String

Select Case Quality

Case 0: GetQualityText = "BAD"

Case 64: GetQualityText = "UNCERTAIN"

Case 192: GetQualityText = "GOOD"