Smart questions
Smart answers
Smart people
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Member Login

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips now!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

Join Tek-Tips
*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

LINK TO THIS FORUM!

Add Stickiness To Your Site By Linking To This Professionally Managed Technical Forum.
Just copy and paste the
code below into your site.

Partner With Us!

"Best Of Breed" Forums Add Stickiness To Your Site
Partner Button
(Download This Button Today!)

Feedback

"...What you have done for people like me is immeasurably helpful."

Geography

Where in the world do Tek-Tips members come from?

How to calculate fast CRC16-CCITT checksum in VB

SJA (TechnicalUser)
22 Jan 10 7:10
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
 

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close