Calculating CRC8 in VBA

2019-05-10 16:15发布

问题:

So sadly I have to admit that I gave up on 8 hour search for the correct CRC8 code in VBA programming language. There are many examples, but yet I haven't find the one that works in my case. So here I am, asking you for help, if someone can write me this part of code, or if there's a misterious link, that I haven't clicked on.

Explanation:

AppID = "A00000039656434103F0154020D4000A" 

In my project, it is required that char "A" is at the end of this AppID, since based on this the CRC8 should be calculated. If understand correct (cause I might have gone insane during entire day of trying to write this CRC8 function) I have 32-byte ID, on which I want to do the CRC8 check on the 16bits (does this make sense?)

In the given example, I have only the result of what the CRC8 should return:

CRC8 = 0x6D

And I need to replace the lower nible with the char "A" in my main AppID:

FinalAppID = "A00000039656434103F0154020D4000D"

PROBLEM: But I simply don't know how to write nor to convert the codes from C++ / C#. And I was really strick with step by step conversion, yet it didn't work.

This is the code I use:

Public function calculateCRC8(ByVal AppID As String ) As String
    Dim CRC8 As Byte
    Dim i as Integer
    Dim j as Integer
    Dim AppIDarray()


    CRC8 = &HC7; //Based on preset 0xE3 
    aidLenght = LEN(AppID)
    AppIDarray = StringToArray(AppID) ' I user a UDF that I wrote, this should work OK'
            For j = 0 To aidLenght
                CRC8 = CRC8 Xor AppIDarray(j) 
                For i = 1 To 8 
                    If CRC8 And &H80 Then
                     CRC8 = (CRC8 * 2) Xor &H1D
                    Else
                     CRC8 = CRC8 * 2
                    End If  
                next i
            Next j
    calculateCRC8 = CRC8
End Function

I'm not in office now, so there might by typos in the above code, or some silly mistakes, I wrote it just now by my head, as I worked with it entire day.

The problem that occurs with above code is:

Error:

Error: Overflow!

This error occurs even if I pass the entire string, or just the 16bits. Same error.

If anyone has anything to help me out here, I will be really grateful to him!

回答1:

Here is a version of with a few fixes and it prevents the overflow from happening. It generates the expected result (&H6D) for your hex bytes (A00000039656434103F0154020D4000A).

Public Function calculateCRC8(ByVal AppID As String) As String
    Dim CRC8 As Byte
    Dim i As Integer
    Dim j As Integer
    Dim AppIDarray() As Byte  '<--- explicitly dimensioned as a Byte array to avoid confusion


    CRC8 = &HC7  

    'The AppID is actually bytes stored in hexadecimal in a string. You have to convert them back to bytes before you can run a crc8 on them.
    AppIDarray = HexToByte(AppID)
    aidLength = UBound(AppIDarray)
            For j = 0 To aidLength
                CRC8 = CRC8 Xor AppIDarray(j)
                For i = 1 To 8
                    If CRC8 And &H80 Then
                     'masking off the left-most bit before shifting prevents the Overflow error.
                     CRC8 = ((&H7F And CRC8) * 2) Xor &H1D
                    Else
                     CRC8 = CRC8 * 2
                    End If
                Next i
            Next j
    calculateCRC8 = CRC8
End Function

This function takes a hexadecimal string and interprets it as a Byte array.

Public Function HexToByte(strHex As String) As Byte()
    Dim i As Integer
    Dim tempByte As Byte
    Dim outBytes() As Byte
    ReDim outBytes(Len(strHex) \ 2 - 1)
    For i = 0 To Len(strHex) \ 2 - 1
        For j = 0 To 1
            char = Mid(strHex, i * 2 + j + 1, 1)
            Select Case char
                Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9":
                    tempByte = tempByte Or (Asc(char) - 48)
                Case "A", "B", "C", "D", "E", "F":
                    tempByte = tempByte Or (Asc(char) - 55)
            End Select
            If j = 0 Then
                tempByte = tempByte * 2 ^ 4
            Else
                outBytes(i) = tempByte
                tempByte = 0
            End If
        Next
    Next
    HexToByte = outBytes
End Function