CRC / LRC Calculator

[John Waalkes]

Hi guys, I'm in the process of re-writing my Modbus client and I thought that I would share my CRC / LRC routines (the CRC16 is the one that seems to give everyone trouble - it shouldn't, it's easy).

The polynomial defaults to &hA001, which is what Modbus uses. But you can change it to anything that you like.

Code Select Expand

'CRC / LRC Checksum Calculator
'Created by John Waalkes
'This Code Is Public Domain. Enjoy.
'No warranties, express or implied. Use At your own risk.
'Dec 20, 2010



'--------------------------------------------------------------------------------
Function FORM1_WM_CREATE ( _
                         hWndForm As Dword, _      ' handle of Form
                         ByVal UserData As Long _  ' optional user defined Long value
                         ) As Long

End Function
                                                                         
'--------------------------------------------------------------------------------

Function FORM1_CMDCALCCRCB_BN_CLICKED ( _
                                   ControlIndex     As Long,  _  ' index in Control Array
                                   hWndForm         As Dword, _  ' handle of Form
                                   hWndControl      As Dword, _  ' handle of Control
                                   idButtonControl  As Long   _  ' identifier of button
                                   ) As Long

Dim Poly As Word
Dim CRC As Word
Dim MBStr$

MBStr$ = FF_TextBox_GetText (HWND_FORM1_TXTINPSTR)
Poly = Val("&h" + FF_TextBox_GetText (HWND_FORM1_TXTPoly))

If MBStr$ <> "" Then
   Call CRC16ComputeB (MBStr$, Poly, CRC)             'This is the Binary (CRC) version
End If

End Function

'--------------------------------------------------------------------------------

Function FORM1_CMDCALCCRCH_BN_CLICKED ( _
                                   ControlIndex     As Long,  _  ' index in Control Array
                                   hWndForm         As Dword, _  ' handle of Form
                                   hWndControl      As Dword, _  ' handle of Control
                                   idButtonControl  As Long   _  ' identifier of button
                                   ) As Long

Dim Poly As Word
Dim CRCErr As Word
Dim CRC As Word
Dim MBStr$

MBStr$ = FF_TextBox_GetText (HWND_FORM1_TXTINPSTR)
Poly = Val("&h" + FF_TextBox_GetText (HWND_FORM1_TXTPoly))

If MBStr$ <> "" Then
   Call CRC16ComputeH (MBStr$, Poly, CRC, CRCErr)     'This is the HEX (CRC) version
End If

End Function

'--------------------------------------------------------------------------------

Function FORM1_CMDCALCLRC_BN_CLICKED ( _
                                     ControlIndex     As Long,  _  ' index in Control Array
                                     hWndForm         As Dword, _  ' handle of Form
                                     hWndControl      As Dword, _  ' handle of Control
                                     idButtonControl  As Long   _  ' identifier of button
                                     ) As Long

Dim CRCErr As Word
Dim LRC As Word
Dim MBStr$

MBStr$ = FF_TextBox_GetText (HWND_FORM1_TXTINPSTR)

If MBStr$ <> "" Then
   Call LRCCompute (MBStr$, LRC, CRCErr)     'This is the LRC (HEX only) version
End If

End Function

'--------------------------------------------------------------------------------
Sub CRC16ComputeB (MBStr$, Poly As Word, CRC As Word)   'calculate the CRC treating each character as one byte (Binary).

Dim tCRC As Word
Dim b$
Dim i%

If MBStr$ = "" Then Exit Sub                       'Not too much that we can do with an empty string.

tCRC = &hFFFF                                      'Seed tCRC with -1
Do While MBStr$ <> ""
   b$ = Left$(MBStr$,1)                            'Grab a character.
   MBStr$ = Right$(MBStr$, Len(MBStr$) - 1)        'Now remove it from MBStr$
   tCRC = tCRC Xor Asc(b$)                         'Xor tCRC with the first byte

   For i% = 1 To 8                                 'If tCRC is an odd number, we need to shift it right on place and Xor it with the Polynominal (in this case, &hA001)
      If (tCRC And 1) = 1 Then
         Shift Right tCRC, 1
         tCRC = tCRC Xor Poly
      Else
         Shift Right tCRC, 1                       'Otherwise, just shift it right one bit.
      End If
   Next i%   
Wend

MBStr$ = Hex$(tCRC)                                'The result needs to be byte-swapped (little endian to big endian) for the Modbus world
MBStr$ = Right$(MBStr$, 2) + Left$(MBStr$, 2)      'This gets the string swapped
CRC = Val("&h" + MBStr$)                           'And this gets you the actual value.

FF_TextBox_SetText (ByVal HWND_FORM1_TXTMODBUSCRC,  ByVal MBStr$)
End Sub

'--------------------------------------------------------------------------------

Sub CRC16ComputeH (MBStr$, Poly As Word, CRC As Word, CRCErr As Word)   'calculate the CRC treating each character as two bytes (HEX).
                                                                        'include CRCErr since we have a couple of errors that occur here (non-HEX, and odd number of nibbles).
Dim tCRC As Word
Dim b$
Dim i%

If Len(MBStr$) Mod 2 = 1 Then
   CRCErr = 1  'Odd number of nibbles (keep in mind that each character in MBStr$ represents one nibble)
   Exit Sub
End If

MBStr$ = UCase$(MBStr$) 'Transfer the string to upper case (for the Tally operation)

i% = Tally (MBStr$, Any "1234567890ABCDEF")  'Tally up the number of legal characters in MBStr$, if it doesn't add up to the length of the string, then we have a problem.
If i% <> Len(MBStr$) Then
   crcerr = 2  'A non-Hex character was found.
   Exit Sub
End If

tCRC = &hFFFF                                      'Basically the same as the binary version with the exception that each character will represent a HEX nibble.
Do While MBStr$ <> ""                       
   b$ = Left$(MBStr$,2)                            'Grab two characters (to make up one byte)
   MBStr$ = Right$(MBStr$, Len(MBStr$) - 2)        'Shortem MBStr$ by two characters (which is why we make sure that MBStr$ has an even number of characters).
   tCRC = tCRC Xor Val("&h" + b$)                  'By prepending b$ with "&h" we tell VAL that we are sending it a HEX value.
   For i% = 1 To 8                                 'If tCRC is an odd number, we need to shift it right on place and Xor it with the Polynominal (in this case, &hA001)
      If (tCRC And 1) = 1 Then
         Shift Right tCRC, 1
         tCRC = tCRC Xor Poly
      Else
         Shift Right tCRC, 1                       'Otherwise, just shift it right one bit.
      End If
   Next i%   
Wend

MBStr$ = Hex$(tCRC)                                'The result needs to be byte-swapped (little endian to big endian) for the Modbus world
MBStr$ = Right$(MBStr$, 2) + Left$(MBStr$, 2)      'This gets the string swapped
CRC = Val("&h" + MBStr$)                           'And this gets you the actual value.

FF_TextBox_SetText (ByVal HWND_FORM1_TXTMODBUSCRC,  ByVal MBStr$)
End Sub

'--------------------------------------------------------------------------------

Sub LRCCompute (MBStr$, LRC As Word, CRCErr As Word)                    'calculate the LRC treating each character as two bytes (HEX).
                                                                        'include CRCErr since we have a couple of errors that occur here (non-HEX, and odd number of nibbles).
Dim tLRC As Byte
Dim b$
Dim i%

If Len(MBStr$) Mod 2 = 1 Then
   CRCErr = 1  'Odd number of nibbles (keep in mind that each character in MBStr$ represents one nibble)
   Exit Sub
End If

MBStr$ = UCase$(MBStr$) 'Transfer the string to upper case (for the Tally operation)

i% = Tally (MBStr$, Any "1234567890ABCDEF")  'Tally up the number of legal characters in MBStr$, if it doesn't add up to the length of the string, then we have a problem.
If i% <> Len(MBStr$) Then
   crcerr = 2  'A non-Hex character was found.
   Exit Sub
End If

tLRC = 0

Do While MBStr$ <> ""                       
   b$ = Left$(MBStr$,2)                            'Grab two characters (to make up one byte)
   MBStr$ = Right$(MBStr$, Len(MBStr$) - 2)        'Shortem MBStr$ by two characters (which is why we make sure that MBStr$ has an even number of characters).
   tLRC = tLRC + Val("&h" + b$)                    'By prepending b$ with "&h" we tell VAL that we are sending it a HEX value.
Wend

tLRC = &hFF - tLRC + 1

MBStr$ = Hex$(tLRC)                               
LRC = Val("&h" + MBStr$)                           'And this gets you the actual value.

FF_TextBox_SetText (ByVal HWND_FORM1_TXTMODBUSCRC,  ByVal MBStr$)
End Sub

'--------------------------------------------------------------------------------