form1.frm

opc client, visual basic opc clien for modbus

      Height          =   375
      Index           =   0
      Left            =   1560
      TabIndex        =   3
      Text            =   "Value"
      Top             =   2400
      Width           =   735
   End
   Begin VB.CommandButton READ_Button 
      Caption         =   "Read"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3960
      TabIndex        =   2
      Top             =   960
      Width           =   1455
   End
   Begin VB.TextBox ItemName 
      Height          =   375
      Index           =   0
      Left            =   240
      TabIndex        =   1
      Top             =   2400
      Width           =   1095
   End
   Begin VB.CommandButton CONNECT 
      Caption         =   "Connect"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2160
      TabIndex        =   0
      Top             =   360
      Width           =   1455
   End
   Begin VB.Label Label6 
      Caption         =   "Update Rate"
      Height          =   255
      Left            =   120
      TabIndex        =   41
      Top             =   1200
      Width           =   975
   End
   Begin VB.Label Label5 
      Caption         =   "OPCServer Name"
      Height          =   255
      Left            =   240
      TabIndex        =   40
      Top             =   120
      Width           =   1575
   End
   Begin VB.Label Label4 
      Caption         =   "Quality"
      Height          =   255
      Left            =   4560
      TabIndex        =   38
      Top             =   2160
      Width           =   735
   End
   Begin VB.Label Label3 
      Caption         =   "Date/Time"
      Height          =   255
      Left            =   3000
      TabIndex        =   37
      Top             =   2160
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "Value"
      Height          =   255
      Left            =   1560
      TabIndex        =   36
      Top             =   2160
      Width           =   615
   End
   Begin VB.Label Label1 
      Caption         =   "Item Name"
      Height          =   255
      Left            =   240
      TabIndex        =   35
      Top             =   2160
      Width           =   975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'==============================================================================
' OPC Client Sample for VB6.0 - Ver1.01
'
' TITLE: Form1.frm
'
' CONTENTS:
'
'
' (c) Copyright 2004 Takebishi Electric Sales Corporation
' ALL RIGHTS RESERVED.
'
' DISCLAIMER:
'  This code is provided by the Takebishi Electric Sales Corporation solely
'  to assist in understanding and use of the appropriate OPC Specification(s).
'  This code is provided as-is and without warranty or support of any sort.
'==============================================================================

Option Explicit

Option Base 1

Private Const ItemMax = 8                           'Maximum of registered Items
Private Const HEAD_TKBSVR As String = "Takebishi"   'Header of TAKEBISHI OPC Server
Dim WithEvents OPCMyserver As OPCServer             'Server object
Attribute OPCMyserver.VB_VarHelpID = -1
Dim WithEvents OPCMygroups As OPCGroups             'Group collection
Attribute OPCMygroups.VB_VarHelpID = -1
Dim WithEvents OPCMygroup As OPCGroup               'Group object
Attribute OPCMygroup.VB_VarHelpID = -1
Dim OPCMyitems As OPCItems                          'Item collection
Dim OPCMyitem As OPCItem                            'Item object


Dim bConnect As Boolean



Private Sub CONNECT_Click()
    
    Dim ItemServerHandles() As Long
    Dim ClientHandles(1) As Long
    Dim OPCItemIDs(1) As String
    Dim Errors() As Long
    Dim i As Integer
    
    If bConnect = False Then
        On Error GoTo ConnectError
    
        Set OPCMyserver = New OPCServer
        OPCMyserver.CONNECT Form1.ServerName.List(ServerName.ListIndex), ""
  
        Set OPCMygroups = OPCMyserver.OPCGroups
        Set OPCMygroup = OPCMygroups.Add("Group1")
        OPCMygroup.UpdateRate = Val(UpdateRateSet.Text)
        Set OPCMyitems = OPCMygroup.OPCItems
    
        For i = 1 To ItemMax
            ClientHandles(1) = i
            OPCItemIDs(1) = Form1.ItemName(i - 1).Text
            OPCMyitems.AddItems 1, OPCItemIDs, ClientHandles, ItemServerHandles, Errors  ''', RequestedDataTypes, AccessPaths
            If Errors(1) <> 0 Then
                Form1.Value(i - 1) = "Error"
          End If
        Next i
      
        bConnect = True
        CONNECT.Caption = "DisConnect"
        READ_Button.Enabled = True
        WRITE_Button.Enabled = True
        ADVISE_Button.Enabled = True
        ADVISE_Button.Caption = "Auto Read On"
        OPCMygroup.IsActive = False

        For i = ItemName.LBound To ItemName.UBound
            ItemName(i).Enabled = False
        Next i
    Else
        On Error Resume Next

        OPCMygroup.IsActive = False
        OPCMygroups.Remove OPCMygroup.ServerHandle

        Set OPCMyitems = Nothing  'Delete Item collection
        Set OPCMyitem = Nothing   'Delete Item object
        Set OPCMygroups = Nothing 'Delete Group collection
        Set OPCMygroup = Nothing  'Delete Group object

        OPCMyserver.Disconnect    'Disconnect with OPC Server
        Set OPCMyserver = Nothing 'Delete Server object
    
        bConnect = False
        READ_Button.Enabled = False
        WRITE_Button.Enabled = False
        ADVISE_Button.Enabled = False
        CONNECT.Caption = "Connect"
        For i = ItemName.LBound To ItemName.UBound
            ItemName(i).Enabled = True
        Next i

        Exit Sub
    End If
    Exit Sub

ConnectError:
    MsgBox "Error Connecting"
    For i = 0 To ItemMax - 1
        Form1.Value(i) = "Error"
    Next i

End Sub

Private Sub Form_Load()
    Dim Getserver As OPCServer
    Dim Servers As Variant
    Dim i As Integer
    Dim ItemName As String
    Dim Fno As Integer
    On Error GoTo LoadEnd
    ServerName.Clear
    Set Getserver = New OPCServer
    Servers = Getserver.GetOPCServers
    For i = LBound(Servers) To UBound(Servers)
        If InStr(1, Servers(i), HEAD_TKBSVR, vbTextCompare) > 0 Then
            ServerName.AddItem Servers(i)
        End If
    Next i
    Set Getserver = Nothing
    ServerName.ListIndex = 0
    
    Fno = FreeFile(1)
    Open "OPCSample.INI" For Input As #Fno
    i = 1
    Do While Not EOF(1)         'Repeat to the terminal of the file.
       Input #Fno, ItemName
       Form1.ItemName(i - 1).Text = ItemName
       If i > ItemMax Then
         Exit Do
       End If
       i = i + 1
    Loop

    Close #Fno
    Exit Sub
LoadEnd:
    If Fno > 0 Then
        Close #Fno
    End If
    For i = 0 To ItemMax - 1
        Form1.ItemName(i).Text = "Device1.D" + Format$(i)
    Next i
   
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer
    Dim Fno As Integer
    If bConnect = True Then
        CONNECT_Click
    End If
    Fno = FreeFile(1)
    Open "OPCSample.INI" For Output As #Fno
    For i = 1 To ItemMax
        Print #Fno, Form1.ItemName(i - 1).Text
    Next i
    Close #Fno

End Sub

Private Sub READ_Button_Click()
    On Error Resume Next
    Dim anItem As OPCItem
    For Each anItem In OPCMygroup.OPCItems
        anItem.Read OPCDevice ', value, qual, time    ' If subscribed, don't do this!
        Form1.Value(anItem.ClientHandle - 1) = anItem.Value
        Form1.Time(anItem.ClientHandle - 1) = anItem.TimeStamp
        Form1.Quality(anItem.ClientHandle - 1) = anItem.Quality
    Next anItem
    Set anItem = Nothing

End Sub


Private Sub WRITE_Button_Click()

    On Error Resume Next
    Dim anItem As OPCItem
    For Each anItem In OPCMygroup.OPCItems
        anItem.Write Val(Form1.Value(anItem.ClientHandle - 1))  'Ver1.01
    Next anItem
    Set anItem = Nothing

End Sub
Private Sub ADVISE_button_Click()
    OPCMygroup.IsActive = Not OPCMygroup.IsActive
    OPCMygroup.IsSubscribed = OPCMygroup.IsActive
    If OPCMygroup.IsActive = False Then
        ADVISE_Button.Caption = "Auto Read On"
    Else
        ADVISE_Button.Caption = "Auto Read Off"
        READ_Button_Click
    End If
End Sub

Private Sub OPCMygroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
    
    Dim id As Integer
    Dim i As Integer
    For i = 1 To NumItems
        id = ClientHandles(i) - 1
        Form1.Value(id) = ItemValues(i)
        Form1.Time(id) = TimeStamps(i)
        Form1.Quality(id) = Qualities(i)
    Next i

End Sub
Private Sub OPCMyserver_ServerShutDown(ByVal Reason As String)
    MsgBox "Server Shutdown"
    
End Sub