vb点虐 crc效验 crc校验vb源代码

vb如何实现CRC12校验

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

vb crc冗余校验

计算法就是依据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的低位可能在前，而高位在后。

如何在vb中写crc32校验

两种方法：

1、查表法 通过字节内容查表后与下一个字节异或，再查表，再异或，直至最后得到校验码。在VB中设置定义数组后查表即可。

2、计算法 按照crc多项式，自己编写子程序进行计算，输入变量为需要校验的字节（可定义成字节数组），返回校验码。

VB 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