Imports FieldTalk.Modbus.Master

Public Class Form1

    Private myProtocol As MbusMasterFunctions


    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ToolTip1.SetToolTip(txtPollDelay, "Delay in milliseconds between two consecutive Modbus operations, 0 to disable")
        ToolTip1.SetToolTip(cmbRetry, "How many times do we retry operation if it fails first time?")
        ToolTip1.SetToolTip(cmbSerialProtocol, "Serial protocol choice: ASCII or RTU")
        ToolTip1.SetToolTip(cmbTcpProtocol, "Ethernet protocol choice: MODBUS/TCP or Encapsulated RTU over TCP")
        cmbComPort.SelectedIndex = 0
        cmbParity.SelectedIndex = 0
        cmbStopBits.SelectedIndex = 0
        cmbDataBits.SelectedIndex = 0
        cmbBaudRate.SelectedIndex = 0
        cmbSerialProtocol.SelectedIndex = 0
        cmbTcpProtocol.SelectedIndex = 0
        cmbRetry.SelectedIndex = 0
        cmbCommand.SelectedIndex = 0
    End Sub


    Private Sub cmdOpenSerial_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdOpenSerial.Click
        ' Make sure we close rather than leaving closing to the garbage collector
        If Not myProtocol Is Nothing Then
            myProtocol.closeProtocol()
        End If
        '
        ' Create and open protocol
        '
        Try
            If cmbSerialProtocol.SelectedIndex = 0 Then 'RTU
                myProtocol = New MbusRtuMasterProtocol
            Else 'ASCII
                myProtocol = New MbusAsciiMasterProtocol
            End If
        Catch ex As OutOfMemoryException
            lblResult.Text = "Could not instantiate serial protocol class! Error was " & ex.Message
            Exit Sub
        End Try
        '
        ' Here we configure the protocol
        '
        Dim retryCnt, pollDelay, timeOut, baudRate, parity, dataBits, stopBits, res As Int32
        Try
            retryCnt = Int32.Parse(cmbRetry.Text)
        Catch ex As Exception
            retryCnt = 0
        End Try
        Try
            pollDelay = Int32.Parse(txtPollDelay.Text)
        Catch ex As Exception
            pollDelay = 0
        End Try
        Try
            timeOut = Int32.Parse(txtTimeout.Text)
        Catch ex As Exception
            timeOut = 1000
        End Try
        Try
            baudRate = Int32.Parse(cmbBaudRate.Text)
        Catch ex As Exception
            baudRate = 19200
        End Try
        Select Case cmbParity.SelectedIndex
            Case 0
                parity = MbusSerialClientBase.SER_PARITY_NONE
            Case 1
                parity = MbusSerialClientBase.SER_PARITY_EVEN
            Case 2
                parity = MbusSerialClientBase.SER_PARITY_ODD
        End Select
        Select Case cmbDataBits.SelectedIndex
            Case 0
                dataBits = MbusSerialClientBase.SER_DATABITS_8
            Case 1
                dataBits = MbusSerialClientBase.SER_DATABITS_7
        End Select
        Select Case cmbStopBits.SelectedIndex
            Case 0
                stopBits = MbusSerialClientBase.SER_STOPBITS_1
            Case 1
                stopBits = MbusSerialClientBase.SER_STOPBITS_2
        End Select
        myProtocol.timeout = timeOut
        myProtocol.retryCnt = retryCnt
        myProtocol.pollDelay = pollDelay
        ' Note: The following CType() cast is required as the myProtocol object is declared
        ' as the superclass of MbusSerialClientBase. That way myProtocol can
        ' represent different protocol types.
        res = CType(myProtocol, MbusSerialClientBase).openProtocol(cmbComPort.Text, baudRate, dataBits, stopBits, parity)
        If res = BusProtocolErrors.FTALK_SUCCESS Then
            lblResult.Text = "Serial port opened successfully with parameters: " & cmbComPort.Text & ", " & baudRate & " baud, " & dataBits & " data bits, " & stopBits & " stop bits, parity " & parity
        Else
            lblResult.Text = "Could not open protocol, error was: " & BusProtocolErrors.getBusProtocolErrorText(res)
        End If
    End Sub


    Private Sub cmdOpenTCP_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdOpenTCP.Click
        ' Make sure we close rather than leaving closing to the garbage collector
        If Not myProtocol Is Nothing Then
            myProtocol.closeProtocol()
        End If
        '
        ' Create and open protocol
        '
        Try
            If cmbTcpProtocol.SelectedIndex = 0 Then
                myProtocol = New MbusTcpMasterProtocol
            Else
                myProtocol = New MbusRtuOverTcpMasterProtocol
            End If
        Catch ex As OutOfMemoryException
            lblResult.Text = "Could not instantiate ethernet protocol class! Error was " & ex.Message
            Exit Sub
        End Try
        '
        ' Here we configure the protocol
        '
        Dim retryCnt, pollDelay, timeOut, tcpPort, res As Int32
        Try
            retryCnt = Int32.Parse(cmbRetry.Text)
        Catch ex As Exception
            retryCnt = 0
        End Try
        Try
            pollDelay = Int32.Parse(txtPollDelay.Text)
        Catch ex As Exception
            pollDelay = 0
        End Try
        Try
            timeOut = Int32.Parse(txtTimeout.Text)
        Catch ex As Exception
            timeOut = 1000
        End Try
        Try
            tcpPort = Int32.Parse(txtTCPPort.Text)
        Catch ex As Exception
            tcpPort = 502
        End Try
        myProtocol.timeout = timeOut
        myProtocol.retryCnt = retryCnt
        myProtocol.pollDelay = pollDelay
        ' Note: The following CType() cast is required as the myProtocol object is declared
        ' as the superclass of MbusTcpMasterProtocol. That way myProtocol can
        ' represent different protocol types.
        CType(myProtocol, MbusIpClientBase).port = CShort(tcpPort)
        res = CType(myProtocol, MbusIpClientBase).openProtocol(txtHostName.Text)
        If res = BusProtocolErrors.FTALK_SUCCESS Then
            lblResult.Text = "Modbus/TCP port opened successfully with parameters: " & txtHostName.Text & ", TCP port " & tcpPort
        Else
            lblResult.Text = "Could not open protocol, error was: " & BusProtocolErrors.getBusProtocolErrorText(res)
        End If
    End Sub


    Private Sub cmdExecute_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdExecute.Click
        Dim writeVals(125), readVals(125) As Int16
        Dim slave, startWrReg, numWrRegs, startRdReg, numRdRegs, i, res, startCoil, numCoils As Int32
        Dim coilVals(2000) As Boolean
        Try
            Try
                slave = Int32.Parse(txtSlave.Text)
            Catch ex As Exception
                slave = 1
            End Try
            Try
                startCoil = Int32.Parse(txtStartCoil.Text)
            Catch ex As Exception
                startCoil = 1
            End Try
            Try
                numCoils = Int32.Parse(txtNumCoils.Text)
            Catch ex As Exception
                numCoils = 1
            End Try
            Try
                startRdReg = Int32.Parse(txtStartRdReg.Text)
            Catch ex As Exception
                startRdReg = 1
            End Try
            Try
                startWrReg = Int32.Parse(txtStartWrReg.Text)
            Catch ex As Exception
                startWrReg = 1
            End Try
            Try
                numWrRegs = Int32.Parse(txtNumWrRegs.Text)
            Catch ex As Exception
                numWrRegs = 1
            End Try
            Try
                numRdRegs = Int32.Parse(txtNumRdRegs.Text)
            Catch ex As Exception
                numRdRegs = 1
            End Try
            Try
                writeVals(0) = Int16.Parse(txtWriteVal1.Text)
                writeVals(1) = Int16.Parse(txtWriteVal2.Text)
                writeVals(2) = Int16.Parse(txtWriteVal3.Text)
                writeVals(3) = Int16.Parse(txtWriteVal4.Text)
                writeVals(4) = Int16.Parse(txtWriteVal5.Text)
                writeVals(5) = Int16.Parse(txtWriteVal6.Text)
                writeVals(6) = Int16.Parse(txtWriteVal7.Text)
                writeVals(7) = Int16.Parse(txtWriteVal8.Text)
                coilVals(0) = (writeVals(0) <> 0)
                coilVals(1) = (writeVals(1) <> 0)
                coilVals(2) = (writeVals(2) <> 0)
                coilVals(3) = (writeVals(3) <> 0)
                coilVals(4) = (writeVals(4) <> 0)
                coilVals(5) = (writeVals(5) <> 0)
                coilVals(6) = (writeVals(6) <> 0)
                coilVals(7) = (writeVals(7) <> 0)
            Catch ex As Exception
            End Try
            Select Case cmbCommand.SelectedIndex
                '
                'Read Holding Registers
                '
                Case 0
                    res = myProtocol.readMultipleRegisters(slave, startRdReg, readVals, numRdRegs)
                    lblResult2.Text = "Result: " & BusProtocolErrors.getBusProtocolErrorText(res) & vbCrLf
                    If res = BusProtocolErrors.FTALK_SUCCESS Then
                        lblReadValues.Text = ""
                        For i = 0 To numRdRegs - 1
                            lblReadValues.Text = lblReadValues.Text & readVals(i) & "  "
                        Next
                    End If
                    '
                    'Read Input Registers
                    '
                Case 1
                    res = myProtocol.readInputRegisters(slave, startRdReg, readVals, numRdRegs)
                    lblResult2.Text = "Result: " & BusProtocolErrors.getBusProtocolErrorText(res) & vbCrLf
                    If res = BusProtocolErrors.FTALK_SUCCESS Then
                        lblReadValues.Text = ""
                        For i = 0 To numRdRegs - 1
                            lblReadValues.Text = lblReadValues.Text & readVals(i) & "  "
                        Next
                    End If
                    '
                    'Read Coils
                    '
                Case 2
                    res = myProtocol.readCoils(slave, startCoil, coilVals, numCoils)
                    lblResult2.Text = "Result: " & BusProtocolErrors.getBusProtocolErrorText(res) & vbCrLf
                    If res = BusProtocolErrors.FTALK_SUCCESS Then
                        lblReadValues.Text = ""
                        For i = 0 To numCoils - 1
                            If coilVals(i) Then
                                lblReadValues.Text = lblReadValues.Text & "1  "
                            Else
                                lblReadValues.Text = lblReadValues.Text & "0  "
                            End If

                        Next
                    End If
                    '
                    'Write Coils
                    '
                Case 3
                    res = myProtocol.forceMultipleCoils(slave, startCoil, coilVals, numCoils)
                    lblResult2.Text = "Result: " & BusProtocolErrors.getBusProtocolErrorText(res) & vbCrLf
                    '
                    'Write Holding Registers
                    '
                Case 4
                    res = myProtocol.writeMultipleRegisters(slave, startWrReg, writeVals, numWrRegs)
                    lblResult2.Text = "Result: " & BusProtocolErrors.getBusProtocolErrorText(res) & vbCrLf
                    '
                    'Write Single Register
                    '
                Case 5
                    res = myProtocol.writeSingleRegister(slave, startWrReg, writeVals(0))
                    lblResult2.Text = "Result: " & BusProtocolErrors.getBusProtocolErrorText(res) & vbCrLf
                    '
                    'Read/Write Registers
                    '
                Case 6
                    res = myProtocol.readWriteRegisters(slave, startRdReg, readVals, numRdRegs, startWrReg, writeVals, numWrRegs)
                    lblResult2.Text = "Result: " & BusProtocolErrors.getBusProtocolErrorText(res) & vbCrLf
            End Select
        Catch ex As Exception
            lblResult2.Text = "Exception occured: " & ex.Message
        End Try
    End Sub

End Class
