form1.frm

学习开发opcserver和opcclient的好例子

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Begin VB.Form Form1 
   Caption         =   "[e-mail] QQ:10167223 "
   ClientHeight    =   4080
   ClientLeft      =   1860
   ClientTop       =   1830
   ClientWidth     =   5505
   LinkTopic       =   "Form1"
   ScaleHeight     =   4080
   ScaleWidth      =   5505
   Begin VB.CommandButton btnExit 
      Caption         =   "Exit"
      Height          =   372
      Left            =   4320
      TabIndex        =   12
      Top             =   3600
      Width           =   972
   End
   Begin VB.CommandButton btnStopLoop 
      Caption         =   "Stop Loop"
      Enabled         =   0   'False
      Height          =   372
      Left            =   2760
      TabIndex        =   11
      Top             =   3600
      Width           =   972
   End
   Begin VB.CommandButton btnLoopRead 
      Caption         =   "Loop Read"
      Enabled         =   0   'False
      Height          =   372
      Left            =   2760
      TabIndex        =   10
      Top             =   3120
      Width           =   972
   End
   Begin VB.CommandButton btnWrite 
      Caption         =   "Write"
      Enabled         =   0   'False
      Height          =   372
      Left            =   1920
      TabIndex        =   9
      Top             =   3600
      Width           =   612
   End
   Begin VB.CommandButton btnRead 
      Caption         =   "Read"
      Enabled         =   0   'False
      Height          =   372
      Left            =   1920
      TabIndex        =   8
      Top             =   3120
      Width           =   612
   End
   Begin VB.CommandButton btnDisconnect 
      Caption         =   "Disconnect"
      Enabled         =   0   'False
      Height          =   372
      Left            =   4200
      TabIndex        =   7
      Top             =   360
      Width           =   1092
   End
   Begin VB.CommandButton btnConnect 
      Caption         =   "Connect"
      Height          =   372
      Left            =   3000
      TabIndex        =   6
      Top             =   360
      Width           =   972
   End
   Begin VB.TextBox eTagValue 
      Height          =   288
      Left            =   120
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   3360
      Width           =   1572
   End
   Begin ComctlLib.TreeView tvTagList 
      Height          =   1932
      Left            =   120
      TabIndex        =   2
      Top             =   1080
      Width           =   5172
      _ExtentX        =   9128
      _ExtentY        =   3413
      _Version        =   327682
      LineStyle       =   1
      PathSeparator   =   "."
      Style           =   7
      Appearance      =   1
   End
   Begin VB.ComboBox cbServerList 
      Height          =   288
      Left            =   120
      TabIndex        =   1
      Text            =   "Combo1"
      Top             =   360
      Width           =   2652
   End
   Begin VB.Label lCounter 
      Caption         =   "0"
      Height          =   252
      Left            =   840
      TabIndex        =   15
      Top             =   3720
      Width           =   852
   End
   Begin VB.Label Label4 
      Caption         =   "Counter:"
      Height          =   252
      Left            =   120
      TabIndex        =   14
      Top             =   3720
      Width           =   612
   End
   Begin VB.Label lTagSelected 
      Caption         =   "Tag"
      Height          =   252
      Left            =   1320
      TabIndex        =   13
      Top             =   840
      Width           =   3972
   End
   Begin VB.Label Label3 
      Caption         =   "Tag Value"
      Height          =   252
      Left            =   120
      TabIndex        =   5
      Top             =   3120
      Width           =   972
   End
   Begin VB.Label Label2 
      Caption         =   "Tag Selected: "
      Height          =   252
      Left            =   120
      TabIndex        =   3
      Top             =   840
      Width           =   1092
   End
   Begin VB.Label Label1 
      Caption         =   "OPC Server"
      Height          =   252
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   972
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public WithEvents callbackGroup As OPCGroup
Attribute callbackGroup.VB_VarHelpID = -1
Public browser As OPCBrowser
Dim gValues(10) As Variant
Dim bStopProcess As Boolean

Private Sub FillServers()
    On Error GoTo Problems

    MousePointer = vbHourglass
    cbServerList.Clear
    
    Dim Servers As Variant
    Set Server = New OPCServer
    Servers = Server.GetOPCServers("")
    
    Dim lastIndex As Integer
    lastIndex = 0
    For I = LBound(Servers) To UBound(Servers)
        cbServerList.AddItem Servers(I)
        If Servers(I) = lastServer Then lastIndex = I - 1
    Next I
    cbServerList.ListIndex = lastIndex
    MousePointer = vbDefault
    Exit Sub

    
Problems:
    MousePointer = vbDefault
    If Err.Number <> 0 Then
        MsgBox Server.GetErrorString(Err.Number)
    End If
End Sub

Private Sub btnConnect_Click()
    Dim sServerName As String
    On Error GoTo Problems
    
    UseEvents = False
    
    If Server Is Nothing Then
        Set Server = New OPCServer
    End If
    If Group Is Nothing Then GoTo noGroup
    Group.IsSubscribed = False
    Set Group = Nothing
    Set callbackGroup = Nothing

noGroup:
    MousePointer = vbHourglass
    sServerName = cbServerList.Text
    Server.Connect sServerName, ""
    lastServer = cbServerList.Text
   
    ' test groups collection
    Server.OPCGroups.DefaultGroupUpdateRate = 800
    Set Group = Server.OPCGroups.Add("I7000")
    ' Either use subscription events or polled reads
    If UseEvents = True Then Group.IsSubscribed = True
    Set callbackGroup = Group

    Call FillItems

    MousePointer = vbDefault
    btnConnect.Enabled = False
    btnExit.Enabled = False
    btnDisconnect.Enabled = True
    btnRead.Enabled = True
    btnWrite.Enabled = True
    btnLoopRead.Enabled = True
    Exit Sub

Problems:
    MousePointer = vbDefault
    ' MsgBox Server.GetErrorString(Err.number)
End Sub

Private Sub btnDisconnect_Click()
    Call DisconnectServer
    btnDisconnect.Enabled = False
    btnConnect.Enabled = True
    btnExit.Enabled = True
    btnRead.Enabled = False
    btnWrite.Enabled = False
    btnLoopRead.Enabled = False
    tvTagList.Nodes.Clear
End Sub

Private Sub btnExit_Click()
    Unload Me
    End
End Sub

Private Sub btnLoopRead_Click()
    On Error GoTo Problems
    
    ' Check if Server and Group are valid
    If Server Is Nothing Then Exit Sub
    If Group Is Nothing Then Exit Sub
    'Results.Text = "Item Read Failed"
    
    btnRead.Enabled = False
    btnWrite.Enabled = False
    btnDisconnect.Enabled = False
    btnLoopRead.Enabled = False
    btnStopLoop.Enabled = True
    
    ' Local variables
    Dim serverHandles(1) As Long
    Dim Errors() As Long
    
    ' Get the OPCItem
    Dim anItem As OPCItem
    Group.OPCItems.AddItem lTagSelected.Caption, 1
    Set anItem = Group.OPCItems.Item(1)
    
    Dim StartTime As Long, EndTime As Long
    Dim TotalTime As Long, TotalCount As Long
    TotalCount = 0
    bStopProcess = False
    ' Read the OPCItem and set the value into the text box
    StartTime = GetTickCount
    While (Not bStopProcess)
        anItem.Read OPCCache
        'anItem.Read OPCDevice
        eTagValue.Text = anItem.Value
        TotalCount = TotalCount + 1
        lCounter.Caption = str(TotalCount)
        DoEvents
    Wend
    EndTime = GetTickCount
    
    serverHandles(1) = anItem.ServerHandle
    Group.OPCItems.Remove 1, serverHandles, Errors
    Set anItem = Nothing
    
    MsgBox "Performance = " _
           + str(TotalCount * 1000 \ (EndTime - StartTime)) _
           + " Reads/Sec."
    
    'Results.Text = "Item Read Was Successful"
    btnRead.Enabled = True
    btnWrite.Enabled = True
    btnDisconnect.Enabled = True
    btnLoopRead.Enabled = True
    btnStopLoop.Enabled = False
   
    Exit Sub

Problems:
    btnRead.Enabled = True
    btnWrite.Enabled = True
    btnDisconnect.Enabled = True
    btnLoopRead.Enabled = True
    btnStopLoop.Enabled = False
    bStopProcess = True
End Sub

Private Sub btnRead_Click()
    On Error GoTo Problems
    
    ' Check if Server and Group are valid
    If Server Is Nothing Then Exit Sub
    If Group Is Nothing Then Exit Sub
    
    MousePointer = vbHourglass
    
    ' Local variables
    Dim serverHandles(1) As Long
    Dim Errors() As Long
    
    ' Get the OPCItem
    Dim anItem As OPCItem
    Group.OPCItems.AddItem lTagSelected.Caption, 1
    Group.UpdateRate = 100
    Sleep 200   ' = Group update rate + 100, while read data by cache
    Set anItem = Group.OPCItems.Item(1)
    anItem.RequestedDataType = VT_R4    ' Set request data type as float
    
    ' Read the OPCItem and set the value into the text box
    anItem.Read OPCCache
    ' anItem.Read OPCDevice
    eTagValue.Text = anItem.Value
    DoEvents
    
    serverHandles(1) = anItem.ServerHandle
    Group.OPCItems.Remove 1, serverHandles, Errors
    Set anItem = Nothing
    
    MousePointer = vbDefault
    Exit Sub

Problems:
    MousePointer = vbDefault
End Sub

Private Sub btnStopLoop_Click()
    bStopProcess = True
    btnStopLoop.Enabled = False
    btnLoopRead.Enabled = True
End Sub

Private Sub btnWrite_Click()
    On Error GoTo Problems
    
    If Server Is Nothing Then Exit Sub
    If Group Is Nothing Then Exit Sub

    MousePointer = vbHourglass
    
    ' Local variables
    Dim serverHandles(1) As Long
    Dim Errors() As Long
    
    ' Get the OPCItem
    Dim anItem As OPCItem
    Group.OPCItems.AddItem lTagSelected.Caption, 1
    Set anItem = Group.OPCItems.Item(1)
    
    ' Write the value from the text box to the item
    anItem.Write (eTagValue.Text)
    serverHandles(1) = anItem.ServerHandle
    Group.OPCItems.Remove 1, serverHandles, Errors
    Set anItem = Nothing
    
    MousePointer = vbDefault
    Exit Sub

Problems:
    MousePointer = vbDefault
End Sub

Private Sub Form_Load()
    lastAccessPath = GetSetting("NAPOPC", "VBClient", "AccessPath", "")
    lastItemID = GetSetting("NAPOPC", "VBClient", "ItemID", "")
    lastServer = GetSetting("NAPOPC", "VBClient", "Server", "")
    
    Call FillServers
End Sub

Private Sub DisconnectServer()
    If Server Is Nothing Then Exit Sub
    
    If Group Is Nothing Then GoTo noGroup
    Group.IsSubscribed = False
    Set Group = Nothing

    If callbackGroup Is Nothing Then GoTo noGroup
    Set callbackGroup = Nothing

noGroup:
    Server.OPCGroups.RemoveAll
    Server.Disconnect
    Set Server = Nothing

    SaveSetting "NAPOPC", "VBClient", "AccessPath", lastAccessPath
    SaveSetting "NAPOPC", "VBClient", "ItemID", lastItemID
    SaveSetting "NAPOPC", "VBClient", "Server", lastServer
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DisconnectServer
End Sub

Private Sub FillItems()
    On Error GoTo Problems
        
    Dim Count As Integer
    Dim Count1 As Integer
    Dim Count2 As Integer
    Dim node1 As node
    Dim str As String
    Dim Org As Integer
    
    'Create tree of tags
    If Server Is Nothing Then Exit Sub
    Set browser = Server.CreateBrowser
    
    Org = browser.Organization
    
    'Organization is Heirarchical
    If Org = 1 Then
        browser.MoveToRoot
        browser.ShowBranches
        Count = browser.Count
        
        ' If count is > 0 then branches exist
        If Count > 0 Then
            'For each branch check for sub branches and populate
            For X = 1 To Count
                    
                'Add the branch
                Set node1 = tvTagList.Nodes.Add
                str = browser.Item(X)
                node1.Text = str
                    
                ' Check for sub branches
                browser.MoveDown (str)
                browser.ShowBranches
                Count1 = browser.Count
                
                'If Count1 > 0 then sub branches exist
                If Count1 > 0 Then Branch Count1, node1
                
                'Check for leafs in this branch
                browser.ShowLeafs
                Count2 = browser.Count
                        
                For Y = 1 To Count2
                    Set node2 = tvTagList.Nodes.Add(node1, tvwChild)
                    str = browser.Item(Y)
                    node2.Text = str
                Next Y
                        
                browser.MoveUp
                browser.ShowBranches
            Next X
        End If
    End If
    
    'Organization is flat
    If Org = 2 Then
        browser.ShowLeafs
        Count = browser.Count
        
        'Just add leafs
        For Z = 1 To Count
            Set node1 = tvTagList.Nodes.Add
            str = browser.Item(Z)
            node1.Text = str
        Next Z
    End If
    
Problems:

End Sub

Public Sub Branch(Count As Integer, node1 As node)
' This function is used to populate the sub branches in the browser tree
    
    Dim node2 As node
    Dim node3 As node
    Dim str As String
    Dim Count1 As Integer
    Dim Count2 As Integer
    
    For X = 1 To Count
        
        Set node2 = tvTagList.Nodes.Add(node1, tvwChild)
        str = browser.Item(X)
        node2.Text = str
    
        ' Check for additional sub branches
        browser.MoveDown (str)
        browser.ShowBranches
        Count1 = browser.Count
        
        'If Count1 > 0 then more sub branches exist, function calls itself
        If Count1 > 0 Then Branch Count1, node2
        
        'Check for leafs in this branch
        browser.ShowLeafs
        Count2 = browser.Count
            
        For Y = 1 To Count2
            Set node3 = tvTagList.Nodes.Add(node2, tvwChild)
            str = browser.Item(Y)
            node3.Text = str
        Next Y
        
        browser.MoveUp
        browser.ShowBranches
    Next X

End Sub

Private Sub tvTagList_NodeClick(ByVal node As ComctlLib.node)
    'Place Full Branch path into ItemID Box
    lTagSelected.Caption = node.FullPath
End Sub