Public Class Form1
Public data1 As String '待校验的数组名称
Public Number1 As Long
Public data2 As String
Public Number2 As Long
'no 数组 中元素个数
'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}
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Public Function CalCRC16Fast(data() As Byte, no As Integer, btLoCRC As Byte, btHiCRC As Byte) 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 s1 As String
If (tmp > 16) Then
a1 = Int(tmp / 16)
Else
a1 = 0
End If
a2 = tmp Mod 16
s1 = NumToString(a1) + NumToString(a2)
Return s1
End Function
Function NumToString(a1 As Integer) As String
Dim s1 As String
Select Case (a1)
Case 15
s1 = "F"
Case 14
s1 = "E"
Case 13
s1 = "D"
Case 12
s1 = "C"
Case 11
s1 = "B"
Case 10
s1 = "A"
Case 9
s1 = Str(a1)
Case 8
s1 = Str(a1)
Case 7
s1 = Str(a1)
Case 6
s1 = Str(a1)
Case 5
s1 = Str(a1)
Case 4
s1 = Str(a1)
Case 3
s1 = Str(a1)
Case 2
s1 = Str(a1)
Case 1
s1 = Str(a1)
Case 0
s1 = Str(a1)
End Select
Return s1
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 Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim btSend(8) As Byte
Dim tmp As String
Dim Itmp As Integer
tmp = Microsoft.VisualBasic.Left(TextBox1.Text, 2)
Itmp = Int(tmp)
btSend(0) = CByte(Itmp) '目标站号
tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 3, 2)
Itmp = Int(tmp)
btSend(1) = CByte(Itmp) '功能码
tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 5, 2)
Itmp = Int(tmp)
btSend(2) = CByte(Itmp) 'Q1.1地址 (0009)高字节
tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 7, 2)
Itmp = Int(tmp)
btSend(3) = CByte(Itmp) 'Q1.1地址 (0009)低字节
tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 9, 2)
Itmp = Int(tmp)
btSend(4) = CByte(Itmp) '强制值高字节
tmp = Microsoft.VisualBasic.Mid(TextBox1.Text, 11, 2)
Itmp = Int(tmp)
btSend(5) = CByte(Itmp) '强制值低字节
Dim crc
Dim btCRCHi As Byte, btCRCLo As Byte
crc = CalCRC16Fast(btSend, 6, btCRCLo, btCRCHi)
btSend(6) = btCRCHi
btSend(7) = btCRCLo
TextBox8.Text = crc
End Sub
End Class
留言列表