建立如下窗体：

引用如下：

代码如下：


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