VB通过OPC与S7 200 PLC通讯的代码实例

冰糖 · 发表于 2010-12-18 21:15:05

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有帐号？立即注册

x

Option Explicit
Option Base 1
Private QOpcServer As OPCServer
Private QGroups As OPCGroups
Private WithEvents QGroup As OPCGroup
Private QItems As OPCItems
Private QItemServerHandles() As LongPrivate Sub Form_Load()
On Error GoTo ErrorHandler
'建立与OPC服务器的连接
Set QOpcServer = New OPCServer
Call QOpcServer.Connect("S7200.OPCServer") 'S7200.OPCServer是固定的OPC名称
'建立一个数据群组
Set QGroups = QOpcServer.OPCGroups ' Get OPCGroups Collection Object from QOPCServer
' Set Default Properties for Group Collection
' These Properties are used to set the Properies for new Groups
QGroups.DefaultGroupIsActive = 500 ' Set Default Group Update Rate to 500 ms
QGroups.DefaultGroupIsActive = False ' Set Default Group Active State to Inactive
Set QGroup = QGroups.Add("QGroup1") ' Add a new Group to the Group Collection
' Set Group Properties
QGroup.IsSubscribed = True ' Enable Callbacks
QGroup.UpdateRate = 100 '这个群组的刷新速度是100ms
'往群组里添加要传送的地址单元
Dim i As Long
Dim ErrorFlag As Boolean
Dim ItemObj As OPCItem
Dim ItemIDs(2) As String
Dim ItemClientHandles(2) As Long
Dim Errors() As Long ' Array for returned Item related errors
ErrorFlag = False
Set QItems = QGroup.OPCItems ' 关联OPC Items
' Initialize the [IN] parameters for the Add Items call
' ItemIDs -> ItemIDs of the Items to add
' ItemClientHandles -> Client defined handles for the Items. The Server sends these handles in the Callbacks
ItemIDs(1) = "2,q1.0,bool" ' Read ItemId 1 from Text Box
ItemIDs(2) = "2,VW10,Word" ' Read ItemId 2 from Text Box
ItemClientHandles(1) = 1
ItemClientHandles(2) = 2
' [OUT] parameters are
' ItemServerHandles -> Server defined handles for the Items. The client must use these handles for all Read/Write calls
' Errors -> Item related errors
' Add Items to the Group
Call QItems.AddItems(2, ItemIDs, ItemClientHandles, QItemServerHandles, Errors)
' Check Item Errors
For i = 1 To 2
If Not Errors(i) = 0 Then
MsgBox "Item " + Str$(i) + " FAILED. Error Code = " + Str$(Errors(i)), vbCritical
ErrorFlag = True
End If
Next
' Continue only if all Items SUCCEEDED
If ErrorFlag Then
Dim RemoveErrors() As Long
Dim RemoveHandles(1) As Long
' Remove Succeede Items
For i = 1 To 2
If Errors(i) = 0 Then
RemoveHandles(1) = QItemServerHandles(i)
Call QItems.Remove(1, RemoveHandles, RemoveErrors)
End If
Next
End If
If Not QGroup Is Nothing Then
QGroup.IsActive = True
End If
Exit Sub
ErrorHandler:
MsgBox Err.Description + Chr(13) + "联接到OPC服务器", vbCritical, "Error"
End SubPrivate Sub cmdWriteSync_Click()
'On Error GoTo ErrorHandler
Dim i As Long
Dim Values(2) As Variant
Dim Errors() As Long ' Array for returned Item related errors' Initialize the [IN] parameters for the SyncWrite call
' Values -> Values to write
Values(1) = txtWriteVal1.Text ' Read Value 1 from Text Box
Values(2) = txtWriteVal2.Text ' Read Value 2 from Text Box
' ItemServerHandles -> Server defined handles from the AddItems call
' Write Values Syncronous
Call QGroup.SyncWrite(2, QItemServerHandles, Values, Errors)
' Check Item Errors
For i = 1 To 2
If Not Errors(i) = 0 Then MsgBox "Item " + Str$(i) + " FAILED. Error Code = " + Str$(Errors(i)), vbCritical
NextExit Sub
ErrorHandler:
MsgBox Err.Description + Chr(13) + "Writing Items Syncronous", vbCritical, "ERROR"
End Sub' Callback from OnDataChange
Private Sub QGroup_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
' Check Parameters
For i = 1 To NumItems
If ClientHandles(i) > 0 And ClientHandles(i) < 3 Then
' Values -> Values from read complete
' Qualities -> Qualities of the values
If Qualities(i) = 192 Then
txtChangeVal.Item(ClientHandles(i) - 1).Text = ItemValues(i) ' Write Value to Text Box
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, "ERRORCha"
End SubPrivate Sub cmdExit_Click()
Unload Me
End Sub
' Unload Form. Event
Private Sub Form_Unload(Cancel As Integer)
Dim i As Long
Dim Errors() As Long ' Array for returned Item related errors
' Remove Items from the Group
Call QItems.Remove(2, QItemServerHandles, Errors)
' Check Item Errors
For i = 1 To 2
If Not Errors(i) = 0 Then MsgBox "Item " + Str$(i) + " FAILED. Error Code = " + Str$(Errors(i)), vbCritical
Next
Erase QItemServerHandles ' Erase Item Server Handle Array
QGroups.RemoveAll ' Removes all Groups
Set QGroup = Nothing ' Delete OPCGroup Object
Set QGroups = Nothing ' Delete OPCGroups Collection Object
QOpcServer.Disconnect ' Disconnect from OPC Server
Set QOpcServer = Nothing ' Delete OPCServer Object
End Sub

复制代码

帐号		自动登录	找回密码
密码			立即注册

[OPC技术] VB通过OPC与S7 200 PLC通讯的代码实例

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。