OPC client program (VB article-asynchronous)

Program | Creates the following form asynchronously:

The reference is as follows:

The code is as follows:


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 = "Connect OPC server"
Set ServerObj = New opcserver
Serverobj.connect ("Xxxserver")

Outtext = "Add Group"
Set groupobj = ServerObj.OPCGroups.Add ("Group")


groupobj.issubscribed = True

Chkgroupactive_click

Outtext = "Add 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 () ' Asynchronous read

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 = "Read Value"

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 () ' Asynchronous write

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 () ' Stop
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


' Asynchronous read callback
Private Sub Groupobj_asyncreadcomplete (ByVal TransactionID as Long, ByVal NumItems as Long, clienthandles () as Long, ITEMV Alues () 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 If
End Sub

' Asynchronous write callback
Private Sub Groupobj_asyncwritecomplete (ByVal TransactionID as Long, ByVal NumItems as Long, clienthandles () as Long, Erro RS () 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 If
End Sub
' Callback
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"
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