mainform.frm

VB开发opcClient的教程和源码,开发有帮助。

        MyGroup.IsActive = True   ' A group that is active acquires Data
    Else
        MyGroup.IsActive = False
    End If
    
    ' Set Button Enable
    Me.cmdAddGroup.Enabled = False   'Button add group disabled
    Me.cmdDisconnect.Enabled = False 'Button disconect disabled
    Me.cmdRemGroup.Enabled = True    'Button removed group enabled
    Me.cmdAddItem.Enabled = True     'Button add item enabled
    'Multi line text for editbox of info code
    Me.tbSourceCode.Text = "Private Sub cmdAddGroup_Click()" & ChrW(13) & ChrW(10) & ChrW(9) & ChrW(13) & ChrW(10) & "   'Get OPCGroups Collection Object from MyOP" & _
    "CServer" & ChrW(13) & ChrW(10) & "   MyGroups = MyOPCServer.OPCGroups " & ChrW(13) & ChrW(10) & "   MyGroups.DefaultGroupIsActive " & _
    "= 500 ' Set Default Group Update Rate to 500 ms" & ChrW(13) & ChrW(10) & "   MyGroup = MyGroups.Add(txtGr" & _
    "oup.Text) ' Add a new Group to the Group Collection" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "End Sub"
    '
Exit Sub
ErrorHandler: ' Code that handles errors
    MsgBox Err.Description + Chr(13) + "Adding a Group to OPC Server", vbCritical, "ERROR"
End Sub

'************************************************************************************************
'** @Sub cmdRemGroup_Click | function for Remove OPCGroups Collection Object from MyOPCServer   *
'**                                                                                             *
'** This function remove a Group to the Groups Collection<nl>                                   *
'**                                                                                             *
'************************************************************************************************

Private Sub cmdRemGroup_Click()
On Error GoTo ErrorHandler  ' Code that may or may not contain errors
    MyGroups.RemoveAll      ' Removes all Groups
    Set MyGroup = Nothing   ' Delete OPCGroup Object
    Set MyGroups = Nothing  ' Delete OPCGroups Collection Object
    
    ' Set Button Enable
    Me.cmdRemGroup.Enabled = False  ' Button removed group disabled
    Me.cmdAddItem.Enabled = False   ' Button add item disabled
    Me.cmdAddGroup.Enabled = True   ' Button group item enabled
    Me.cmdDisconnect.Enabled = True ' Button disconect enabled
    ' Multi line text for editbox of info code
    Me.tbSourceCode.Text = "Private Sub cmdRemGroup_Click() " & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "   MyGroups.RemoveAll() ' Removes all Groups" & ChrW(13) & ChrW(10) & "   MyGroup = Nothing ' Delete OPCGroup Object" & ChrW(13) & ChrW(10) & "   MyGroups = Nothing ' Delete O" & _
    "PCGroups Collection Object" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "End Sub"
    '
Exit Sub
ErrorHandler: ' Code that handles errors
    MsgBox Err.Description + Chr(13) + "Removing Group from OPC Server", vbCritical, "ERROR"
End Sub


'************************************************************************************************
'** @Sub CheckGroupActive_CheckStateChanged | function set propertis of CheckState              *
'**                                                                                             *
'** This function set a group that is active acquires Data<nl>                                  *
'**                                                                                             *
'************************************************************************************************

Private Sub CheckGroupActive_Click()
    If Not MyGroup Is Nothing Then
        If CheckGroupActive.Value = 1 Then
            MyGroup.IsActive = True 'A group that is active acquires Data
        Else
            MyGroup.IsActive = False
        End If
    End If
End Sub

'************************************************************************************************
'** @Sub cmdAddItem_Click | function get OPCItems Collection Object from MyOPCServer            *
'**                                                                                             *
'** This function add Items to the Group<nl>                                                    *
'**                                                                                             *
'************************************************************************************************

Private Sub cmdAddItem_Click()
On Error GoTo ErrorHandler ' Code that may or may not contain errors
    Dim i As Long
    Dim ErrorFlag As Boolean
    Dim ItemIDs(2) As String         ' Item id array
    Dim ItemClientHandles(2) As Long ' Item client handles array
    Dim Errors() As Long             ' Array for returned Item related errors
    ErrorFlag = False
    
    Set MyItems = MyGroup.OPCItems ' Get OPCItems Collection Object from MyOPCServer
     
    ItemIDs(1) = txtItem1.Text   ' Read ItemId 1 from Text Box
    ItemIDs(2) = txtItem2.Text   ' Read ItemId 2 from Text Box
    ItemClientHandles(1) = 1
    ItemClientHandles(2) = 2
     
    ' Add Items to the Group
    Call MyItems.AddItems(2, ItemIDs, ItemClientHandles, MyItemServerHandles, 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) = MyItemServerHandles(i)
                Call MyItems.Remove(1, RemoveHandles, RemoveErrors)
            End If
        Next
    Else
        ' Set Button Enable
        Me.cmdAddItem.Enabled = False   ' Button add item disabled
        Me.cmdRemGroup.Enabled = False  ' Button removed group disabled
        Me.cmdRemItem.Enabled = True    ' Button removed item enabled
        Me.cmdWriteSync.Enabled = True  ' Button write synchronous enabled
        Me.cmdWriteAsync.Enabled = True ' Button write asynchronous enabled
        Me.cmdReadSync.Enabled = True   ' Button read synchronous enabled
        Me.cmdReadAsync.Enabled = True  ' Button read asynchronous disabled
    End If
    
    ' Multi line text for editbox of info code
    Me.tbSourceCode.Text = "Private Sub cmdAddItem_Click() " & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "    Dim i As Integer" & ChrW(13) & ChrW(10) & "    Dim ItemIDs() As String)" & ChrW(13) & ChrW(10) & "    Dim ItemCli" & _
    "entHandles As Long" & ChrW(13) & ChrW(10) & "    Dim Errors As Long)" & ChrW(13) & ChrW(10) & "       " & ChrW(13) & ChrW(10) & "    MyItems = MyGroup.OPCItems ' Get OPCItems Collection Obj" & _
    "ect from MyOPCServer" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "    ItemClientHandles(1) = 1" & ChrW(13) & ChrW(10) & "    ItemClientHandles(2) = 2" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "   ItemIDs(1) = txtItem1.Text ' Read ItemId 1 from Text Box" & ChrW(13) & ChrW(10) & _
    "   ItemIDs(2) = txtItem2.Text ' Read ItemId 2 from Text Box" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "   'Add Items to " & _
    "the Group" & ChrW(13) & ChrW(10) & "   Call MyItems.AddItems(2, ItemIDs, ItemClientHandles," & _
    " MyItemServerHandles, Errors)" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "End Sub"
    '
Exit Sub
ErrorHandler: ' Code that handles errors
    MsgBox Err.Description + Chr(13) + "Adding Items to the Group", vbCritical, "ERROR"
End Sub

 '************************************************************************************************
 '** @Sub cmdRemItem_Click | function remove OPCItems Collection Object from MyOPCServer         *
 '**                                                                                             *
 '** This function remove Items to the Group<nl>                                                 *
 '**                                                                                             *
 '************************************************************************************************

Private Sub cmdRemItem_Click()
On Error GoTo ErrorHandler ' Code that may or may not contain errors
    Dim i As Long
    Dim Errors() As Long ' Array for returned Item related errors
    
    ' Remove Items from the Group
    Call MyItems.Remove(2, MyItemServerHandles, 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 MyItemServerHandles ' Erase Item Server Handle Array
    
    ' Set Button Enable
    Me.cmdRemItem.Enabled = False    ' Button removed item disabled
    Me.cmdWriteSync.Enabled = False  ' Button write asynchronous disabled
    Me.cmdWriteAsync.Enabled = False ' Button write asynchronous disabled
    Me.cmdReadSync.Enabled = False   ' Button read synchronous disabled
    Me.cmdReadAsync.Enabled = False  ' Button read asynchronous disabled
    Me.cmdAddItem.Enabled = True     ' Button add item enabled
    Me.cmdRemGroup.Enabled = True    ' Button removed group enabled
    
    'Clear edit box
    Me.TxtDataChange.Text = 0
    Me.TxtAReadComplete.Text = 0
    Me.TxtAWriteComplete.Text = 0
    Me.txtChangeVal.Item(0).Text = ""
    Me.txtChangeVal.Item(1).Text = ""
    Me.txtWriteVal1.Text = 0
    Me.txtWriteVal2.Text = 0
    Me.txtReadVal.Item(0).Text = ""
    Me.txtReadVal.Item(1).Text = ""
    
    
    
    
    ' Multi line text for editbox of info code
    Me.tbSourceCode.Text = "Private Sub cmdRemItem_Click()" & ChrW(13) & ChrW(10) & "    " & ChrW(13) & ChrW(10) & "   'Array for returned Item related errors " & _
    "   " & ChrW(13) & ChrW(10) & "   Dim Errors As Long" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "   'Remove Items from the Group" & ChrW(13) & ChrW(10) & "   Call MyItems.Remove(2, MyItemSe" & _
    "rverHandles, Errors)" & ChrW(13) & ChrW(10) & "   Erase MyItemServerHandles ' Erase Item Server Handle Ar" & _
    "ray" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "End Sub"

Exit Sub
ErrorHandler: ' Code that handles errors
    MsgBox Err.Description + Chr(13) + "Removing Items from the Group", vbCritical, "ERROR"
End Sub

'************************************************************************************************
'** @Sub cmdWriteSync_Click | function Write Values Syncronous                                  *
'**                                                                                             *
'** This function write Items values Syncronous to the server<nl>                               *
'**                                                                                             *
'************************************************************************************************

Private Sub cmdWriteSync_Click()
On Error GoTo ErrorHandler ' Code that may or may not contain errors
    Dim i As Long
    Dim Values(2) As Variant ' Array for returned Item value
    Dim Errors() As Long     ' Array for returned Item related errors

    Values(1) = txtWriteVal1.Text ' Read Value 1 from Text Box
    Values(2) = txtWriteVal2.Text ' Read Value 2 from Text Box
        
    ' Write Values Syncronous
    Call MyGroup.SyncWrite(2, MyItemServerHandles, 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
    Next
    ' Multi line text for editbox of info code
    Me.tbSourceCode.Text = "Private Sub cmdWriteSync_Click()" & ChrW(13) & ChrW(10) & "      " & ChrW(13) & ChrW(10) & "   Dim Values As Variant" & ChrW(13) & ChrW(10) & "   Dim Errors As Long" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "   Values(1) = txtWriteVa" & _
    "l1.Text ' Read Value 1 from Text Box" & ChrW(13) & ChrW(10) & "   Values(2) = txtWriteVal2.Text ' Read Va" & _
    "lue 2 from Text Box" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "   'Write Values Syncronous" & ChrW(13) & ChrW(10) & "   Call MyGroup.SyncWrite(2," & _
    " MyItemServerHandles, Values, Errors)" & ChrW(13) & ChrW(10) & "       " & ChrW(13) & ChrW(10) & "End Sub"
    '
Exit Sub
ErrorHandler: ' Code that handles errors
    MsgBox Err.Description + Chr(13) + "Writing Items Syncronous", vbCritical, "ERROR"
End Sub

'************************************************************************************************
'** @Sub cmdReadSync_Click | function read Values Syncronous                                    *
'**                                                                                             *
'** This function read Items values Syncronous from the server<nl>                              *
'**                                                                                             *
'************************************************************************************************

Private Sub cmdReadSync_Click()
On Error GoTo ErrorHandler ' Code that may or may not contain errors
    Dim i As Long
    Dim Values() As Variant   ' Array for returned Item value
    Dim Errors() As Long      ' Array for returned Item related errors
    Dim Qualities As Variant  ' Array for returned Qualities of the Values
    Dim TimeStamps As Variant ' Array for returned Timestamps of the Values

    ' Read Values Syncronous
    Call MyGroup.SyncRead(OPCDevice, 2, MyItemServerHandles, Values, Errors, Qualities, TimeStamps)
     
    ' Check errors and parameters
    For i = 1 To 2
        If Not Errors(i) = 0 Then
            MsgBox "Item " + Str$(i) + " FAILED. Error Code = " + Str$(Errors(i)), vbCritical
        Else
           
            ' Qualities of the returned values
            If Qualities(i) = 192 Then
                txtReadVal.Item(i - 1).Text = Values(i) ' Write Value to Text Box
                txtReadVal.Item(i - 1).BackColor = &HFFFFFF
            Else
                txtReadVal.Item(i - 1).Text = GetQualityText(Qualities(i))
                txtReadVal.Item(i - 1).BackColor = &H8080FF
            End If
        End If
    Next
    
    ' Multi line text for editbox of info code
    Me.tbSourceCode.Text = "Private Sub cmdReadSync_Click() " & ChrW(13) & ChrW(10) & "       " & ChrW(13) & ChrW(10) & "   Dim Values As Variant" & ChrW(13) & ChrW(10) & "   Dim Errors As Long" & ChrW(13) & ChrW(10) & "   Dim Qualities As Variant" & ChrW(13) & ChrW(10) & "   Dim TimeStamps" & _
    " As Variant" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "   Cal" & _
    "l MyGroup.SyncRead(OPCDevice, 2, MyItemServerHandles" & _
    ", Values, Errors, Qualities, TimeStamps)" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "End Sub"
    '
Exit Sub
ErrorHandler: ' Code that handles errors
    MsgBox Err.Description + Chr(13) + "Reading Items Syncronous", vbCritical, "ERROR"
End Sub