OPC client program (VB article-sync)

The program establishes the following form:

The reference is as follows:

The code is as follows:
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 = "Connect OPC server"
Set ServerObj = New opcserver
Serverobj.connect ("Xxxserver") ' Xxxserver for an OPC server name

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

Outtext = "Adding an Item to the group"
Set itemobj = GroupObj.OPCItems.AddItem ("Xxxitem", 1) ' Xxxitem for added item name

Exit Sub


ErrorHandler: ' If an exception occurs, an error is reported.
MsgBox Err.Description + Chr (13) + _
Outtext, vbcritical, "ERROR"


End Sub

Private Sub Command_read_click () synchronous read

Dim Outtext as String
Dim MyValue as Variant
Dim Myquality as Variant
Dim Mytimestamp as Variant

On Error GoTo ErrorHandler

Outtext = "Read Item value"
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 () ' Synchronous write

Dim Outtext as String
Dim Serverhandles (1) as Long
Dim myvalues (1) as Variant
Dim myerrors () as Long

Outtext = "Write value"
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 () ' Stop, delete item, delete Group, delete 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 = "Delete Object"
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