vb与欧姆龙OPC服务器编程实例(读取PLC100个内存的vb源代码)

Option Explicit
Option Base 1 ' All OPC Automation Arrays start with 1
Dim MyOPCServer As OPCServer ' OPCServer Object
Dim MyGroups As OPCGroups ' OPCGroups Collection Object
Dim WithEvents MyGroup As OPCGroup ' OPCGroup Object
Dim MyItems As OPCItems ' OPCItems Collection Object
Dim MyItemServerHandles() As Long ' Server Handles for Items
Dim MyTID As Long ' Transaction ID for asynchronous calls Private Sub Command1_Click()
Dim Errors() As Long
Call MyItems.Remove(100, MyItemServerHandles, Errors)
MyGroups.RemoveAll
Set MyGroup = Nothing
Set MyGroups = Nothing
MyOPCServer.Disconnect
Set MyOPCServer = Nothing
End Sub
Private Sub Command2_Click()
PFAsyncWriteCommand
End Sub
Private Sub Command3_Click()
Form_Load
End Sub
Private Sub Form_Load()
MyTID = 1
Set MyOPCServer = New OPCServer
Call MyOPCServer.Connect("OMRON.OPC.2")
Set MyGroups = MyOPCServer.OPCGroups
MyGroups.DefaultGroupUpdateRate = 500
MyGroups.DefaultGroupIsActive = True
Set MyGroup = MyGroups.Add("Group1")
MyGroup.IsSubscribed = True
MyGroup.IsActive = True
MyGroup.UpdateRate = 500
Dim ErrorFlag As Boolean
Dim ItemObj As OPCItem
Dim ItemIDs(100) As String
Dim ItemClientHandles(100) As Long
Dim Errors() As Long
ErrorFlag = False
Set MyItems = MyGroup.OPCItems
Dim m As Integer
For m = 0 To 3
Text1(m).ForeColor = vbRed
Text1(m).FontSize = 15
Text2(m).ForeColor = vbRed
Text2(m).FontSize = 15
Next
For m = 4 To 99
Text1(m).ForeColor = vbBlue
Text1(m).FontSize = 15
Next
For m = 1 To 100
ItemIDs(m) = "Device.Group1.Tag" & CStr(m)
ItemClientHandles(m) = m
Next
Call MyItems.AddItems(100, ItemIDs, ItemClientHandles, MyItemServerHandles, Errors)
End Sub
Private Sub MyGroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
On Error GoTo ErrorHandler '订阅方式回馈信息存储
Dim i As Long
For i = 1 To NumItems
If ClientHandles(i) > 0 And ClientHandles(i) < 101 Then
If Qualities(i) = 192 Then
data1(ClientHandles(i)) = ItemValues(i)
Else
' MsgBox GetQualityText(Qualities(i))
End If
Else
MsgBox "DataChange Item " + Str$(i) + " has invalid Client Handle ", vbCritical
End If
Next
Exit Sub
ErrorHandler:
MsgBox Err.Description + Chr(13) + "OnDataChange", vbCritical, "ERROR"
End Sub
Private Sub Timer1_Timer()
Dim i As Integer
For i = 1 To 100
Text1(i - 1).Text = data1(i)
Next i
End Sub
Public Sub PFAsyncWriteCommand() '异步写入命令
On Error GoTo ErrorHandler
Dim i, j As Long
Dim Values(4) As Variant
Dim Errors() As Long
Dim CID As Long
Dim AsyncHandles(4) As Long
For j = 1 To 4
AsyncHandles(j) = MyItemServerHandles(j)
Values(j) = Text2(j - 1).Text
Next
MyTID = MyTID + 1
Call MyGroup.AsyncWrite(4, AsyncHandles, Values, Errors, MyTID, CID)
For i = 1 To 4
If Not Errors(i) = 0 Then MsgBox "Item " + Str$(i) + " FAILED. Error Code = " + Str$(Errors(i)), vbCritical Next
Exit Sub
ErrorHandler:
MsgBox Err.Description + Chr(13) + "Writing Items Asyncronous", vbCritical, "ERROR"
End Sub
Private Sub MyGroup_AsyncWriteComplete(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, Errors() As Long)
On Error GoTo ErrorHandler '异步写命令回馈信息
Dim i As Long
For i = 1 To NumItems
If Not Errors(i) = 0 Then MsgBox "AsyncWriteComplete Item Clienthandle = " + Str$(ClientHandles(i)) + " FAILED. Error Code = " + Str$(Errors(i)), vbCritical
Next
Exit Sub
ErrorHandler:
MsgBox Err.Description + Chr(13) + "Async Write Complete", vbCritical, "ERROR"
End Sub。