Option Base 1
Option Explicit

Private Const ItemMax = 8                           'Maximum of registered Items

Dim WithEvents OPCMyserver As OPCServer             'Server object
Dim WithEvents OPCMygroups As OPCGroups             'Group collection
Dim WithEvents OPCMygroup As OPCGroup               'Group object

Dim OPCMyitems As OPCItems                          'Item collection
Dim OPCMyitem As OPCItem                            'Item object

Dim bConnect As Boolean

Private Sub CmdItem_Click()
    On Error GoTo LoadEnd
    Dim ItemName As String
    Dim i, Fno As Integer
    '
    Fno = 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
       FrmOPC.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
        FrmOPC.ItemName(i).Text = "Device1.D" + Format$(i)
    Next i

End Sub

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 FrmOPC.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) = FrmOPC.ItemName(i - 1).Text
            OPCMyitems.AddItems 1, OPCItemIDs, ClientHandles, ItemServerHandles, Errors  ''', RequestedDataTypes, AccessPaths
            If Errors(1) <> 0 Then
                FrmOPC.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
        FrmOPC.Value(i) = "Error"
    Next i

End Sub

Private Sub Form_Load()
    Dim Getserver As OPCServer
    Dim Servers As Variant
    Dim i As Integer
    '
    ServerName.Clear
    Set Getserver = New OPCServer
    Servers = Getserver.GetOPCServers
    '
    For i = LBound(Servers) To UBound(Servers)
        ServerName.AddItem Servers(i)
    Next i
    '
    Set Getserver = Nothing
    ServerName.ListIndex = 0
   
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 = 1
    Open "OPCSample.INI" For Output As #Fno
    For i = 1 To ItemMax
        Print #Fno, FrmOPC.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
        FrmOPC.Value(anItem.ClientHandle - 1) = anItem.Value
        FrmOPC.Time(anItem.ClientHandle - 1) = anItem.TimeStamp
        FrmOPC.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 FrmOPC.Value(anItem.ClientHandle - 1)
    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
        FrmOPC.Value(id) = ItemValues(i)
        FrmOPC.Time(id) = TimeStamps(i)
        FrmOPC.Quality(id) = Qualities(i)
    Next i

End Sub

Private Sub OPCMyserver_ServerShutDown(ByVal Reason As String)

    MsgBox "Server Shutdown"
    
End Sub