opcform.frm

opc-OLE PROCESS on Controll

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form OpcForm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "专用数据网关"
   ClientHeight    =   7845
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   11175
   Icon            =   "OpcForm.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7845
   ScaleWidth      =   11175
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer timerTestWork 
      Interval        =   1000
      Left            =   2400
      Top             =   3120
   End
   Begin VB.Timer timerGetData 
      Interval        =   1000
      Left            =   1560
      Top             =   3120
   End
   Begin VB.CommandButton drop 
      Caption         =   "复位"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   8040
      TabIndex        =   3
      Top             =   7200
      Width           =   1215
   End
   Begin VB.CommandButton Connect 
      Caption         =   "连接"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   9600
      TabIndex        =   2
      Top             =   7200
      Width           =   1215
   End
   Begin MSComctlLib.ListView dataList 
      Height          =   6135
      Left            =   0
      TabIndex        =   1
      Top             =   120
      Width           =   11175
      _ExtentX        =   19711
      _ExtentY        =   10821
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      AllowReorder    =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   4
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "序号"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "点号"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "当前值"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   3
         Text            =   "通道状态"
         Object.Width           =   2540
      EndProperty
   End
   Begin VB.Label labLastError 
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   2040
      TabIndex        =   6
      Top             =   6480
      Width           =   8775
   End
   Begin VB.Label Label2 
      Caption         =   "最后错误代码："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   5
      Top             =   6480
      Width           =   1695
   End
   Begin VB.Label Label1 
      Caption         =   "运行状态："
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   720
      TabIndex        =   4
      Top             =   7200
      Width           =   1215
   End
   Begin VB.Label workstatus 
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2040
      TabIndex        =   0
      Top             =   7200
      Width           =   5775
   End
End
Attribute VB_Name = "OpcForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Option Explicit
Option Base 1

'变量定义
 
Private DataNotChangeCount As Long

Private WithEvents ClientOPCServer As OPCServer
Attribute ClientOPCServer.VB_VarHelpID = -1
Private ConnectedServerGroup As OPCGroups
Private WithEvents ConnectedGroup As OPCGroup
Attribute ConnectedGroup.VB_VarHelpID = -1

' OPC Item related data
Private OPCItemCollection As OPCItems
Private OneOPCItem As OPCItem


Private Sub AddItems()
    
    If ConnectedGroup Is Nothing Then
         GoTo OPCEnd
    End If
    
    Me.workstatus = "服务器正在添加位号..."
    'error handle
    On Error GoTo ShowOPCItemAddError
    
    '*************************************************
    'OPCItemIDs这里
    GetTagName   '获取位号名
    
    'ClientHandles这里
    Dim i As Long
        
    For i = 1 To ItemCount
        ClientHandles(i) = i
    Next i
    
    ')))))))))))))))))))))))))))))))))))))))))))))))))))))
    
    Set OPCItemCollection = ConnectedGroup.OPCItems
    OPCItemCollection.DefaultIsActive = True
    OPCItemCollection.Add ItemCount, OPCItemIDs(), ClientHandles(), ItemServerHandles, ItemServerErrors
    
    'ItemServerErrors(当返回正确时为0，错误时为ItemServerHandles标定为空）
    
    For i = 1 To ItemCount
        If ItemServerErrors(i) <> 0 Then
            ItemServerHandles(i) = 0  ' If the handle was bad mark it as empty
            ItemErrorHandles(i) = ClientHandles(i) '将错误的句炳保存
        End If
        
    Next i
        
    GoTo ShowOPCItemAddSuccess
    
ShowOPCItemAddError:
     Set OPCItemCollection = Nothing
     Call DisplayOPC_COM_ErrorValue("添加位号出错", Err.Number)
     
     DisconnectOpc
     IsConnectSuccess = False
     Exit Sub
     
ShowOPCItemAddSuccess:
     Me.workstatus.Caption = "服务器正在运行"
     IsConnectSuccess = True
OPCEnd:
     
End Sub



Private Sub ConnectToServer()
    '错误处理
    
    Me.workstatus = "服务器正在连接OPC服务器..."
    
    On Error GoTo ShowOPCGetServersError
    
    Dim ConnectedNodeName As String
    
    '建立opc服务器并连接服务器
    Set ClientOPCServer = New OPCServer
    
    ConnectedNodeName = DcsComputer
    'Attempt to connect with the server连接到服务器
    ClientOPCServer.Connect OpcServerName, ConnectedNodeName
    
    GoTo SkipOPCItemActiveStateError
    
ShowOPCGetServersError: