mainform.frm

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

 '************************************************************************************************
 '** @Sub cmdWriteAsync_Click | function write Values Asyncronous                                *
 '**                                                                                             *
 '** This function write Items values Asyncronous to the server<nl>                              *
 '**                                                                                             *
 '************************************************************************************************
Private Sub cmdWriteAsync_Click()
On Error GoTo ErrorHandler
    Dim i As Long
    Dim Values(2) As Variant ' Array for returned Item value
    Dim Errors() As Long     ' Array for returned Item related errors
    Dim CID As Long          ' CancelID, Server generating value with identification transaction

    
    ' Values to write
    Values(1) = txtWriteVal1.Text ' Read Value 1 from Text Box
    Values(2) = txtWriteVal2.Text ' Read Value 2 from Text Box
    
    MyTID = MyTID + 1   ' Increment Transaction ID
    
    ' Write Values Asyncronous
    Call MyGroup.AsyncWrite(2, MyItemServerHandles, Values, Errors, MyTID, CID)
     
    ' 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 cmdWriteAsync_Click() " & ChrW(13) & ChrW(10) & "   " & ChrW(13) & ChrW(10) & "  'Array for returned Item related error" & _
    "s" & ChrW(13) & ChrW(10) & "   Dim Errors As Long) " & ChrW(13) & ChrW(10) & "   Dim Values As Variant  " & ChrW(13) & ChrW(10) & "   Dim CID As Long'CancelID, Server generated value with tr" & _
    "ansaction identification  " & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "   Values(1) = txtWriteVal1.Text ' Read Value 1 fr" & _
    "om Text Box" & ChrW(13) & ChrW(10) & "   Values(2) = txtWriteVal2.Text ' Read Value 2 from Text Box" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "  " & _
    " MyTID = MyTID + 1 ' Increment Transaction ID" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "   'Write Values Asyncronous" & ChrW(13) & ChrW(10) & " " & _
    "  Call MyGroup.AsyncWrite(2, MyItemServerHandles, Values, Errors, MyTID, CID)" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "End Sub"
    '
Exit Sub
ErrorHandler: ' Code that handles errors
    MsgBox Err.Description + Chr(13) + "Writing Items Asyncronous", vbCritical, "ERROR"
End Sub

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

Private Sub cmdReadAsync_Click()
On Error GoTo ErrorHandler
    Dim i As Long
    Dim Errors() As Long ' Array for returned Item related errors
    Dim CID As Long      ' CancelID, Server generating value with identification transaction
    
    ' Server defined handles from the AddItems call
    MyTID = MyTID + 1 ' Increment Transaction ID
    
    ' Read Values Syncronous
    Call MyGroup.AsyncRead(2, MyItemServerHandles, Errors, MyTID, CID)
     
    ' 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 cmdReadAsync_Click() " & ChrW(13) & ChrW(10) & "        " & ChrW(13) & ChrW(10) & "   Dim Errors As System.Array = Syst" & _
    "em.Array.CreateInstance(GetType(Long), maxItem) ' Array for " & ChrW(13) & ChrW(10) & "   returned Item r" & _
    "elated errors" & ChrW(13) & ChrW(10) & "   " & ChrW(13) & ChrW(10) & "   Dim CID As Integer ' CancelID, Server generating value wi" & _
    "th identification transaction" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "   MyTID = MyTID + 1 ' Increment Transaction ID" & _
    "" & ChrW(13) & ChrW(10) & ChrW(13) & ChrW(10) & "End Sub"
    '
Exit Sub
ErrorHandler: ' Code that handles errors
    MsgBox Err.Description + Chr(13) + "Reading Items Asyncronous", vbCritical, "ERROR"
End Sub



'************************************************************************************************
'** @Sub MyGroup_AsyncReadComplete | function catch callback from AsyncRead                     *
'**                                                                                             *
'** This function Set value count asynchronous read complete<nl>                                *
'**                                                                                             *
'************************************************************************************************

Private Sub MyGroup_AsyncReadComplete(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date, Errors() As Long)
On Error GoTo ErrorHandler ' Code that may or may not contain errors
    Dim i As Long
    
    TxtAReadComplete.Text = TxtAReadComplete.Text + 1 'Set value count asynchronous read complete
    
    ' Check Parameters
    For i = 1 To NumItems
        If Not Errors(i) = 0 Then
            MsgBox "AsyncReadComplete Item Clienthandle = " + Str$(ClientHandles(i)) + " FAILED. Error Code = " + Str$(Errors(i)), vbCritical
        ElseIf ClientHandles(i) > 0 And ClientHandles(i) < 3 Then
            
            ' Qualities of the values
            If Qualities(i) = 192 Then
                txtReadVal.Item(ClientHandles(i) - 1).Text = ItemValues(i) ' Write Value to Text Box
                txtReadVal.Item(ClientHandles(i) - 1).BackColor = &HFFFFFF
            Else
                txtReadVal.Item(ClientHandles(i) - 1).Text = GetQualityText(Qualities(i))
                txtReadVal.Item(ClientHandles(i) - 1).BackColor = &H8080FF
            End If
        Else
            MsgBox "AsyncWriteComplete Item " + Str$(i) + " has invalid Client Handle ", vbCritical
        End If
    Next
Exit Sub
ErrorHandler: ' Code that handles errors
    MsgBox Err.Description + Chr(13) + "Async Read Complete", vbCritical, "ERROR"
End Sub

'************************************************************************************************
'** @Sub MyGroup_AsyncWriteComplete | function catch callback from AsyncWrite                   *
'**                                                                                             *
'** This function Set value count asynchronous write complete<nl>                               *
'**                                                                                             *
'************************************************************************************************

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
    
    TxtAWriteComplete.Text = TxtAWriteComplete.Text + 1 'Set value count asynchronous write complete
    
    ' Check Item Errors
    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: ' Code that handles errors
    MsgBox Err.Description + Chr(13) + "Async Write Complete", vbCritical, "ERROR"
End Sub

 '************************************************************************************************
 '** @Sub MyGroup_DataChange | function catch callback from OnDataChange                         *
 '**                                                                                             *
 '** This function Set value count asynchronous Data Change complete<nl>                         *
 '**                                                                                             *
 '************************************************************************************************

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 ' Code that may or may not contain errors
    Dim i As Long
    
    TxtDataChange.Text = TxtDataChange.Text + 1 ' Set value count data change complete
    
    ' 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
                txtChangeVal.Item(ClientHandles(i) - 1).BackColor = &HFFFFFF
            Else
                txtChangeVal.Item(ClientHandles(i) - 1).Text = GetQualityText(Qualities(i))
                txtChangeVal.Item(ClientHandles(i) - 1).BackColor = &H8080FF
            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

 '************************************************************************************************
 '** @Sub cmdExit_Click | function close application                                             *
 '**                                                                                             *
 '** This function close application<nl>                                                         *
 '**                                                                                             *
 '************************************************************************************************

Private Sub cmdExit_Click()
    Unload Me 'close application
End Sub

'************************************************************************************************
'** @Sub Form_Load | function load application formular                                         *
'**                                                                                             *
'** This function fill combobox whith server list<nl>                                           *
'**                                                                                             *
'************************************************************************************************

Private Sub Form_Load()
 
On Error GoTo ErrorHandler ' Code that may or may not contain errors
        MyTID = 1 ' Reset Transaction ID
        
        Dim AnOPCServerList As Variant
        Dim i As Integer
        Dim setVal As Integer   ' index for set selected server item
        Dim SNums As Integer    ' Array for returned servers
        Dim srvList() As String ' Server list by String, NOT ARRAY
        Dim ProgID As Variant
        Set MyOPCServer = New OPCServer
        i = 1
        AnOPCServerList = MyOPCServer.GetOPCServers  ' Returned OPC Servers
             
        For Each ProgID In AnOPCServerList 'add servers in combobox
       
            If (AnOPCServerList(i) <> "") Then
                Me.cmbListOpcServer.AddItem (AnOPCServerList(i))
                If AnOPCServerList(i) = "SAEAutomation.SNMPOpcServerDA.3" Then 'Set flag if server is "SAEAutomation.SNMPOpcServerDA.3"
                    setVal = i
                End If
                i = i + 1
            End If
            
        Next
               
        Me.cmbListOpcServer.ListIndex = (setVal - 1) ' Set select an 'SAEAutomation.SNMPOpcServerDA.3' server
        Me.cmbListOpcServer.Enabled = True ' Button combobox server list enabled
         
    Exit Sub

ErrorHandler:  ' Code that handles errors
        MsgBox Err.Description + Chr(13) + "Load form", vbCritical, "ERROR"
End Sub

'************************************************************************************************
'** @Sub Form_Unload | function Unload application formular                                     *
'**                                                                                             *
'** This function deactive  safe server connection<nl>                                          *
'**                                                                                             *
'************************************************************************************************

Private Sub Form_Unload(Cancel As Integer)
    If cmdRemItem.Enabled = True Then Call cmdRemItem_Click
    If cmdRemGroup.Enabled = True Then Call cmdRemGroup_Click
    If cmdDisconnect.Enabled = True Then Call cmdDisconnect_Click
End Sub

'************************************************************************************************
'** @Function GetQualityText | function selected case quality for item                          *
'**                                                                                             *
'** This function selected quality quality for itemn<nl>                                        *
'**                                                                                             *
'************************************************************************************************

Private Function GetQualityText(Quality) As String
    Select Case Quality
        Case 0:     GetQualityText = "BAD"
        Case 64:    GetQualityText = "UNCERTAIN"
        Case 192:   GetQualityText = "GOOD"
        Case 8:     GetQualityText = "NOT_CONNECTED"
        Case 13:    GetQualityText = "DEVICE_FAILURE"
        Case 16:    GetQualityText = "SENSOR_FAILURE"
        Case 20:    GetQualityText = "LAST_KNOWN"
        Case 24:    GetQualityText = "COMM_FAILURE"
        Case 28:    GetQualityText = "OUT_OF_SERVICE"
        Case 132:   GetQualityText = "LAST_USABLE"
        Case 144:   GetQualityText = "SENSOR_CAL"
        Case 148:   GetQualityText = "EGU_EXCEEDED"
        Case 152:   GetQualityText = "SUB_NORMAL"
        Case 216:   GetQualityText = "LOCAL_OVERRIDE"
        
        Case Else: GetQualityText = "UNKNOWN QUALITY"
    End Select
End Function