13518219792
Private Sub Form_Load()
崇左网站制作公司哪家好，找创新互联！从网页设计、网站建设、微信开发、APP开发、响应式网站设计等网站项目制作，到程序开发，运营维护。创新互联于2013年开始到现在10年的时间，我们拥有了丰富的建站经验和运维经验，来保证我们的工作的顺利进行。专注于网站建设就选创新互联。
'text1为校验对象
Text1.Text = "31303432"
'text2为校验多项式
Text2.Text = "180D"
End Sub
Private Sub Command1_Click()
Text3.Text = CRC(Text1.Text, Text2.Text, 12)
End Sub
Private Function CRC(ByVal Hex_Number As String, ByVal Hex_CRC As String, Optional ByVal C As Integer = 16) As String
'Hex_Number为校验项16进制数字，Hex_CRC为校验多项式，16进制，C为默认位数CRC-16
Dim i As Integer
Dim BinNumber As String
Dim BinCRC As String
Dim Temp As String
CRC = "0"
If Hex_Number = "0" Then Exit Function
BinNumber = HEXtoBin(Hex_Number)
BinCRC = HEXtoBin(Hex_CRC)
i = Len(BinCRC)
BinNumber = BinNumber String(C, "0")
CRC = Left(BinNumber, i)
Temp = Right(BinNumber, Len(BinNumber) - i)
Temp = HEXtoBin(Hex(CLng("H" BINtoHEX(CRC)) Xor CLng("H" Hex_CRC))) Temp
CRC = BINtoHEX(Temp)
If Len(Temp) = i Then
CRC = CRC(CRC, Hex_CRC, 0)
End If
End Function
Private Function HEXtoBin(Hex_Number) As String
'十六进制转换为二进制
Dim i As Long
Dim B As String
Hex_Number = UCase(Hex_Number)
For i = 1 To Len(Hex_Number)
Select Case Mid(Hex_Number, i, 1)
Case "0": B = B "0000"
Case "1": B = B "0001"
Case "2": B = B "0010"
Case "3": B = B "0011"
Case "4": B = B "0100"
Case "5": B = B "0101"
Case "6": B = B "0110"
Case "7": B = B "0111"
Case "8": B = B "1000"
Case "9": B = B "1001"
Case "A": B = B "1010"
Case "B": B = B "1011"
Case "C": B = B "1100"
Case "D": B = B "1101"
Case "E": B = B "1110"
Case "F": B = B "1111"
End Select
Next i
While Left(B, 1) = "0"
B = Right(B, Len(B) - 1)
Wend
HEXtoBin = B
End Function
Private Function BINtoHEX(ByVal Bin_Number As String) As String
'二进制转换为十六进制
Dim i As Long
Dim H As String
If Len(Bin_Number) Mod 4 0 Then
Bin_Number = String(4 - Len(Bin_Number) Mod 4, "0") Bin_Number
End If
For i = 1 To Len(Bin_Number) Step 4
Select Case Mid(Bin_Number, i, 4)
Case "0000": H = H "0"
Case "0001": H = H "1"
Case "0010": H = H "2"
Case "0011": H = H "3"
Case "0100": H = H "4"
Case "0101": H = H "5"
Case "0110": H = H "6"
Case "0111": H = H "7"
Case "1000": H = H "8"
Case "1001": H = H "9"
Case "1010": H = H "A"
Case "1011": H = H "B"
Case "1100": H = H "C"
Case "1101": H = H "D"
Case "1110": H = H "E"
Case "1111": H = H "F"
End Select
Next i
While Left(H, 1) = "0"
H = Right(H, Len(H) - 1)
Wend
BINtoHEX = H
End Function
计算法就是依据CRC校验码的产生原理来设计程序。其优点是模块代码少，修改灵活，可移植性好。其缺点为计算量大。为了便于理解，这里假定了三位数据，而多项式码为A001(hex)。
在窗体上放置一命令按钮Command1，并添加如下代码：
Private Sub Command1_Click()
Dim CRC() As Byte
Dim d() As Byte '待传输数据
ReDim d(2) As Byte
d(0) = 123
d(1) = 112
d(2) = 135
CRC = CRC16(d) '调用CRC16计算函数
'CRC(0)为高位
'CRC(1)为低位
End Sub
注意：在数据传输时CRC的低位可能在前，而高位在后。
两种方法：
1、查表法 通过字节内容查表后与下一个字节异或，再查表，再异或，直至最后得到校验码。在VB中设置定义数组后查表即可。
2、计算法 按照crc多项式，自己编写子程序进行计算，输入变量为需要校验的字节（可定义成字节数组），返回校验码。
大概看了下。有变量定义类型错误，修改如下：
Public
Function
crc16(ByRef
cmdstring()
As
Byte,
DataLen
As
Integer)
As
String
Dim
data
As
Integer
Dim
i
As
Integer
Dim
CRCHi
As
long,
CRCLo
As
long'这里应该定义为long.因为下面赋值是long型。朋友。
Dim
iIndex
As
Long
Dim
CRCStr
As
String
Dim
DataStr
As
String
CRCLo
=
HFF'看这里的赋值。long型
CRCHi
=
HFF
For
i
=
To
DataLen
iIndex
=
CRCLo
Xor
cmdstring(i)
CRCLo
=
CRCHi
Xor
GetCRCLo(iIndex)
'低位处理
CRCHi
=
GetCRCHi(iIndex)
'高位处理
DataStr
=
DataStr
Chr(cmdstring(i))
Next
i
Dim
ReturnData(1)
As
Byte
ReturnData(1)
=
CRCHi
ReturnData(0)
=
CRCLo
CRCStr
=
StrConv(ReturnData,
vbUnicode)
crc16
=
DataStr
+
CRCStr
End
Function
