VB+OPC代码.doc

OPC的VB例子 Option ExplicitOption Base 1Private QOpcServer As OPCServerPrivate QGroups As OPCGroupsPrivate WithEvents QGroup As OPCGroupPrivate QItems As OPCItemsPrivate QItemServerHandles() As Long Private Sub Form_Load()On Error GoTo ErrorHandler建立与OPC服务器的连接Set QOpcServer = New OPCServerCall 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 GroupsQGroups.DefaultGroupIsActive = 500 Set Default Group Update Rate to 500 msQGroups.DefaultGroupIsActive = False Set Default Group Active State to InactiveSet QGroup = QGroups.Add(QGroup1) Add a new Group to the Group Collection Set Group PropertiesQGroup.IsSubscribed = True Enable CallbacksQGroup.UpdateRate = 100 这个群组的刷新速度是100ms往群组里添加要传送的地址单元Dim i As LongDim ErrorFlag As BooleanDim ItemObj As OPCItemDim ItemIDs(2) As StringDim ItemClientHandles(2) As LongDim Errors() As Long Array for returned Item related errorsErrorFlag = FalseSet QItems = QGroup.OPCItems Get OPCItems Collection Object from QOPCServer 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 CallbacksItemIDs(1) = 2,q1.0,bool Read ItemId 1 from Text BoxItemIDs(2) = 2,VW10,Word Read ItemId 2 from Text BoxItemClientHandles(1) = 1ItemClientHandles(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 GroupCall QItems.AddItems(2, ItemIDs, ItemClientHandles, QItemServerHandles, Errors) Check Item ErrorsFor i = 1 To 2If Not Errors(i) = 0 ThenMsgBox Item + Str$(i) + FAILED. Error Code = + Str$(Errors(i), vbCriticalErrorFlag = TrueEnd IfNext Continue only if all Items SUCCEEDEDIf ErrorFlag ThenDim RemoveErrors() As LongDim RemoveHandles(1) As Long Remove Succeede ItemsFor i = 1 To 2If Errors(i) = 0 ThenRemoveHandles(1) = QItemServerHandles(i)Call QItems.Remove(1, RemoveHandles, RemoveErrors)End IfNextEnd IfIf Not QGroup Is Nothing ThenQGroup.IsActive = TrueEnd IfExit SubErrorHandler: MsgBox Err.Description + Chr(13) + 联接到OPC服务器, vbCritical, ErrorEnd Sub Private Sub cmdWriteSync_Click()On Error GoTo ErrorHandlerDim i As LongDim Values(2) As VariantDim Errors() As Long Array for returned Item related errors Initialize the IN parameters for the SyncWrite call Values - Values to writeValues(1) = txtWriteVal1.Text Read Value 1 from Text BoxValues(2) = txtWriteVal2.Text Read Value 2 from Text Box ItemServerHandles - Server defined handles from the AddItems call Write Values SyncronousCall QGroup.SyncWrite(2, QItemServerHandles, Values, Errors) Check Item ErrorsFor i = 1 To 2If Not Errors(i) = 0 Then MsgBox Item + Str$(i) + FAILED. Error Code = + Str$(Errors(i), vbCriticalNext Exit SubErrorHandler:MsgBox Err.Description + Chr(13) + Writing Items Syncronous, vbCritical, ERROREnd Sub Callback from OnDataChangePrivate 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 ErrorHandlerDim i As Long Check ParametersFor i = 1 To NumItemsIf ClientHandles(i) 0 And ClientHandles(i) Values from read complete Qualities - Qualities of the values If Qualities(i) = 192 ThentxtChangeVal.Item(ClientHandles(i) - 1).Text = ItemValues(i) Write Value to Text Box End IfElseMsgBox DataChange Item + Str$(i) + has invalid Client Handle , vbCriticalEnd IfNextExit SubErrorHandler:MsgBox Err.Description + Chr(13) + OnDataChange, vbCritical, ERRORChaEnd Sub Private Sub cmdExit_Click()Unload MeEnd Sub Unload Form EventPrivate Sub Form_Unload(Cancel As Integer)Dim i As LongDim Errors() As Long Array for returned Item related errors Remove Items from the GroupCall QItems.Remove(2, QItemServerHandles, Errors) Check Item ErrorsFor i = 1 To 2If Not Errors(i) = 0 Then MsgBox Item + Str$(i) + FAILED. Error Code = + Str$(Errors(i), vbCriticalNextErase QItemServerHandles Erase Item Server Handle ArrayQGroups.RemoveAll Removes a