Here is the code to calculate the CRC16-CCITT checksum which uses the x^16,x^12,x^5,x^1 polynomial. It uses a lookup table for speed. DataByte() is the byte array which the checksum is calculated for. In the example the array is loaded from a hex string in Text1.Text. The initial value is loaded from Text2.Text. The CRC is displayed in Text3.Text. The lookup table is pasted in at the end of the code. It should be copied into a text file called CRCTAB.txt and saved in the same folder as the Project.
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 Index As Long Dim TempLng As Integer Dim CRC As Long
TempStr = Text1.Text ' Load text box hex bytes DataSize = (Len(TempStr) / 2) - 1 ' Calc nunber of pairs of chrs ReDim DataByte(DataSize) ' Resize the array Index = 1 For X = 0 To DataSize ' Load array into memory DataByte(X) = "&h" & Mid(TempStr, Index, 2) Index = Index + 2 Next
CRC = CLng("&h" & Text2.Text) ' Load initial value (normally 0xFFFF)
For X = 0 To DataSize ' Loop through data bytes TempLng = ((CRC \ 256) Xor DataByte(X)) ' Shift left (>>8) XOR with data CRC = ((CRC * 256) And 65535) Xor CRCTab(TempLng) ' Shift right (<<8) prevent overflow, XOR with table Next Text3.Text = Right("0000" & Hex(CRC), 4)
End Sub
'Load single byte CRC table Private Sub Form_Load() Dim X As Long Dim TempStr As String
Open App.Path & "\CRCTAB.txt" For Input As #1 For X = 0 To 255 Input #1, TempStr CRCTab(X) = CLng(TempStr) Next Close #1
End Sub
&h0000, &h1021, &h2042, &h3063, &h4084, &h50A5, &h60C6, &h70E7,&h8108, &h9129, &hA14A, &hB16B, &hC18C, &hD1AD, &hE1CE, &hF1EF,&h1231, &h0210, &h3273, &h2252, &h52B5, &h4294, &h72F7, &h62D6,&h9339, &h8318, &hB37B, &hA35A, &hD3BD, &hC39C, &hF3FF, &hE3DE,&h2462, &h3443, &h0420, &h1401, &h64E6, &h74C7, &h44A4, &h5485,&hA56A, &hB54B, &h8528, &h9509, &hE5EE, &hF5CF, &hC5AC, &hD58D,&h3653, &h2672, &h1611, &h0630, &h76D7, &h66F6, &h5695, &h46B4,&hB75B, &hA77A, &h9719, &h8738, &hF7DF, &hE7FE, &hD79D, &hC7BC,&h48C4, &h58E5, &h6886, &h78A7, &h0840, &h1861, &h2802, &h3823,&hC9CC, &hD9ED, &hE98E, &hF9AF, &h8948, &h9969, &hA90A, &hB92B,&h5AF5, &h4AD4, &h7AB7, &h6A96, &h1A71, &h0A50, &h3A33, &h2A12,&hDBFD, &hCBDC, &hFBBF, &hEB9E, &h9B79, &h8B58, &hBB3B, &hAB1A,&h6CA6, &h7C87, &h4CE4, &h5CC5, &h2C22, &h3C03, &h0C60, &h1C41,&hEDAE, &hFD8F, &hCDEC, &hDDCD, &hAD2A, &hBD0B, &h8D68, &h9D49,&h7E97, &h6EB6, &h5ED5, &h4EF4, &h3E13, &h2E32, &h1E51, &h0E70,&hFF9F, &hEFBE, &hDFDD, &hCFFC, &hBF1B, &hAF3A, &h9F59, &h8F78,&h9188, &h81A9, &hB1CA, &hA1EB, &hD10C, &hC12D, &hF14E, &hE16F,&h1080, &h00A1, &h30C2, &h20E3, &h5004, &h4025, &h7046, &h6067,&h83B9, &h9398, &hA3FB, &hB3DA, &hC33D, &hD31C, &hE37F, &hF35E,&h02B1, &h1290, &h22F3, &h32D2, &h4235, &h5214, &h6277, &h7256,&hB5EA, &hA5CB, &h95A8, &h8589, &hF56E, &hE54F, &hD52C, &hC50D,&h34E2, &h24C3, &h14A0, &h0481, &h7466, &h6447, &h5424, &h4405,&hA7DB, &hB7FA, &h8799, &h97B8, &hE75F, &hF77E, &hC71D, &hD73C,&h26D3, &h36F2, &h0691, &h16B0, &h6657, &h7676, &h4615, &h5634,&hD94C, &hC96D, &hF90E, &hE92F, &h99C8, &h89E9, &hB98A, &hA9AB,&h5844, &h4865, &h7806, &h6827, &h18C0, &h08E1, &h3882, &h28A3,&hCB7D, &hDB5C, &hEB3F, &hFB1E, &h8BF9, &h9BD8, &hABBB, &hBB9A,&h4A75, &h5A54, &h6A37, &h7A16, &h0AF1, &h1AD0, &h2AB3, &h3A92,&hFD2E, &hED0F, &hDD6C, &hCD4D, &hBDAA, &hAD8B, &h9DE8, &h8DC9,&h7C26, &h6C07, &h5C64, &h4C45, &h3CA2, &h2C83, &h1CE0, &h0CC1,&hEF1F, &hFF3E, &hCF5D, &hDF7C, &hAF9B, &hBFBA, &h8FD9, &h9FF8,&h6E17, &h7E36, &h4E55, &h5E74, &h2E93, &h3EB2, &h0ED1, &h1EF0 |