' 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