ModBus CRC16校验VB算法
ModBus CRC16
VB与modbus rtu协议通信,并进行CRC校验
modbus rtu协议可以算是一种事实上的工业标准协议，为许多仪表、PLC等所支持。
以前有几个用户问如何使用VB编程来与我们的KND-K3系列PLC通讯，于是整了一个demo程序。
这次把这个demo共享，希望能给大家一点帮助。
Sub Button1_Click()
Dim str As String
Dim sByte(10) As Byte
Dim i As Integer, j As Integer
Dim l As Byte, h As Byte
str = Trim(Sheet1.TextBox1.Text)
str = Replace(str, " ", "")
j = 0
For i = 0 To Len(str) - 1 Step 2
sByte(j) = Mid(str, i + 1, 2)
j = j + 1
Next
MsgBox CalCRC16Fast(sByte, 5, l, h)
MsgBox CalCRC16Tbl(sByte, 5, l, h)
End Sub
Public Function CalCRC16Fast(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) As String
Dim CL As Byte, CH As Byte '多项式码&HA001
Dim SaveHi As Byte, SaveLo As Byte
Dim i As Integer
Dim Flag As Integer
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 '如果LSB为1，则与多项式码进行异或
btLoCRC = btLoCRC Xor CH
btHiCRC = btHiCRC Xor CL
End If
Next Flag
Next i
Dim ReturnData(1) As Byte
ReturnData(0) = Hex(btHiCRC) 'CRC高位
ReturnData(1) = Hex(btLoCRC) 'CRC低位
CalCRC16Fast = ReturnData(1) & ReturnData(0)
End Function
Public Function CalCRC16Tbl(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) As String
'Dim btLoCRC As Byte
' Dim btHiCRC As Byte
btLoCRC = &HFF
btHiCRC = &HFF
Dim i As Integer
Dim iIndex As Long
For i = 0 To (no - 1)
iIndex = btHiCRC Xor data(i)
btHiCRC = btLoCRC Xor GetCRCLo(iIndex)
'低位处理
btLoCRC = GetCRCHi(iIndex) '高位处理
Next i
Dim ReturnData(1) As Byte
ReturnData(0) = Hex(btHiCRC) 'CRC高位
ReturnData(1) = Hex(btLoCRC) 'CRC低位
CalCRC16Tbl = ReturnData(0) & ReturnData(1)
End Function
'CRC低位字节值表
Function GetCRCLo(Ind As Long) As Byte
GetCRCLo = Choose(Ind + 1, _
&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)
End Function
'CRC高位字节值表
Function GetCRCHi(Ind As Long) As Byte
GetCRCHi = Choose(Ind + 1, _
&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)
End Function