Modbus CRC RTU Table for Visual stdio 2017 VB－ㄚ嬤的心內話

Byte() transfer to Single

Dim mybyteArray() as byte

Dim StartIndex as integer

float myFloat = System.BitConverter.ToSingle(mybyteArray, startIndex);

Imports System.IO.Ports
Imports System.Threading

Public Class Form1
Public data1 As String '待校验的数组名称
Public Number1 As Long
Public data2 As String
Public Number2 As Long
Public StartAddr As String
Public NumberOfPoint As String
Public btSend(7) As Byte
'no 数组中元素个数
Dim btHiCRC As Byte, btLoCRC As Byte
'btLoCRC 算出的 CRC高字节
'btHiCRC 算出的 CRC低字节

Dim Choose11() As Byte = New Byte() {&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40,
&H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41,
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41,
&H0, &HC1, &H81, &H40}

Dim Choose22() As Byte = New Byte() {&H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7,
&H5, &HC5, &HC4, &H4, &HCC, &HC, &HD, &HCD, &HF, &HCF, &HCE, &HE,
&HA, &HCA, &HCB, &HB, &HC9, &H9, &H8, &HC8, &HD8, &H18, &H19, &HD9,
&H1B, &HDB, &HDA, &H1A, &H1E, &HDE, &HDF, &H1F, &HDD, &H1D, &H1C, &HDC,
&H14, &HD4, &HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3,
&H11, &HD1, &HD0, &H10, &HF0, &H30, &H31, &HF1, &H33, &HF3, &HF2, &H32,
&H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, &H3C, &HFC, &HFD, &H3D,
&HFF, &H3F, &H3E, &HFE, &HFA, &H3A, &H3B, &HFB, &H39, &HF9, &HF8, &H38,
&H28, &HE8, &HE9, &H29, &HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF,
&H2D, &HED, &HEC, &H2C, &HE4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26,
&H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, &HA0, &H60, &H61, &HA1,
&H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, &HA5, &H65, &H64, &HA4,
&H6C, &HAC, &HAD, &H6D, &HAF, &H6F, &H6E, &HAE, &HAA, &H6A, &H6B, &HAB,
&H69, &HA9, &HA8, &H68, &H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA,
&HBE, &H7E, &H7F, &HBF, &H7D, &HBD, &HBC, &H7C, &HB4, &H74, &H75, &HB5,
&H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, &H70, &HB0,
&H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, &H96, &H56, &H57, &H97,
&H55, &H95, &H94, &H54, &H9C, &H5C, &H5D, &H9D, &H5F, &H9F, &H9E, &H5E,
&H5A, &H9A, &H9B, &H5B, &H99, &H59, &H58, &H98, &H88, &H48, &H49, &H89,
&H4B, &H8B, &H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C,
&H44, &H84, &H85, &H45, &H87, &H47, &H46, &H86, &H82, &H42, &H43, &H83,
&H41, &H81, &H80, &H40}
Dim SerialPort1 As SerialPort = Nothing

Public Sub New()

' 設計工具需要此呼叫。
InitializeComponent()

' 在 InitializeComponent() 呼叫之後加入所有初始設定。

End Sub

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Try
SerialPort1 = New SerialPort("com4", 19200, Parity.Even, 8, StopBits.One)
SerialPort1.Open()
Catch ex As Exception
MessageBox.Show(Me, ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)

End Try

End Sub
Private Sub Form1_Close()
SerialPort1.Close()
End Sub
Public Function CalCRC16Fast(data() As Byte, no As Integer) As String
Dim CL As Byte
Dim CH As Byte '多项式码 &HAO01
Dim SaveHi As Byte
Dim SaveLo As Byte
Dim i As Integer
Dim Flag As Integer
Dim Rlt(2) As Byte
Dim RltS As String

btHiCRC = &HFF
btLoCRC = &HFF
CL = &H1
CH = &HA0
For i = 0 To (no - 1)
btHiCRC = btHiCRC Xor data(i) '每一个数据与 CRC寄存器
For Flag = 0 To 7
SaveHi = btLoCRC
SaveLo = btHiCRC
btLoCRC = btLoCRC \ 2 '高位右移一位
btHiCRC = btHiCRC \ 2 '低位右移一位
If ((SaveHi And &H1) = &H1) Then '如果高位字节最后一位为 1
btHiCRC = btHiCRC Or &H80 '则低位字节右移后前面补 1
End If '否则自动补 0
If ((SaveLo And &H1) = &H1) Then '如果 kSB为 1，则与多项式码进行异或
btLoCRC = btLoCRC Xor CH
btHiCRC = btHiCRC Xor CL
End If
Next Flag
Next i

RltS = HexToString(btHiCRC)
RltS = RltS + HexToString(btLoCRC)

Return RltS

End Function
Function HexToString(tmp As Byte) As String
Dim a1 As Integer
Dim a2 As Integer
Dim ss1 As String
If (tmp > 16) Then
a1 = Int(tmp / 16)
Else
a1 = 0
End If
a2 = tmp Mod 16

ss1 = NumToString(a1) + NumToString(a2)

Return ss1
End Function
Function NumToString(a1 As Integer) As String
Dim ss2 As String = Nothing
Select Case (a1)
Case 15
ss2 = "F"
Case 14
ss2 = "E"
Case 13
ss2 = "D"
Case 12
ss2 = "C"
Case 11
ss2 = "B"
Case 10
ss2 = "A"
Case 9
ss2 = Str(a1)
Case 8
ss2 = Str(a1)
Case 7
ss2 = Str(a1)
Case 6
ss2 = Str(a1)
Case 5
ss2 = Str(a1)
Case 4
ss2 = Str(a1)
Case 3
ss2 = Str(a1)
Case 2
ss2 = Str(a1)
Case 1
ss2 = Str(a1)
Case 0
ss2 = "0"
End Select
Return ss2
End Function

'CRC低位字节值表
Function GetCRCLo(Ind As Long) As Byte

Return Choose11(Ind + 1)
End Function
Private Function GetCRCHi(iIndex As Long) As Byte
Return Choose22(iIndex + 1)
End Function

Private Sub CRCCal()
Dim tmp As String
Dim Itmp As Integer

tmp = Microsoft.VisualBasic.Left(TextBox1.Text, 2)
Itmp = CInt(tmp)
btSend(0) = CByte(Itmp) '目标站号
tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 3, 2)
Itmp = CInt(tmp)
btSend(1) = CByte(Itmp) '功能码

tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 5, 2)
Itmp = Convert.ToInt32(tmp, 16)
btSend(2) = CByte(Itmp) 'Q1．1地址 (0009)高字节
tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 7, 2)
Itmp = Convert.ToInt32(tmp, 16)
btSend(3) = CByte(Itmp) 'Q1．1地址 (0009)低字节
tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 9, 2)
Itmp = Convert.ToInt32(tmp, 16)
btSend(4) = CByte(Itmp) '强制值高字节
tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 11, 2)
Itmp = Convert.ToInt32(tmp, 16)
btSend(5) = CByte(Itmp) '强制值低字节
Dim crc

crc = CalCRC16Fast(btSend, 6)
btSend(6) = btHiCRC
btSend(7) = btLoCRC

Read11.Text = TextBox1.Text + crc

End Sub

Private Sub Send_Click(sender As Object, e As EventArgs) Handles Send.Click
Dim SendByte(7) As Byte
Dim Cnt1 As Integer
Dim ShowStr As String = Nothing

SendByte = btSend
SerialPort1.Write(SendByte, 0, SendByte.Length)
Thread.Sleep(150)
If SerialPort1.BytesToRead > 5 Then
Dim buffRec As Byte() = New Byte(SerialPort1.BytesToRead - 1) {}
SerialPort1.Read(buffRec, 0, buffRec.Length)
Cnt1 = buffRec.Length
Dim data(Cnt1 - 1) As Byte
For i = 0 To Cnt1 - 1
ShowStr = ShowStr + Str(buffRec(i))
Next

'Convert byte array to word array
TxtReceive.Text = ShowStr
Result11.Text = ShowStr
End If

End Sub

Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged
Call CRCCal
End Sub

End Class