Gambas3 cliente MODBUS RTU - Fase en desarrollo

' Gambas class file

Public ADU[254] As Integer
Public Nregistros As Integer
Public Nbytes As Integer
Public BYTES[1024] As Integer

' Conectar al puerto serie

Public Sub Button2_Click()

  SerialPort1.PortName = TextBox1.Text
  SerialPort1.Speed = TextBox2.Text  
  SerialPort1.Open()  
  
  TextBox6.text = "Puerto : " & SerialPort1.PortName & " Configuracion : " &  
  SerialPort1.Speed & "," & SerialPort1.Parity & "," & SerialPort1.DataBits & "," & SerialPort1.StopBits
  
  Button1.Enabled = True
  Button4.Enabled = True
  Button2.Enabled = False

End

' Desconectar del puerto serie
Public Sub Button4_Click()

  SerialPort1.Close()
  TextArea1.text = TextArea1.text & SerialPort1.Status
  
  Button4.Enabled = False
  Button2.Enabled = True
End

' Salir de la aplicacion

Public Sub Button3_Click()
  SerialPort1.Close()
  Quit
End

Public Sub Button5_Click()
  TextArea3.Clear()
  TextArea1.Clear()
End

' Envio de la consulta modbus
Public Sub Button1_Click()
  Dim DireccionHI As Integer
  Dim DireccionLO As Integer
  Dim DatoHI As Integer
  Dim DatoLO As Integer
  Dim ID As Integer
  Dim Funcion As Integer  
  Dim CRCLO, CRCHI, i As Integer
  Dim CRC As String
   
  Nbytes = 0
  TextArea2.text = TextArea2.text & "\n"
   
  'ID
  ADU[0] = TextBox3.text
  
  'Funcion
  ADU[1] = ComboBox1.Index + 1
  
  'Direccion HI
  ADU[2] = 0
  
  'Direccion LO
  ADU[3] = SpinBox1.Text
  
  'Numero de registros/DATO HI
  If ((ComboBox1.Index + 1) = 5) Or ((ComboBox1.Index + 1) = 6) Then
    ADU[4] = TextBox5.Text
  Else
    ADU[4] = 0
  Endif
  
  'Numero de registros/DATO LO
  If ((ComboBox1.Index + 1) = 5) Or ((ComboBox1.Index + 1) = 6) Then
     ADU[5] = TextBox4.Text
  Else  
     ADU[5] = SpinBox2.Text
  Endif
  
  Nregistros = SpinBox2.Text
  
  CRC = Hex(CRC16(5))
  
  If Len(CRC) < 4 Then
    ADU[6] = HEX_DEC(Right$(CRC, 2))
    ADU[7] = HEX_DEC(Left$(CRC, 1))    
  Else
    ADU[6] = HEX_DEC(Right$(CRC, 2))
    ADU[7] = HEX_DEC(Left$(CRC, 2))    
  Endif
  
  For i = 0 To 1
    TextArea1.Text = TextArea1.text & i & ":" & ADU[i] & "  "    
  Next
  TextArea1.Text = TextArea1.text & "\n"
  
  For i = 2 To 7
    TextArea3.Text = TextArea3.text & i & ":" & ADU[i] & "  "    
  Next
  TextArea3.Text = TextArea3.text & "\n"
  
    
  For i = 0 To 7
    Write #SerialPort1, Chr$(ADU[i])
  Next
End


Function CRC16(n As Integer) As Integer
  Dim i, pos As Integer 
  Dim CRC As Integer
  CRC = 65535 
  
  For pos = 0 To n
    CRC = CRC Xor ADU[pos]    
    For i = 0 To 7
      If ((CRC And 1) <> 0) Then
        CRC = Lsr(CRC, 1)
        CRC = CRC Xor 40961
      Else
        CRC = Lsr(CRC, 1)  
      Endif    
    Next
  Next
  
 Return CRC
End

Function HEX_DEC(aux As String) As Integer
  Dim a, b, c, l As Integer
  Dim d As String
  c = 0

  l = Len(aux)
  For a = 1 To l
    d = Mid$(aux, a, 1)
    Select Case d
      Case "A"
        b = 10
      Case "B"
        b = 11
      Case "C"
        b = 12
      Case "D"
        b = 13
      Case "E"
        b = 14
      Case "F"
        b = 15
      Case Else
        b = CInt(d)
    End Select   
   
    c = c + (b * 16 ^ (l - a))    
   
  Next    
  Return c
End

'Recepcion de datos seriales 
Public Sub SerialPort1_Read()
  Dim DATO_BYTE As String
      
  Read #SerialPort1, DATO_BYTE, 1  
    
  TextArea2.text = TextArea2.text & Nbytes & ":" & Hex(Asc(DATO_BYTE)) & "  "   
  
  Nbytes = Nbytes + 1
   
 End


Public Sub Button6_Click()
  TextArea2.Clear()

End

Public Sub Form_Open()

  Nbytes = 0
  
End

Public Sub Button7_Click()

  TextArea2.text = TextArea2.text & "\n"

End