Private Function CRC_CCITT2(btArrX() As Byte, _
bolLOFirst As Boolean) As Long
Dim lngCRC As Long
Dim lngPolynom As Long
Dim x As Long
Dim y As Long
Dim bolB1 As Boolean
Dim bolB2 As Boolean
Dim lngArr2(15) As Long
Dim lngCRC2 As Long
Dim btArr() As Byte
 
     ReDim btArr(UBound(btArrX) + 2)
 
     For x = 0 To UBound(btArrX)
         btArr(x) = btArrX(x)
     Next
     btArr(x) = &H0
     btArr(x + 1) = &H0
 
     For x = 0 To 15
         lngArr2(x) = 2 ^ x
     Next
 
     lngPolynom = &H1021& '11021
 
     For x = 0 To UBound(btArr)
         For y = 0 To 7
             bolB1 = lngCRC > &H7FFF&
             bolB2 = btArr(x) And lngArr2(y)
             lngCRC = lngCRC And &H7FFF&
 
             lngCRC = lngCRC * 2
             If bolB2 Then
                 lngCRC = lngCRC + 1
             End If
             If bolB1 Then
                 lngCRC = lngCRC Xor lngPolynom
             End If
         Next
     Next
 
     If bolLOFirst Then
         For x = 0 To 15
             If lngCRC And lngArr2(x) Then
                 lngCRC2 = lngCRC2 + lngArr2(15 - x)
             End If
         Next
         CRC_CCITT = lngCRC2
     Else
         CRC_CCITT = lngCRC
     End If
 
End Function