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.
'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
'--------------------------------------------------------------------------------