Hi all,
I try the FireFly project but it give res errors?
'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_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
Local Poly As Word
Local CRC As Word
Local MBStr As String
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
Local Poly As Word
Local CRCErr As Word
Local CRC As Word
Local MBStr As String
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
Local CRCErr As Word
Local LRC As Word
Local MBStr As String
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 (ByVal MBStr As String, ByVal Poly As Word, ByVal CRC As Word) 'calculate the CRC treating each character as one byte (Binary).
Local tCRC As Word
Local b As String
Local i As Integer
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 (ByVal MBStr As String, ByVal Poly As Word, ByVal CRC As Word, ByVal 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).
Local tCRC As Word
Local b As String
Local i As Integer
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).
Local tLRC As Word
Local b As String
Local i As Integer
'include CRCErr since we have a couple of errors that occur here (non-HEX, and odd number of nibbles).
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
Hi Stephane,
You missed a change in the "Sub LRCCompute" declaration
This: Sub LRCCompute (MBStr$, LRC As Word, ....
Should be: Sub LRCCompute (MBStr As String, LRC As Word, CRCErr As Word)
Also, keep in mind that I wrote this for Modbus RTU, which always works out to an even number of bytes. Modbus ASCII uses a LRC check (included in the program), and it can be of any length.
Also for use with Modbus RTU, the order of the CRC checksum has to be swapped. Which has been done for you in the program.
The LRC calculation is used for Modbus ASCII, and also has to have to have an even number of bytes. (Which BTW, was broken - oops!)
The "straight up" CRC16 calculation is just thrown in there for completeness (or in other words, I can't remember why I put it in there).
And finally, I apologize for not including the entire project as a zip file, I don't know what I was thinking/drinking!
Let me know if you need anything else.