Imports System Imports System.Collections.Generic Imports System.Text Imports System.IO.Ports Namespace Modbus_S Public Class Modbus Inherits SerialPort Public Event MessageRecived(ByVal b() As Byte) Dim _modbusStatus As String Public Property modbusStatus As String Get Return _modbusStatus End Get Set(ByVal value As String) _modbusStatus = value End Set End Property Public Function Connect(ByVal portName As String, ByVal baudRate As Integer, ByVal databits As Integer, ByVal prty As Integer, ByVal stpBts As StopBits) As Boolean 'Ensure port isn't already opened: If (Not Me.IsOpen) Then 'Assign desired settings to the serial port: Me.PortName = portName Me.BaudRate = baudRate Me.DataBits = databits Me.Parity = prty Me.StopBits = stpBts 'These timeouts are default and cannot be editted through the class at this point: Me.ReadTimeout = 1000 Me.WriteTimeout = 1000 Try Me.Open() Catch err As Exception modbusStatus = "Error opening " + portName + ": " + err.Message Return False End Try modbusStatus = portName + " opened successfully" Return True Else modbusStatus = portName + " already opened" Return False End If End Function Public Overloads Function Close() As Boolean 'Ensure port is opened before attempting to close: If (IsOpen) Then Try MyBase.Close() Catch err As Exception modbusStatus = "Error closing " + Me.PortName + ": " + err.Message Return False End Try modbusStatus = Me.PortName + " closed successfully" Return True Else modbusStatus = Me.PortName + " is not open" Return False End If End Function Private Function GetCRC(ByVal message() As Byte) As Integer 'Function expects a modbus message of any length as well as a 2 byte CRC array in which to 'return the CRC values: ' I copy the function from the Arduino Sketch. Function Encode =Function Decode Dim CRCFull As UInt16 = &HFFFF Dim CRCHigh As Byte = &HFF Dim CRCLow As Byte = &HFF Dim CRCLSB As Byte Dim i, j As Integer For i = 0 To UBound(message) - 2 CRCFull = CRCFull Xor message(i) For j = 0 To 7 CRCLSB = CRCFull And &H1 CRCFull = CRCFull >> 1 If (CRCLSB = 1) Then CRCFull = CRCFull Xor &HA001 Next Next CRCHigh = CRCFull >> 8 CRCFull = CRCFull << 8 Or CRCHigh CRCFull = CRCFull And &HFFFF Return (CRCFull) End Function Private Sub BuildMessage(ByVal address As Byte, ByVal type As Byte, ByVal start As UInt16, ByVal registers As UInt16, ByRef message() As Byte) 'Array to receive CRC bytes: Dim crc As Integer message(0) = Byte.Parse(address) message(1) = Byte.Parse(type) message(2) = Byte.Parse(start \ 256) message(3) = Byte.Parse(start Mod 256) message(4) = Byte.Parse(registers \ 256) message(5) = Byte.Parse(registers Mod 256) crc = GetCRC(message) message(message.Length - 2) = crc >> 8 message(message.Length - 1) = crc And &HFF End Sub Private Function CheckResponse(ByVal response() As Byte) As Boolean 'Perform a basic CRC check: Dim CRC As Integer CRC = GetCRC(response) If (CRC >> 8 = response(response.Length - 2) And (CRC And &HFF) = response(response.Length - 1)) Then Return True Else Return False End If End Function Public Function SendFc1(ByVal address As Byte, ByVal start As UInt16, ByVal registers As UInt16) As Boolean 'Function 1 'Ensure port is open: If (Me.IsOpen) Then 'Clear in/out buffers: Me.DiscardOutBuffer() Me.DiscardInBuffer() 'Function 1 request is always 8 bytes: Dim message(7) As Byte 'Function 1 response buffer: Dim nW As Integer = registers \ 8 If (registers Mod 8) > 0 Then nW = nW + 1 End If Dim response(5 + nW) As Byte 'Build outgoing modbus message: BuildMessage(address, 1, start, registers, message) 'Send modbus message to Serial Port: Try Me.Write(message, 0, message.Length) Catch err As Exception modbusStatus = "Error in read event: " + err.Message Return False End Try End If Return True End Function Public Function SendFc2(ByVal address As Byte, ByVal start As UInt16, ByVal registers As UInt16) As Boolean 'Function 2 'Ensure port is open: If (Me.IsOpen) Then 'Clear in/out buffers: Me.DiscardOutBuffer() Me.DiscardInBuffer() 'Function 2 request is always 8 bytes: Dim message(7) As Byte 'Function 2 response buffer: Dim nW As Integer = registers \ 8 If (registers Mod 8) > 0 Then nW = nW + 1 End If Dim response(5 + nW) As Byte 'Build outgoing modbus message: BuildMessage(address, 2, start, registers, message) 'Send modbus message to Serial Port: Try Me.Write(message, 0, message.Length) Catch err As Exception modbusStatus = "Error in read event: " + err.Message Return False End Try End If Return True End Function Public Function SendFc3(ByVal address As Byte, ByVal start As UInt16, ByVal registers As UInt16) As Boolean 'Function 3 'Ensure port is open: If (Me.IsOpen) Then 'Clear in/out buffers: Me.DiscardOutBuffer() Me.DiscardInBuffer() 'Function 3 request is always 8 bytes: Dim message(7) As Byte 'Function 3 response buffer: Dim response(5 + 2 * registers) As Byte 'Build outgoing modbus message: BuildMessage(address, 3, start, registers, message) 'Send modbus message to Serial Port: Try Me.Write(message, 0, message.Length) Catch err As Exception modbusStatus = "Error in read event: " + err.Message Return False End Try End If Return True End Function Public Function SendFc4(ByVal address As Byte, ByVal start As UInt16, ByVal registers As UInt16) As Boolean 'Function 4 'Ensure port is open: If (Me.IsOpen) Then 'Clear in/out buffers: Me.DiscardOutBuffer() Me.DiscardInBuffer() 'Function 4 request is always 8 bytes: Dim message(7) As Byte 'Function 4 response buffer: Dim response(5 + 2 * registers) As Byte 'Build outgoing modbus message: BuildMessage(address, 4, start, registers, message) 'Send modbus message to Serial Port: Try Me.Write(message, 0, message.Length) Catch err As Exception modbusStatus = "Error in read event: " + err.Message Return False End Try End If Return True End Function Public Function SendFc5(ByVal address As Byte, ByVal start As UInt16, ByVal registers As UInt16, ByVal values() As UInt16) As Boolean 'Function 5 'Ensure port is open: If (Me.IsOpen) Then 'Clear in/out buffers: Me.DiscardOutBuffer() Me.DiscardInBuffer() 'Message is 1 addr + 1 fcn + 2 start + 2 * reg vals + 2 CRC Dim message(5 + 2 * registers) As Byte 'Function 16 response is fixed at 8 bytes Dim response(7) As Byte message(0) = address message(1) = 5 message(2) = start >> 8 message(3) = start And &HFFFF Dim i As Integer For i = 0 To registers - 1 message(4 + 2 * i) = CByte(values(i) >> 8) message(5 + 2 * i) = CByte(values(i) And &HFF) Next 'Build outgoing message: 'BuildMessage(address, 5, start, registers, message) Dim crc As Integer crc = GetCRC(message) message(message.Length - 2) = crc >> 8 message(message.Length - 1) = crc And &HFF 'Send Modbus message to Serial Port: Try Me.Write(message, 0, message.Length) Return True Catch err As Exception modbusStatus = "Error in write event: " + err.Message Return False End Try 'Evaluate message: Else modbusStatus = "Serial port not open" Return False End If End Function Public Function SendFc16(ByVal address As Byte, ByVal start As UInt16, ByVal registers As UInt16, ByVal values() As UInt16) As Boolean 'Function 16 'Ensure port is open: If (Me.IsOpen) Then 'Clear in/out buffers: Me.DiscardOutBuffer() Me.DiscardInBuffer() 'Message is 1 addr + 1 fcn + 2 start + 2 reg + 1 count + 2 * reg vals + 2 CRC Dim message(8 + 2 * registers) As Byte 'Function 16 response is fixed at 8 bytes Dim response(7) As Byte 'Add bytecount to message: message(6) = CByte(registers * 2) 'Put write values into message prior to sending: Dim i As Integer For i = 0 To registers - 1 message(7 + 2 * i) = CByte(values(i) >> 8) message(8 + 2 * i) = CByte(values(i) And &HFF) Next 'Build outgoing message: BuildMessage(address, 16, start, registers, message) 'Send Modbus message to Serial Port: Try Me.Write(message, 0, message.Length) Return True Catch err As Exception modbusStatus = "Error in write event: " + err.Message Return False End Try 'Evaluate message: Else modbusStatus = "Serial port not open" Return False End If End Function Dim aIn(5) As Byte Dim BytesCount As Integer Private Sub Modbus_DataReceived(ByVal sender As Object, ByVal e As System.IO.Ports.SerialDataReceivedEventArgs) Handles Me.DataReceived 'IMPORTANT: this catch the incoming message, if you want read what is incoming, 'catch the message MessageReceive (b() as Byte) from this class, you will lease the whole buffer 'inclusive sclave and CRC On Error GoTo XT BytesCount = 5 'Sclave, function,count + crc 1 & 2 Dim i As Integer = 0 Dim tim As New TimeSpan Dim tmp As DateTime = Now() tim = tmp.Subtract(Now()) 'the speed of pc is higher than Arduino send, therefore I force him to stay here for 200 ms, in order to be sure that read whole 'msg Do While BytesCount > 0 And tim.TotalMilliseconds < 200 Do While sender.BytesToRead > 0 tmp = Now() aIn(i) = sender.ReadByte BytesCount = BytesCount - 1 'TODO: to improve, too much ReDim. If i = 1 AndAlso aIn(1) = 16 Then ReDim Preserve aIn(7) 'length of responde fc16 BytesCount = BytesCount + 3 ElseIf i = 2 AndAlso aIn(1) < 129 And aIn(1) <> 16 Then BytesCount = BytesCount + aIn(2) ReDim Preserve aIn(4 + aIn(2)) 'TODO: I would like to avoid this redim, but I would still utilize a simple array End If i = i + 1 If BytesCount = 0 Then i = 0 BytesCount = 5 Dim j As Integer If CheckResponse(aIn) Then RaiseEvent MessageRecived(aIn) ReDim aIn(5) 'TODO: I would like to avoid this redim, but I would still utilize a simple array End If Loop tim = Now().Subtract(tmp) Loop Exit Sub XT: 'MsgBox(Err.Description) End Sub End Class End Namespace