Hi,
I really liked this hash calculator. I am a software developer and would appreciate it if I could be able to use this from VB 6. I am only interested in the FCS 16 and FCS 32 algorithms. The problem I am running into is that VB does not support bit shifting and because of this I have to do it manually. But that gives me incorrect CRC values some times. If anyone can point me to something that could do this in VB or be called from VB it would be nice. If anyone can figure out code anomalies that would be nice too. I am attaching my code below.
Thanks in advance.
Vishal.
Option Explicit<br />
<br />
Public CRCArray As Variant<br />
<br />
Public Function CalcCRC(DataString As String) As String<br />
Dim DataLen As Integer<br />
Dim CRCValue As Long<br />
Dim CRCShiftRight As Integer<br />
Dim X As Integer<br />
Dim NextPieceofData As Integer<br />
Dim CRCShiftRightStr As String<br />
Dim ArrayPointer As Integer<br />
'invert<br />
Dim CRCIntStr As String<br />
Dim CRCFinalString As String<br />
Dim CRCletter As String<br />
Dim TempStr As String<br />
Dim CRCShiftRightLONG As Long<br />
<br />
'invert<br />
DataLen = Len(DataString)<br />
'init variables<br />
CRCShiftRight = 0<br />
ArrayPointer = 0<br />
' Enought potatoes<br />
' fcs = (fcs >> 8) ^ fcstab[(fcs ^ datapiece) & 0xff];<br />
' int CRC to 0xffff<br />
CRCValue = &HFFFF<br />
' Loop thru data<br />
For X = 1 To DataLen<br />
NextPieceofData = Asc(Mid(DataString, X, 1))<br />
' SHIFT RIGHT (By turning to Hex movng letters and then back to integer)<br />
CRCShiftRightLONG = CRCValue And &HFF00<br />
'Long to short conversion<br />
If CRCShiftRightLONG < 32767 Then<br />
CRCShiftRight = CRCShiftRightLONG<br />
TempStr = Hex(CRCShiftRight)<br />
Else<br />
TempStr = Hex(CRCShiftRightLONG)<br />
End If<br />
' End Long to short conversion<br />
'Take care of extra or not enough Hex Characters<br />
If Len(TempStr) = 4 Then<br />
CRCShiftRightStr = Mid(TempStr, 1, 2)<br />
Else<br />
If Len(TempStr) = 3 Then<br />
CRCShiftRightStr = Mid(TempStr, 1, 1)<br />
Else<br />
If Len(TempStr) < 3 Then<br />
CRCShiftRightStr = "00"<br />
Else<br />
If Len(TempStr) > 4 Then<br />
CRCShiftRightStr = "00"<br />
Debug.Print "lentempstr error"<br />
End If<br />
End If<br />
End If<br />
End If<br />
<br />
<br />
'End Take care of extra or not enough Hex Characters<br />
<br />
CRCShiftRight = Val("&H" & CRCShiftRightStr)<br />
<br />
' END SHIFT RIGHT<br />
<br />
'ArrayPointer<br />
ArrayPointer = (CRCValue Xor NextPieceofData) And &HFF<br />
'End ArrayPointer<br />
<br />
<br />
'XOR<br />
CRCValue = (CRCShiftRight) Xor CRCArray(ArrayPointer)<br />
'End XOR<br />
Next<br />
<br />
'Fix neg Numbers<br />
If CRCValue < 0 Then<br />
CRCValue = 65536 + CRCValue<br />
End If<br />
'End Fix Ned Numbers<br />
<br />
<br />
<br />
CRCValue = CRCValue Xor &HFFFF<br />
CRCFinalString = Hex(CRCValue)<br />
<br />
<br />
Dim HiCRC As String<br />
Dim LoCRC As String<br />
Dim Hi As Byte<br />
Dim Lo As Byte<br />
<br />
HiCRC = Hex(CRCValue And &HFF)<br />
Hi = Val("&H" & HiCRC)<br />
LoCRC = Mid(CRCFinalString, 5, 2)<br />
Lo = Val("&H" & LoCRC)<br />
<br />
DataString = DataString & Chr(Hi) & Chr(Lo)<br />
CalcCRC = DataString<br />
<br />
End Function<br />
<br />
Public Sub Init()<br />
CRCArray = Array( _<br />
&H0, &H1189, &H2312, &H329B, &H4624, &H57AD, &H6536, &H74BF0, &H8C48, &H9DC1, &HAF5A, &HBED3, &HCA6C, &HDBE5, &HE97E, &HF8F7, _<br />
&H1081, &H108, &H3393, &H221A, &H56A5, &H472C, &H75B7, &H643E, &H9CC9, &H8D40, &HBFDB, &HAE52, &HDAED, &HCB64, &HF9FF, &HE876, _<br />
&H2102, &H308B, &H210, &H1399, &H6726, &H76AF, &H4434, &H55BD, &HAD4A, &HBCC3, &H8E58, &H9FD1, &HEB6E, &HFAE7, &HC87C, &HD9F5, _<br />
&H3183, &H200A, &H1291, &H318, &H77A7, &H662E, &H54B5, &H453C, &HBDCB, &HAC42, &H9ED9, &H8F50, &HFBEF, &HEA66, &HD8FD, &HC974, _<br />
&H4204, &H538D, &H6116, &H709F, &H420, &H15A9, &H2732, &H36BB, &HCE4C, &HDFC5, &HED5E, &HFCD7, &H8868, &H99E1, &HAB7A, &HBAF3, _<br />
&H5285, &H430C, &H7197, &H601E, &H14A1, &H528, &H37B3, &H263A, &HDECD, &HCF44, &HFDDF, &HEC56, &H98E9, &H8960, &HBBFB, &HAA72, _<br />
&H6306, &H728F, &H4014, &H519D, &H2522, &H34AB, &H630, &H17B9, &HEF4E, &HFEC7, &HCC5C, &HDDD5, &HA96A, &HB8E3, &H8A78, &H9BF1, _<br />
&H7387, &H620E, &H5095, &H411C, &H35A3, &H242A, &H16B1, &H738, &HFFCF, &HEE46, &HDCDD, &HCD54, &HB9EB, &HA862, &H9AF9, &H8B70, _<br />
&H8408, &H9581, &HA71A, &HB693, &HC22C, &HD3A5, &HE13E, &HF0B7, &H840, &H19C9, &H2B52, &H3ADB, &H4E64, &H5FED, &H6D76, &H7CFF, _<br />
&H9489, &H8500, &HB79B, &HA612, &HD2AD, &HC324, &HF1BF, &HE036, &H18C1, &H948, &H3BD3, &H2A5A, &H5EE5, &H4F6C, &H7DF7, &H6C7E, _<br />
&HA50A, &HB483, &H8618, &H9791, &HE32E, &HF2A7, &HC03C, &HD1B5, &H2942, &H38CB, &HA50, &H1BD9, &H6F66, &H7EEF, &H4C74, &H5DFD, _<br />
&HB58B, &HA402, &H9699, &H8710, &HF3AF, &HE226, &HD0BD, &HC134, &H39C3, &H284A, &H1AD1, &HB58, &H7FE7, &H6E6E, &H5CF5, &H4D7C, _<br />
&HC60C, &HD785, &HE51E, &HF497, &H8028, &H91A1, &HA33A, &HB2B3, &H4A44, &H5BCD, &H6956, &H78DF, &HC60, &H1DE9, &H2F72, &H3EFB, _<br />
&HD68D, &HC704, &HF59F, &HE416, &H90A9, &H8120, &HB3BB, &HA232, _<br />
&H5AC5, &H4B4C, &H79D7, &H685E, &H1CE1, &HD68, &H3FF3, &H2E7A, _<br />
&HE70E, &HF687, &HC41C, &HD595, &HA12A, &HB0A3, &H8238, &H93B1, _<br />
&H6B46, &H7ACF, &H4854, &H59DD, &H2D62, &H3CEB, &HE70, &H1FF9, _<br />
&HF78F, &HE606, &HD49D, &HC514, &HB1AB, &HA022, &H92B9, &H8330, _<br />
&H7BC7, &H6A4E, &H58D5, &H495C, &H3DE3, &H2C6A, &H1EF1, &HF78)<br />
End Sub<br />
|