Http://www.opc-china.com established the following form: See the Album OPC Technology. Quoted as follows: See Album OPC Technology. The code is as follows: Option Explicitdim Withevents Serverobj As OpcserDim Withevents Groupobj As OpcGroupdim ItemObj As Opcitem
Private sub fascist_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 server connection" 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 is the added item name EXIT SUB
ErrorHandler: 'If an exception occurs, it is reported. MsgBox Err.Description Chr (13) _ OutText, Vbcritical, "Error"
End Sub
Private submed_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 = "ITEM read 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 = "writing the 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 objects" 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 (qualy) 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 SelectEnd Function
