crc16校验 用VB编写的CRC校验程序

用VB编写的CRC校验程序
Private Sub Command1_Click()
Dim bcrc%, gp&, bdf& bcrc值为整型, gp值为长整型, bdf值为长整型
bcrc = 16 用CRC—16位校验
gp = V al("&H" & CStr(Text2.Text) & "&") gp为生成多项式缺省为11021（16进制）bdf = Val("&H" & CStr(Text1.Text) & "&") bdf为原值
Text3 = Hex(calcrc(bcrc, gp, bdf)) 为生成的CRC值
End Sub
Function calcrc(bcrc As Integer, gp As Long, bdf As Long) As Long
Dim c1&, c2&
Dim a1%, prec1&
Dim leftvalue%, a1shift%
If bdf = 0 Then
calcrc = 0
Exit Function
End If
a1 = (Len(Hex(bdf)) - 1) * 4 a1 ={原值（16进制）的字符数目-1}*4
c1 = bdf * 2 ^ bcrc 进行异或运行前，把原值（2进制）后面加16个0
leftvalue = Val("&H" & Mid(Hex(bdf), 1, 1)) 原值的左边第1位（最高位）数值（16进制）If leftvalue >= 1 Then a1shift = 1 原值的最高位=1 偏差=1
If leftvalue >= 2 Then a1shift = 2 原值的最高位=2或3 偏差=2
If leftvalue >= 4 Then a1shift = 3 原值的最高位>=4，<=7 偏差=3
If leftvalue >= 8 Then a1shift = 4 原值的最高位>=8 偏差=4
a1 = a1 + (a1shift - 1) 原值（后面加16个0）与生成多项式的二进制码的个数差c2 = gp * 2 ^ a1 把生成多项式的后面也相应加a1个0
Do
prec1 = c1
c1 = c1 Xor c2 原值与生成多项式进行异或
Do
a1 = a1 – 1 a1数值减1
If c1 > prec1 Then 如果异或的结果大于原值，说明原值的左边第1位（最高位）为0 c1 = prec1 Xor (gp * 2 ^ a1) 把a1的值减少一位后，继续异或
Else
Exit Do
End If
Loop
c2 = gp * 2 ^ a1
Loop Until c1 <= gp 直至异或的结果小于生成多项式calcrc = c1 所得的异或结果即是CRC值
End Function。