CRC16 Buypass berechnen VBA

Public 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 = &H8005&

    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_CCITT2 = lngCRC2

    Else

        CRC_CCITT2 = lngCRC

    End If

End Function

Private Sub Befehl137_Click()

   Dim data(1) As Byte

   data(0) = 4

   data(1) = 80

   MsgBox "Crc16 = " & Hex$(CRC_CCITT2(data, True))

End Sub