Calculate CCITT 16-bit checksum from string

**hubertmettwurst** · 01-17-2012, 03:08 PM

Hi everybody,

I would like to calculate a checksum for a string in excel - I only have a C code that explains how it is supposed to be done:
(This is taken from the manual of the application that reads the values I need to calculate)

APPENDIX A: CYCLICAL REDUNDANCY CHECK (CRC) RULES
The last field of each record shall contain a calculated CRC for that record. The CRC shall be a 16 bit unsigned
CRC, calculated according to the CCITT algorithm with a seed value of 0521 hex.

All characters in the record shall be used in the calculation, including KEYWORDS, data items, quotes and
field delimiting commas.

The following is sample code to calculate record CRC values. This code can be used directly by any ANSI Standard
C compiler. To use this code, build up a buffer containing the record up to and including the last comma before the
CRC value, and pass this function the address and length of the buffer.

unsigned int rtpcrc(char *buf, unsigned int len)
{
unsigned int seed = 0x0521;
static unsigned int crc_tbl[] = {
0x0000, 0xC0C1, 0xC181, 0x0140, 0xC301, 0x03C0, 0x0280, 0xC241,
0xC601, 0x06C0, 0x0780, 0xC741, 0x0500, 0xC5C1, 0xC481, 0x0440,
0xCC01, 0x0CC0, 0x0D80, 0xCD41, 0x0F00, 0xCFC1, 0xCE81, 0x0E40,
0x0A00, 0xCAC1, 0xCB81, 0x0B40, 0xC901, 0x09C0, 0x0880, 0xC841,
0xD801, 0x18C0, 0x1980, 0xD941, 0x1B00, 0xDBC1, 0xDA81, 0x1A40,
0x1E00, 0xDEC1, 0xDF81, 0x1F40, 0xDD01, 0x1DC0, 0x1C80, 0xDC41,
0x1400, 0xD4C1, 0xD581, 0x1540, 0xD701, 0x17C0, 0x1680, 0xD641,
0xD201, 0x12C0, 0x1380, 0xD341, 0x1100, 0xD1C1, 0xD081, 0x1040,
0xF001, 0x30C0, 0x3180, 0xF141, 0x3300, 0xF3C1, 0xF281, 0x3240,
0x3600, 0xF6C1, 0xF781, 0x3740, 0xF501, 0x35C0, 0x3480, 0xF441,
0x3C00, 0xFCC1, 0xFD81, 0x3D40, 0xFF01, 0x3FC0, 0x3E80, 0xFE41,
0xFA01, 0x3AC0, 0x3B80, 0xFB41, 0x3900, 0xF9C1, 0xF881, 0x3840,
0x2800, 0xE8C1, 0xE981, 0x2940, 0xEB01, 0x2BC0, 0x2A80, 0xEA41,
0xEE01, 0x2EC0, 0x2F80, 0xEF41, 0x2D00, 0xEDC1, 0xEC81, 0x2C40,
0xE401, 0x24C0, 0x2580, 0xE541, 0x2700, 0xE7C1, 0xE681, 0x2640,
0x2200, 0xE2C1, 0xE381, 0x2340, 0xE101, 0x21C0, 0x2080, 0xE041,
0xA001, 0x60C0, 0x6180, 0xA141, 0x6300, 0xA3C1, 0xA281, 0x6240,
0x6600, 0xA6C1, 0xA781, 0x6740, 0xA501, 0x65C0, 0x6480, 0xA441,
0x6C00, 0xACC1, 0xAD81, 0x6D40, 0xAF01, 0x6FC0, 0x6E80, 0xAE41,
0xAA01, 0x6AC0, 0x6B80, 0xAB41, 0x6900, 0xA9C1, 0xA881, 0x6840,
0x7800, 0xB8C1, 0xB981, 0x7940, 0xBB01, 0x7BC0, 0x7A80, 0xBA41,
0xBE01, 0x7EC0, 0x7F80, 0xBF41, 0x7D00, 0xBDC1, 0xBC81, 0x7C40,
0xB401, 0x74C0, 0x7580, 0xB541, 0x7700, 0xB7C1, 0xB681, 0x7640,
0x7200, 0xB2C1, 0xB381, 0x7340, 0xB101, 0x71C0, 0x7080, 0xB041,
0x5000, 0x90C1, 0x9181, 0x5140, 0x9301, 0x53C0, 0x5280, 0x9241,
0x9601, 0x56C0, 0x5780, 0x9741, 0x5500, 0x95C1, 0x9481, 0x5440,
0x9C01, 0x5CC0, 0x5D80, 0x9D41, 0x5F00, 0x9FC1, 0x9E81, 0x5E40,
0x5A00, 0x9AC1, 0x9B81, 0x5B40, 0x9901, 0x59C0, 0x5880, 0x9841,
0x8801, 0x48C0, 0x4980, 0x8941, 0x4B00, 0x8BC1, 0x8A81, 0x4A40,
0x4E00, 0x8EC1, 0x8F81, 0x4F40, 0x8D01, 0x4DC0, 0x4C80, 0x8C41,
0x4400, 0x84C1, 0x8581, 0x4540, 0x8701, 0x47C0, 0x4680, 0x8641,
0x8201, 0x42C0, 0x4380, 0x8341, 0x4100, 0x81C1, 0x8081, 0x4040,
};
while(len--)
seed = crc_tbl[*((unsigned char *) buf)++ ^ (unsigned char) seed] ^
(unsigned char) (seed >> 8);
return(seed);
}

I found posts about calculating checksums from strings but none of them worked with an array like the above. I am wondering how to get that into vba?
As an example, the string (it is one single row of text...):
"PLAN_DEF","091111 12345","ALDERSON","TANGMAM ÅLESUND","","STE:0-20:4","20111123","150457","20","","","","","skonil","","","","","","skonil","","","Nucletron","Oncentra","OTP V4.1.0","IMPAC_DCM_SCP","2.20.08D7",
would have to result in the decimal "51870" (0xCA9E)

It would be great if someone could help me.
Greetings from Cologne
Hubert

**hubertmettwurst** · 02-01-2012, 04:40 PM

Anybody?
Would be nice.....

**ItumelengS** · 01-12-2022, 03:27 AM

Originally Posted by hubertmettwurst

Anybody?
Would be nice.....

Good day, sir, have you found a solution for this?

**AliGW** · 01-12-2022, 05:06 AM

The thread is almost exactly ten years old ...

**ItumelengS** · 01-12-2022, 04:00 PM

It's not yet answered though

**AliGW** · 01-12-2022, 05:11 PM

So do you have an answer? If so, please share it. If not, and you need help with something, please start your own new thread. Thanks.

**ItumelengS** · 11-05-2022, 02:21 AM

if you are still interested, here is the answer:

'Option Explicit
Dim CRCTab(255) As Long '               Array for single byte CRCs loaded from table
Dim DataByte() As Byte '                Array for byte data

Private Sub CmdStart_Click()
Dim TempStr As String
Dim DataSize As Long
Dim X As Long
Dim CRC As Long
Dim string_holder() As String
Dim byte_holder() As Byte
Dim bytes() As String

Dim FSO As New FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FileToRead = FSO.OpenTextFile("C:\Users\HP ZBOOK I5 10TH GEN\Downloads\example.rtp", ForReading) 'add here the path of your text file
    
TextString = FileToRead.ReadAll
    
FileToRead.Close

hex_number = TextString
byte_holder = TextString    'converts string to an array of bytes
ReDim bytes(UBound(byte_holder))

DataSize = (Len(hex_number) / 2) - 1 '                 Calc nunber of pairs of chrs
ReDim DataByte(DataSize) '                          Resize the array
wl = 0
For X = 0 To UBound(byte_holder) 'removing 0 bytes from the byte array
    yv = byte_holder(X)
    If yv <> 0 Then
        bytes(wl) = yv
        wl = wl + 1
    End If
Next
ReDim Preserve bytes(wl - 1)

CRC = CLng("&h0521") '                     Load initial value (normally 0xFFFF)
 
'CRC Table from the manual
CRCTable = Array(&H0, &HC0C1, &HC181, &H140, &HC301, &H3C0, &H280, &HC241, &HC601, &H6C0, &H780, &HC741, &H500, &HC5C1, &HC481, &H440, &HCC01, &HCC0, &HD80, &HCD41, &HF00, &HCFC1, &HCE81, &HE40, &HA00, &HCAC1, &HCB81, &HB40, &HC901, &H9C0, &H880, &HC841, _
&HD801, &H18C0, &H1980, &HD941, &H1B00, &HDBC1, &HDA81, &H1A40, &H1E00, &HDEC1, &HDF81, &H1F40, &HDD01, &H1DC0, &H1C80, &HDC41, &H1400, &HD4C1, &HD581, &H1540, &HD701, &H17C0, &H1680, &HD641, &HD201, &H12C0, &H1380, &HD341, &H1100, &HD1C1, &HD081, &H1040, _
&HF001, &H30C0, &H3180, &HF141, &H3300, &HF3C1, &HF281, &H3240, &H3600, &HF6C1, &HF781, &H3740, &HF501, &H35C0, &H3480, &HF441, &H3C00, &HFCC1, &HFD81, &H3D40, &HFF01, &H3FC0, &H3E80, &HFE41, &HFA01, &H3AC0, &H3B80, &HFB41, &H3900, &HF9C1, &HF881, &H3840, _
&H2800, &HE8C1, &HE981, &H2940, &HEB01, &H2BC0, &H2A80, &HEA41, &HEE01, &H2EC0, &H2F80, &HEF41, &H2D00, &HEDC1, &HEC81, &H2C40, &HE401, &H24C0, &H2580, &HE541, &H2700, &HE7C1, &HE681, &H2640, &H2200, &HE2C1, &HE381, &H2340, &HE101, &H21C0, &H2080, &HE041, _
&HA001, &H60C0, &H6180, &HA141, &H6300, &HA3C1, &HA281, &H6240, &H6600, &HA6C1, &HA781, &H6740, &HA501, &H65C0, &H6480, &HA441, &H6C00, &HACC1, &HAD81, &H6D40, &HAF01, &H6FC0, &H6E80, &HAE41, &HAA01, &H6AC0, &H6B80, &HAB41, &H6900, &HA9C1, &HA881, &H6840, _
&H7800, &HB8C1, &HB981, &H7940, &HBB01, &H7BC0, &H7A80, &HBA41, &HBE01, &H7EC0, &H7F80, &HBF41, &H7D00, &HBDC1, &HBC81, &H7C40, &HB401, &H74C0, &H7580, &HB541, &H7700, &HB7C1, &HB681, &H7640, &H7200, &HB2C1, &HB381, &H7340, &HB101, &H71C0, &H7080, &HB041, _
&H5000, &H90C1, &H9181, &H5140, &H9301, &H53C0, &H5280, &H9241, &H9601, &H56C0, &H5780, &H9741, &H5500, &H95C1, &H9481, &H5440, &H9C01, &H5CC0, &H5D80, &H9D41, &H5F00, &H9FC1, &H9E81, &H5E40, &H5A00, &H9AC1, &H9B81, &H5B40, &H9901, &H59C0, &H5880, &H9841, _
&H8801, &H48C0, &H4980, &H8941, &H4B00, &H8BC1, &H8A81, &H4A40, &H4E00, &H8EC1, &H8F81, &H4F40, &H8D01, &H4DC0, &H4C80, &H8C41, &H4400, &H84C1, &H8581, &H4540, &H8701, &H47C0, &H4680, &H8641, &H8201, &H42C0, &H4380, &H8341, &H4100, &H81C1, &H8081, &H4040)
 
'here is the python snippet of the code
'def compute( string ):
'    CRC = 0
'    for byte in string:
'        crc = (crc >> 8) ^ table[(crc ^ ord(byte)) & 0xff];
'    return crc
'the following is the rewording of a code from the above website so it could work on excel vba
For X = 0 To UBound(bytes) '                             Loop through data bytes
    B = CRCTable((CRC Xor CLng(bytes(X))) And &HFF) 'moves to negative, then i just shift it back using 65536, seeing its 16 bit
    If B < 0 Then
        B = 65536 + B
    End If
    CRC = Application.WorksheetFunction.Bitrshift(CRC, 8) Xor B ' Shift right (<<8) prevent overflow, XOR with table
Next
MsgBox CRC


End Sub

**FDibbins** · 11-06-2022, 12:44 AM

ItumelengS thanks for the update, but next time, please use code tags when posting code (I have added them for you - this time)

**ItumelengS** · 11-06-2022, 04:47 AM

Thank you for doing that, I was just too happy to have managed getting that solution. I was not thinking clearly in that moment. I will make sure of it next time I post some code.

**FDibbins** · 11-07-2022, 12:48 AM

No problem, thanks for understanding

Calculate CCITT 16-bit checksum from string

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Calculate CCITT 16-bit checksum from string

Re: Calculate CCITT 16-bit checksum from string

Re: Calculate CCITT 16-bit checksum from string

Re: Calculate CCITT 16-bit checksum from string

Re: Calculate CCITT 16-bit checksum from string

Re: Calculate CCITT 16-bit checksum from string

Re: Calculate CCITT 16-bit checksum from string

Re: Calculate CCITT 16-bit checksum from string

Re: Calculate CCITT 16-bit checksum from string

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions