' This procedure creates the CRC16 table for the polynomial X^16+X^15+X^5+1.  The table
' consists of 256 16 bit words.  Each word is represented here by a record of Hi byte and Lo
' byte.  This implimentation overcomes the problem of having no 16 bit unsigned integer type
' available in Visual Basic.  The table is represented here as a series of strings which are
' converted to their equivalent byte values to populate the table.
Sub Create_Crc_Table()

Dim Index, Line_Number, Char_In_String, Hex_Char As Integer
Dim Hex_String As String
Dim Hi As Boolean

Dim crc_table_string(1 To 32) As String

    crc_table_string(1) = "&H00,&H00,&HC0,&HC1,&HC1,&H81,&H01,&H40,&HC3,&H01,&H03,&HC0,&H02,&H80,&HC2,&H41,"
    crc_table_string(2) = "&HC6,&H01,&H06,&HC0,&H07,&H80,&HC7,&H41,&H05,&H00,&HC5,&HC1,&HC4,&H81,&H04,&H40,"
    crc_table_string(3) = "&HCC,&H01,&H0C,&HC0,&H0D,&H80,&HCD,&H41,&H0F,&H00,&HCF,&HC1,&HCE,&H81,&H0E,&H40,"
    crc_table_string(4) = "&H0A,&H00,&HCA,&HC1,&HCB,&H81,&H0B,&H40,&HC9,&H01,&H09,&HC0,&H08,&H80,&HC8,&H41,"
    crc_table_string(5) = "&HD8,&H01,&H18,&HC0,&H19,&H80,&HD9,&H41,&H1B,&H00,&HDB,&HC1,&HDA,&H81,&H1A,&H40,"
    crc_table_string(6) = "&H1E,&H00,&HDE,&HC1,&HDF,&H81,&H1F,&H40,&HDD,&H01,&H1D,&HC0,&H1C,&H80,&HDC,&H41,"
    crc_table_string(7) = "&H14,&H00,&HD4,&HC1,&HD5,&H81,&H15,&H40,&HD7,&H01,&H17,&HC0,&H16,&H80,&HD6,&H41,"
    crc_table_string(8) = "&HD2,&H01,&H12,&HC0,&H13,&H80,&HD3,&H41,&H11,&H00,&HD1,&HC1,&HD0,&H81,&H10,&H40,"
    crc_table_string(9) = "&HF0,&H01,&H30,&HC0,&H31,&H80,&HF1,&H41,&H33,&H00,&HF3,&HC1,&HF2,&H81,&H32,&H40,"
    crc_table_string(10) = "&H36,&H00,&HF6,&HC1,&HF7,&H81,&H37,&H40,&HF5,&H01,&H35,&HC0,&H34,&H80,&HF4,&H41,"
    crc_table_string(11) = "&H3C,&H00,&HFC,&HC1,&HFD,&H81,&H3D,&H40,&HFF,&H01,&H3F,&HC0,&H3E,&H80,&HFE,&H41,"
    crc_table_string(12) = "&HFA,&H01,&H3A,&HC0,&H3B,&H80,&HFB,&H41,&H39,&H00,&HF9,&HC1,&HF8,&H81,&H38,&H40,"
    crc_table_string(13) = "&H28,&H00,&HE8,&HC1,&HE9,&H81,&H29,&H40,&HEB,&H01,&H2B,&HC0,&H2A,&H80,&HEA,&H41,"
    crc_table_string(14) = "&HEE,&H01,&H2E,&HC0,&H2F,&H80,&HEF,&H41,&H2D,&H00,&HED,&HC1,&HEC,&H81,&H2C,&H40,"
    crc_table_string(15) = "&HE4,&H01,&H24,&HC0,&H25,&H80,&HE5,&H41,&H27,&H00,&HE7,&HC1,&HE6,&H81,&H26,&H40,"
    crc_table_string(16) = "&H22,&H00,&HE2,&HC1,&HE3,&H81,&H23,&H40,&HE1,&H01,&H21,&HC0,&H20,&H80,&HE0,&H41,"
    crc_table_string(17) = "&HA0,&H01,&H60,&HC0,&H61,&H80,&HA1,&H41,&H63,&H00,&HA3,&HC1,&HA2,&H81,&H62,&H40,"
    crc_table_string(18) = "&H66,&H00,&HA6,&HC1,&HA7,&H81,&H67,&H40,&HA5,&H01,&H65,&HC0,&H64,&H80,&HA4,&H41,"
    crc_table_string(19) = "&H6C,&H00,&HAC,&HC1,&HAD,&H81,&H6D,&H40,&HAF,&H01,&H6F,&HC0,&H6E,&H80,&HAE,&H41,"
    crc_table_string(20) = "&HAA,&H01,&H6A,&HC0,&H6B,&H80,&HAB,&H41,&H69,&H00,&HA9,&HC1,&HA8,&H81,&H68,&H40,"
    crc_table_string(21) = "&H78,&H00,&HB8,&HC1,&HB9,&H81,&H79,&H40,&HBB,&H01,&H7B,&HC0,&H7A,&H80,&HBA,&H41,"
    crc_table_string(22) = "&HBE,&H01,&H7E,&HC0,&H7F,&H80,&HBF,&H41,&H7D,&H00,&HBD,&HC1,&HBC,&H81,&H7C,&H40,"
    crc_table_string(23) = "&HB4,&H01,&H74,&HC0,&H75,&H80,&HB5,&H41,&H77,&H00,&HB7,&HC1,&HB6,&H81,&H76,&H40,"
    crc_table_string(24) = "&H72,&H00,&HB2,&HC1,&HB3,&H81,&H73,&H40,&HB1,&H01,&H71,&HC0,&H70,&H80,&HB0,&H41,"
    crc_table_string(25) = "&H50,&H00,&H90,&HC1,&H91,&H81,&H51,&H40,&H93,&H01,&H53,&HC0,&H52,&H80,&H92,&H41,"
    crc_table_string(26) = "&H96,&H01,&H56,&HC0,&H57,&H80,&H97,&H41,&H55,&H00,&H95,&HC1,&H94,&H81,&H54,&H40,"
    crc_table_string(27) = "&H9C,&H01,&H5C,&HC0,&H5D,&H80,&H9D,&H41,&H5F,&H00,&H9F,&HC1,&H9E,&H81,&H5E,&H40,"
    crc_table_string(28) = "&H5A,&H00,&H9A,&HC1,&H9B,&H81,&H5B,&H40,&H99,&H01,&H59,&HC0,&H58,&H80,&H98,&H41,"
    crc_table_string(29) = "&H88,&H01,&H48,&HC0,&H49,&H80,&H89,&H41,&H4B,&H00,&H8B,&HC1,&H8A,&H81,&H4A,&H40,"
    crc_table_string(30) = "&H4E,&H00,&H8E,&HC1,&H8F,&H81,&H4F,&H40,&H8D,&H01,&H4D,&HC0,&H4C,&H80,&H8C,&H41,"
    crc_table_string(31) = "&H44,&H00,&H84,&HC1,&H85,&H81,&H45,&H40,&H87,&H01,&H47,&HC0,&H46,&H80,&H86,&H41,"
    crc_table_string(32) = "&H82,&H01,&H42,&HC0,&H43,&H80,&H83,&H41,&H41,&H00,&H81,&HC1,&H80,&H81,&H40,&H40,"
      
    Hi = True
    Index = 0
        
  For Line_Number = 1 To 32
  
    Char_In_String = 1
    For Char_In_String = 1 To 80 Step 5
    
        Hex_String = Mid(crc_table_string(Line_Number), Char_In_String, 4)
        
        If Hi = True Then
            Crc_Table(Index).Hi = Val(Hex_String)
            ' Toggle to low byte
            Hi = False
        Else
            Crc_Table(Index).Lo = Val(Hex_String)
            ' Toggle to high byte
            Hi = True
            ' Increment the CRC table index
            Index = Index + 1
        End If
        
    Next Char_In_String
  
  Next Line_Number

End Sub
'This function checks the CRC of the byte array held in section(1..32)
'It impliments a common CRC16 algorithm
'It compliments the subroutine Set_Crc in this module
'It returns a value of True if the check is successful and False otherwise.
Function Check_Crc()

Const Section_Length_C As Integer = 32
Dim Byte_Index As Integer
Dim Table_Index As Integer
Dim Crc As Crc_Type
   
    Crc.Lo = 0
    Crc.Hi = 0
    
    For Byte_Index = 1 To Section_Length_C
    
        'exclusive-or the input byte with the low-order byte of the CRC register to get an INDEX
        Table_Index = Crc.Lo Xor Section(Byte_Index)
        'shift the CRC register eight bits to the right
        Crc.Lo = Crc.Hi
        Crc.Hi = 0
        ' exclusive-or the CRC register with the contents of Table at Table_Index
        Crc.Lo = Crc.Lo Xor Crc_Table(Table_Index).Lo
        Crc.Hi = Crc.Hi Xor Crc_Table(Table_Index).Hi
        
    Next Byte_Index
    
    'If the CRC register is zero then the check has passed
    If Crc.Lo = 0 And Crc.Hi = 0 Then
        Check_Crc = True
    Else
        Check_Crc = False
    End If

End Function
'This function sets the CRC for the byte array held in Section(1..32)
'It impliments a common CRC16 algorithm.
'It compliments the function Check_Crc in this module
'It calculates the CRC from Section (1..30) and assigns the CRC low byte to
'Section(31) and CRC high byte to Section(32)
Sub Set_Crc()

Const Section_Length_C As Integer = 32
Const Crc_Length As Integer = 32
Dim Byte_Index As Integer
Dim Table_Index As Integer
Dim Crc As Crc_Type
   
    Crc.Lo = 0
    Crc.Hi = 0
    
    For Byte_Index = 1 To Section_Length_C - Crc_Length_C
    
        'exclusive-or the input byte with the low-order byte of the CRC register to get an INDEX
        Table_Index = Crc.Lo Xor Section(Byte_Index)
        'shift the CRC register eight bits to the right
        Crc.Lo = Crc.Hi
        Crc.Hi = 0
        ' exclusive-or the CRC register with the contents of Table at Table_Index
        Crc.Lo = Crc.Lo Xor Crc_Table(Table_Index).Lo
        Crc.Hi = Crc.Hi Xor Crc_Table(Table_Index).Hi
        
        'If all 30 bytes have been processed then assign the Crc to the byte array
        If Byte_Index = Section_Length_C - Crc_Length_C Then
            Section(Byte_Index + 1) = Crc.Lo
            Section(Byte_Index + 2) = Crc.Hi
        End If
        
    Next Byte_Index
    
End Sub