Need to build CRC-16 CCITT calculator

[justinshn]

Hello,

I'm trying to figure out how to modify some code to create an Excel calculator that has been set up for CRC XMODEM, to calculate for the CCITT polynomial x16 + x12 + x5 + 1

I changed the H8408 to H1021 but I'm getting the wrong calculation.

To test the code I enter the string 83FED3407A93 and I know the CRC is supposed to be, 0x702B which I then need to reverse the order to read as 0x2B70.

This is the code...

[vba]

Private Function CRC16(ByVal crc As Integer, d As Byte) As Integer
Dim carry As Integer, i As Byte
For i = 0 To 7
carry = (crc And 1) Xor IIf(d And (2 ^ i), 1, 0)
crc = (crc And &HFFFF&) \ 2
If carry <> 0 Then crc = crc Xor &H8408
Next i
CRC16 = crc
End Function

Public Function CalcCrc16(ByVal buf As String) As String
Dim crc As Integer, t As Integer
crc = &H8408
For t = 1 To Len(buf)
crc = CRC16(crc, Asc(Mid$(buf, t, 1)))
Next t
CalcCrc16 = Hex$(crc)
End Function

Public Function CalcCrc16R(ByVal buf As String) As String
Dim crc As Integer, t As Integer
crc = &H8408
For t = 1 To Len(buf)
crc = CRC16(crc, Asc(Mid$(buf, t, 1)))
Next t
CalcCrc16R = Right(Right("0000" & Hex$(crc), 4), 2) & Left(Right("0000" & Hex$(crc), 4), 2)
End Function [/vba]
If it helps figure out how to get the value I’m getting, when using this calculator - website is - zorc (dot) breitbandkatze (dot) de/crc (dot) html - with the following parameters

1) Click the CCITT button
2) Enter FFFF for the “Final XOR value”
3) select the "reverse data bytes" box and the "reverse CRC results before final XOR" box
4) Enter the string, separated with “%” signs - %83%FE%D3%40%7a%93 for a string of 83FED3407A93...the result produced is 702B, which I then need to reverse to read 2B70.

[Bob Phillips]

Cross-posted all over the place, with tons of answers which quite honestly the OP doesn't seem to understand, so I would venture anyone trying to help seeks out the OPs other postings - me, I will pass it.

[justinshn]

I am the OP...and I've posted this in multiple forums trying to find someone that knows how to do this.

Unfortunately, no one has given an answer that gives me a solution.

update: It looks like someone just posted a solution that will work on xtreme vb talk.

[justinshn]

The posting on xtreme vb talk isn't working for me when used in Excel. I just get a value of "0".

I don't have 5 entries yet, so I can't post the link...but since this is an Excel help for VB scripting, I'm hoping this would be the best place to get an answer of how to implement that script into Excel.

There is a longer thread on the excel forum website that gives the link to the code with the solution.

Thanks much!

[jane_guru]

Private Function ShiftLeft(word As Integer) As Integer
' correr word un bit hacia la izquierda
Dim word2long As Long
    
word2long = 0
Call CopyMemory(word2long, word, 2)
word2long = word2long * 2
Call CopyMemory(ShiftLeft, word2long, 2)
    
'solo para debug
word2long = 0
Call CopyMemory(word2long, ShiftLeft, 2)
End Function


Private Function ShiftNLeft(word As Integer, n As Integer) As Integer
' correr word n bits hacia la izquierda
Dim bitNumber As Integer
Dim word2long As Long
    
ShiftNLeft = word
For bitNumber = 1 To n
ShiftNLeft = ShiftLeft(ShiftNLeft)
Next bitNumber
    
' solo para debug
word2long = 0
Call CopyMemory(word2long, ShiftNLeft, 2)
End Function




Private Function crc16(ByRef data() As Byte, lenght As Integer) As Integer
Dim byteIndex, bitIndex, tmpWord As Integer
Dim carry As Boolean
    
crc16 = &H0
For byteIndex = 0 To lenght - 1
tmpWord = data(byteIndex)
crc16 = crc16 Xor ShiftNLeft(tmpWord, 8) 'for each data and CRC register XOR


bitIndex = 8
Do While bitIndex > 0
carry = crc16 < 0
crc16 = ShiftLeft(crc16)
            
If carry Then
crc16 = crc16 Xor &H1021
End If
bitIndex = bitIndex - 1
Loop
Next byteIndex
End Function

[mdmackillop]

Hi Jane
Welcome to the Forum. Thanks for your solution but this was a 7 year old post.
Regards
MD