CRC -CCITT 如何修改以下代码，使得初始值为oxFFFF

shuxw1986 2013-09-10 01:52:21

text1的内容为"010001010001090522110555021234EEEE05110609050000510162060003450200822000000000003050"

Dim byout() As Byte

Private Sub Command1_Click()
Dim i As Long
ReDim byout(1 To Len(Text1.Text) / 2)
For i = 1 To Len(Text1.Text) / 2
byout(i) = "&H" & Mid(Text1.Text, 2 * i - 1, 2)
Next
Text2.Text = Checkout_ccitt(1, UBound(byout))
End Sub

'计算byout(begnum)到byout(endnum) 的CRC-CCITT校验码(16位的x16+x12+x5+1)
Public Function Checkout_ccitt(Begnum As Integer, Endnum As Integer)
Dim da As String
Dim crc As Long
Dim Tmp As String
Dim i As Long
For i = Begnum To Endnum
Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))

Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))

Tmp = Hex2Bin(Hex(byout(i))) 'crc = crc xor ccitt(da xor byout(i)向右移四位)
Do Until Len(Tmp) = 8
Tmp = "0" & Tmp
Loop
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4))))))

Tmp = Hex2Bin(Hex(crc)) 'crc的高四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
da = CLng("&H" & Bin2Hex("0000" & Left(Tmp, 4)))

Tmp = Hex2Bin(Hex(crc)) 'crc向左移四位
Do Until Len(Tmp) = 16
Tmp = "0" & Tmp
Loop
crc = CLng("&H" & Bin2Hex(Right(Tmp, 12) & "0000"))

'crc = crc xor ccitt(da xor（byout(i) and &HOF）)
crc = crc Xor CLng("&H" & Hex(Ccitt(Val(da) Xor (byout(i) And 15))))
Next

Checkout_ccitt = ""
For i = Len(Hex(crc)) To 4 - 1
Checkout_ccitt = Checkout_ccitt & "0"
Next
Checkout_ccitt = Checkout_ccitt & Hex(crc)
End Function
Function Ccitt(ind As Integer)
Ccitt = Choose(ind + 1, &H0, &H1021, &H2042, &H3063, &H4084, &H50A5, &H60C6, _
&H70E7, &H8108, &H9129, &HA14A, &HB16B, &HC18C, &HD1AD, &HE1CE, &HF1EF)
End Function

Function Hex2Bin(HexValue As String) As String
Const BinIndexTable = "0000000100100011010001010110011110001001101010111100110111101111"
Dim n As Integer
Dim Tmp As String
Tmp = ""
For n = 1 To Len(HexValue)
Tmp = Tmp + Mid(BinIndexTable, _
(Val("&H" + Mid(HexValue, n, 1)) * 4 + 1), 4)
Next
Hex2Bin = Tmp
End Function
Function Bin2Hex(BinValue As String) As String
Dim Tmp As Integer, n As Integer
Do Until Len(BinValue) Mod 4 = 0
BinValue = "0" & BinValue
Loop
Bin2Hex = ""
For n = 1 To Len(BinValue) Step 4
Tmp = 0
If Mid(BinValue, n, 1) = "1" Then Tmp = 8
If Mid(BinValue, n + 1, 1) = "1" Then Tmp = Tmp + 4
If Mid(BinValue, n + 2, 1) = "1" Then Tmp = Tmp + 2
If Mid(BinValue, n + 3, 1) = "1" Then Tmp = Tmp + 1
Bin2Hex = Bin2Hex & Hex(Tmp)
Next
End Function

...全文