Establish the following form: See Album OPC Technology. Quoted as follows: See Album OPC Technology. code show as below:
Option ExplicitOption Base 1
Const Writeasync_ID = 1Const Readasync_ID = 2Const Refreshasync_ID = 3
'------------------------------------- ------------------------------------------- -------------------------------------------------- ------- Public WitHevents Serverobj As OppcserPublic Withevents Groupobj As OpcGroup
DIM ITEMOBJ1 AS OPCITEMDIM ITEMOBJ2 AS OPCITEM
DIM ServerHandle (2) As long
Private sub chkgroupactive_click ()
If Chkgroupactive = 1 Then Groupobj.isActive = 1 else groupobj.isactive = 0 End ifend sub
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 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 = "reading" 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 SubPrivate Sub Command_Write_Click () 'written asynchronously 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.asyncw rite 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, 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 ifend SUB
'Asynchronous write callback 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 IfEnd 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 (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
