frmmain.frm

vb编写的opc客户端

      Caption         =   "B Section"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   24
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   615
      Left            =   3240
      TabIndex        =   71
      Top             =   240
      Width           =   2295
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const DataCountFromDCS = 27                           '从DCS读取的数据个数
Const DataCountToDCS = 7                               '向DCS写入的数据个数
Const DataCountFromNMAC = 7                            '从NMAC读取的数据个数
Const DataCountToNMAC = 27                             '向NMAC写入的数据个数


Dim WithEvents ServerObject As OPCServer               '声明OPCServer对象
Attribute ServerObject.VB_VarHelpID = -1
Dim AnOpcGroups As OPCGroups                           '声明OPCGroups对象
Dim GroupIn As OPCGroup                                '声明OPCGroup对象,从DCS读取数据的组
Dim GroupOut As OPCGroup                               '声明OPCGroup对象,向DCS写入数据的组
Dim ItemsFromDCS As OPCItems                           '声明OPCItems对象,从DCS读取数据的项目集
Dim ItemsToDCS As OPCItems                             '声明OPCItems对象,向DCS写入数据的项目集
Dim Items As OPCItems                                  '声明OPCItems对象


Dim Source As Integer                                  '数据源标志,取值为:OPCDevice 或OPCCache
Dim NumItems As Long                                   '

Dim IDFromDCS(1 To DataCountFromDCS) As String         '从DCS读取的数据ID
Dim IDToDCS(1 To DataCountToDCS) As String             '向DCS写入的数据ID

Dim ClientInHandles(1 To DataCountFromDCS) As Long     '从DCS读取的数据句柄
Dim ClientOutHandles(1 To DataCountFromDCS) As Long    '向DCS写入的数据句柄

Dim OpcError1(1 To DataCountFromDCS) As Long           '错误信息处理
Dim OpcError2(1 To DataCountToDCS) As Long

Dim InDataFromDCS(1 To DataCountFromDCS) As Variant    '存放从DCS读取的数据的缓冲区
Dim OutDataToDCS(1 To DataCountToDCS) As Variant       '存放向DCS写入的数据的缓冲区


Dim OpcServerInHandles(1 To DataCountFromDCS) As Long  '存放从DCS读取的数据句柄的缓冲区
Dim OpcServerOutHandles(1 To DataCountToDCS) As Long   '存放向DCS写入的数据句柄的缓冲区
' Dim SendData(1 To DataCountFromDCS) As Single


Private Sub Connect_Click()
    m_HCCom3A1.Connect                                 '与NMAC连接
    Connect.Enabled = False
End Sub

Private Sub Form_Load()
    On Error GoTo ErrorHandler
    m_HCCom3A1.StartListen
    For X = 1 To DataCountFromDCS
        m_HCCom3A1.SetDigitItem 100 + X
    Next
        
    Dim t As Integer                                   '定义一个整型变量
    Set ServerObject = New OPCServer                   '建立OPCServer对象
        
    ServerObject.Connect ("OPC.DELTAV.1")              '连接OPCServer服务器
    Set AnOpcGroups = ServerObject.OPCGroups           '获取OPCServer对象组
    AnOpcGroups.Add "BIn"                               '添加从DCS读取数据的组
    AnOpcGroups.Add "BOut"                              '添加从DCS写入数据的组
    
   AddReadITems                                       '添加从DCS读取数据的项目集
   AddWriteITems                                     '添加向DCS写入数据的项目集
     Exit Sub
ErrorHandler:
    MsgBox "Form_Load: Error!" & vbCrLf _
        & "Err.Number = " & Err.Number & vbCrLf _
        & "Err.Description = " & Err.Description & vbCrLf _
        & "Err.Source = " & Err.Source & vbCrLf
        Err.Clear
End Sub

Public Sub AddReadITems()
On Error GoTo ErrorHandler
    Dim X As Integer
    Dim anItem As OPCItem
    Set GroupIn = AnOpcGroups.GetOPCGroup("BIn")        '获取从DCS读取数据的组
    Set ItemsFromDCS = GroupIn.OPCItems                '获取从DCS读取数据的项目集
    For X = 1 To DataCountFromDCS
        ClientInHandles(X) = 2000 + X                  '设置从DCS读取数据的句柄
    Next
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''从DCS读取数据的ID
    IDFromDCS(1) = "TI-3221/TI-3221SP.CV"              'TE-3221温度给定值
    IDFromDCS(2) = "TI-3221/AI1/OUT.CV"                'TE-3221温度测量值
    IDFromDCS(3) = "TI-3222/TI-3222SP.CV"              'TE-3222温度给定值
    IDFromDCS(4) = "TIC-3222M/PID1/BKCAL_OUT.CV"       'TE-3222温度测量值
    'IDFromDCS(4) = "TI-3222/AI1/OUT.CV"                'TE-3222温度测量值
    IDFromDCS(5) = "TI-3223/TI-3223SP.CV"              'TE-3223温度给定值
    IDFromDCS(6) = "TI-3223/AI1/OUT.CV"                'TE-3223温度测量值
    IDFromDCS(7) = "TIC-32111/FV_3211/BKCAL_OUT.CV"    'FV_3211阀门测量值
    IDFromDCS(8) = "FV_3212/AO1/OUT.CV"                'FV_3212阀门测量值
    IDFromDCS(9) = "TIC-3222S/FV_3213/BKCAL_OUT.CV"    'FV_3213阀门测量值
    IDFromDCS(10) = "TIC-3222S/FV_3214/BKCAL_OUT.CV"   'FV_3214阀门测量值
    IDFromDCS(11) = "TIC-32112/FV_3215/BKCAL_OUT.CV"   'FV_3215阀门测量值
    IDFromDCS(12) = "FV_3216/AO1/OUT.CV"               'FV_3216阀门测量值
    IDFromDCS(13) = "TIC-32111/SELECT.CV"              'TE-3221切换信号
    IDFromDCS(14) = "TIC-3222S/SELECT.CV"              'TE-3222切换信号
    IDFromDCS(15) = "TIC-32112/SELECT.CV"              'TE-3223切换信号
    IDFromDCS(16) = "TI-3231/AI1/OUT.CV"               'TE-3231温度测量值
    IDFromDCS(17) = "TI-3232/AI1/OUT.CV"               'TE-3232温度测量值
    IDFromDCS(18) = "TI-3233/AI1/OUT.CV"               'TE-3233温度测量值
    IDFromDCS(19) = "TI-3121/AI1/OUT.CV"               'TE-3121温度测量值
    IDFromDCS(20) = "TI-3122/AI1/OUT.CV"               'TE-3122温度测量值
    IDFromDCS(21) = "TI-3123/AI1/OUT.CV"               'TE-3123温度测量值
    IDFromDCS(22) = "TI-32111/AI1/OUT.CV"              'TE-32111温度测量值
    IDFromDCS(23) = "TI-32112/AI1/OUT.CV"              'TE-32112温度测量值
    IDFromDCS(24) = "TIC-32111/TN_3231/BKCAL_OUT.CV"   'TN_3231测量值
    IDFromDCS(25) = "TN_3232/AO1/OUT.CV"               'TN_3232测量值
    IDFromDCS(26) = "TIC-32112/TN_3233/BKCAL_OUT.CV"   'TN_3233测量值
    IDFromDCS(27) = "TI-3215/AI1/OUT.CV"               'TE-3215测量值
    For X = 1 To DataCountFromDCS
        ItemsFromDCS.AddItem IDFromDCS(X), ClientInHandles(X)       '添加项目
    Next
    For X = 1 To DataCountFromDCS
        Set anItem = ItemsFromDCS.Item(X)                           '获取项目句柄
        OpcServerInHandles(X) = anItem.ServerHandle
    Next
    
    Exit Sub
ErrorHandler:
    If Err.Number = -1073479673 Then
        Err.Clear
        Exit Sub
    Else
        MsgBox "Add Read Item: Error!" & vbCrLf _
        & "Err.Number = " & Err.Number & vbCrLf _
        & "Err.Description = " & Err.Description & vbCrLf _
        & "Err.Source = " & Err.Source & vbCrLf
        Err.Clear
    End If
  End Sub
      
    Public Sub GetDataFromDcs()
    On Error GoTo ErrorHandler
    Dim anItem As OPCItem
    Source = OPCDevice 'OPCCache                                    '设置数据源标志
    
    For X = 1 To DataCountFromDCS
     Set anItem = ItemsFromDCS.GetOPCItem(OpcServerInHandles(X))
    
            anItem.Read Source, InDataFromDCS(X)                    '读取数据
     
    Next
    
    Exit Sub
ErrorHandler:
   If Err.Number = -1073479673 Then
        Err.Clear
        Exit Sub
    Else
        MsgBox "Read Data From DCS: Error!" & vbCrLf _
        & "Err.Number = " & Err.Number & vbCrLf _
        & "Err.Description = " & Err.Description & vbCrLf _
        & "Err.Source = " & Err.Source & vbCrLf
        Err.Clear
    End If
   
End Sub
'添加向DCS写入数据的项目集
Public Sub AddWriteITems()
On Error GoTo ErrorHandler
    Dim anItem As OPCItem
    Dim X As Integer
    Dim outdata As Single
    Set GroupOut = AnOpcGroups.GetOPCGroup("BOut")             '获取向DCS写入数据的组
    
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''添加向DCS写入数据的ID
    
    IDToDCS(1) = "TIC-32111/NM_FV3211.CV"                     'FV3211测量值
    IDToDCS(2) = "FV_3212/NM_FV3212.CV"                       'FV3212测量值
    IDToDCS(3) = "TIC-3222S/NM_FV3213.CV"                     'FV3213测量值
    IDToDCS(4) = "TIC-3222S/NM_FV3214.CV"                     'FV3214测量值
    IDToDCS(5) = "TIC-32112/NM_FV3215.CV"                     'FV3215测量值
    IDToDCS(6) = "FV_3216/NM_FV3216.CV"                       'FV3216测量值
    
    IDToDCS(7) = "COMM-LIST/LISTENSIGNB.CV"                   'LISTENSIGN侦听信号B
    For X = 1 To DataCountToDCS
        ClientOutHandles(X) = 3000 + X                        '设置向DCS写入数据的句柄
    Next

   
    Set ItemsToDCS = GroupOut.OPCItems
    For X = 1 To DataCountToDCS
        ItemsToDCS.AddItem IDToDCS(X), ClientOutHandles(X)    '添加向DCS写入数据的项目
    Next

    For X = 1 To DataCountToDCS
        Set anItem = ItemsToDCS.Item(X)
        OpcServerOutHandles(X) = anItem.ServerHandle          '获取向DCS写入数据的句柄
    Next
    Exit Sub
ErrorHandler:
   If Err.Number = -1073479673 Then
        Err.Clear
        Exit Sub
    Else
        MsgBox "Add Write ITems: Error!" & vbCrLf _
        & "Err.Number = " & Err.Number & vbCrLf _
        & "Err.Description = " & Err.Description & vbCrLf _
        & "Err.Source = " & Err.Source & vbCrLf
        Err.Clear
    End If
End Sub
Public Sub PutDataToDcs()
    On Error GoTo ErrorHandler
    Dim anItem As OPCItem
    For X = 1 To DataCountToDCS
        Set anItem = ItemsToDCS.GetOPCItem(OpcServerOutHandles(X))
        anItem.Write OutDataToDCS(X)                          '向DCS写入数据
    Next
    Exit Sub
ErrorHandler:
   If Err.Number = -1073479673 Then
        Err.Clear
        Exit Sub
    Else
        MsgBox "Timer Runing Time: Error!" & vbCrLf _
        & "Err.Number = " & Err.Number & vbCrLf _
        & "Err.Description = " & Err.Description & vbCrLf _
        & "Err.Source = " & Err.Source & vbCrLf
        Err.Clear
    End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo ErrorHandler
    validatepwd.Show
    If signpwd = 0 Then
         Timer1.Enabled = False
      
         AnOpcGroups.RemoveAll                                  '移除所有数据
        ServerObject.Disconnect                                  '断开连接
     
        Cancel = 1
    End If
    
    Exit Sub
ErrorHandler:
    MsgBox "Form_Unload: Error!" & vbCrLf _
        & "Err.Number = " & Err.Number & vbCrLf _
        & "Err.Description = " & Err.Description & vbCrLf _
        & "Err.Source = " & Err.Source & vbCrLf
        Err.Clear
   
End Sub

Private Sub Quit_Click()                                     '响应退出按钮
Unload Me
End Sub

Private Sub Timer1_Timer()                                   '定时器
    On Error GoTo ErrorHandler
    GetDataFromDcs                                           '从DCS获取数据
    GetDataFromNmac                                         '从NMAC获取数据
    PutDataToDcs                                            '向DCS写入数据
    PutDataToNmac                                            '向NMAC写入数据
    Display                                                  '显示数据
        Exit Sub
ErrorHandler:
   If Err.Number = -1073479673 Then
        Err.Clear
        Exit Sub
    Else
        MsgBox "Timer Runing Time: Error!" & vbCrLf _
        & "Err.Number = " & Err.Number & vbCrLf _
        & "Err.Description = " & Err.Description & vbCrLf _
        & "Err.Source = " & Err.Source & vbCrLf
        Err.Clear
    End If
End Sub
Public Sub GetDataFromNmac()
On Error GoTo ErrorHandler
    Dim i As Integer
    For i = 1 To DataCountToDCS
       OutDataToDCS(i) = m_HCCom3A1.GetDataByDigit(100 + i)
    Next
    
Exit Sub
ErrorHandler:
        MsgBox "Read Data From Nmac: Error!" & vbCrLf _
        & "Err.Number = " & Err.Number & vbCrLf _
        & "Err.Description = " & Err.Description & vbCrLf _
        & "Err.Source = " & Err.Source & vbCrLf
        Err.Clear
End Sub
Public Sub PutDataToNmac()
On Error GoTo ErrorHandler
    Dim SendData(1 To DataCountFromDCS) As Single
    Dim slong(1 To DataCountFromDCS) As Long
    Dim i As Integer
    For i = 1 To DataCountFromDCS
        slong(i) = 100 + i
        
            SendData(i) = InDataFromDCS(i)
        
    Next
    For i = 13 To 15
        If SendData(i) <= 1.5 Then                                     '0=DCS
            SendData(i) = 0#
        Else
            SendData(i) = 100#                                         '100=NMAC
        End If
        
    Next
    m_HCCom3A1.SendDataByDigit DataCountFromDCS, slong(1), SendData(1)
    
 Exit Sub
ErrorHandler:
   
        MsgBox "Write Data to Nmac: Error!" & vbCrLf _
        & "Err.Number = " & Err.Number & vbCrLf _
        & "Err.Description = " & Err.Description & vbCrLf _
        & "Err.Source = " & Err.Source & vbCrLf
        Err.Clear
End Sub
Public Sub Display()
    txtGetData1 = Str(InDataFromDCS(1))                      'TE-3221温度给定值
    txtGetData2 = Str(InDataFromDCS(2))                      'TE-3221温度测量值
    txtGetData3 = Str(InDataFromDCS(3))                      'TE-3222温度给定值
    txtGetData4 = Str(InDataFromDCS(4))                      'TE-3222温度测量值
    txtGetData5 = Str(InDataFromDCS(5))                      'TE-3223温度给定值
    txtGetData6 = Str(InDataFromDCS(6))                      'TE-3223温度测量值
    txtGetData7 = Str(InDataFromDCS(7))                      'FV_3211阀门测量值
    txtGetData8 = Str(InDataFromDCS(8))                      'FV_3212阀门测量值
    txtGetData9 = Str(InDataFromDCS(9))                      'FV_3213阀门测量值
    txtGetData10 = Str(InDataFromDCS(10))                    'FV_3214阀门测量值
    txtGetData11 = Str(InDataFromDCS(11))                    'FV_3215阀门测量值
    txtGetData12 = Str(InDataFromDCS(12))                    'FV_3216阀门测量值
    txtGetData13 = Str(InDataFromDCS(13))                    'TE-3221切换信号
    txtGetData14 = Str(InDataFromDCS(14))                    'TE-3222切换信号
    txtGetData15 = Str(InDataFromDCS(15))                    'TE-3223切换信号
    
    txtGetData16 = Str(InDataFromDCS(16))                    'TE-3231温度测量值
    txtGetData17 = Str(InDataFromDCS(17))                    'TE-3232温度测量值
    txtGetData18 = Str(InDataFromDCS(18))                    'TE-3233温度测量值
    txtGetData19 = Str(InDataFromDCS(19))                    'TE-3121温度测量值
    txtGetData20 = Str(InDataFromDCS(20))                    'TE-3122温度测量值
    txtGetData21 = Str(InDataFromDCS(21))                    'TE-3123温度测量值
    txtGetData22 = Str(InDataFromDCS(22))                    'TE-32111温度测量值
    txtGetData23 = Str(InDataFromDCS(23))                    'TE-32112温度测量值
    txtGetData24 = Str(InDataFromDCS(24))                    'TN_3231测量值
    txtGetData25 = Str(InDataFromDCS(25))                    'TN_3232测量值
    txtGetData26 = Str(InDataFromDCS(26))                    'TN_3233测量值
    txtGetData27 = Str(InDataFromDCS(27))                    'TE-3215测量值
    
    txtSendData1 = Str(OutDataToDCS(1))                      'FV3211阀门值
    txtSendData2 = Str(OutDataToDCS(2))                      'FV3212阀门值
    txtSendData3 = Str(OutDataToDCS(3))                      'FV3213阀门值
    txtSendData4 = Str(OutDataToDCS(4))                      'FV3214阀门值
    txtSendData5 = Str(OutDataToDCS(5))                      'FV3215阀门值
    txtSendData6 = Str(OutDataToDCS(6))                      'FV3216阀门值
    
    txtListenData = Str(OutDataToDCS(7))                     'LISTENSIGN侦听信号B据
    
End Sub