Attribute VB_Name = "CRC16"

'CRC-16-CCITT   x16 + x12 + x5 + 1
'Here's my conversion of a C routine into VB for CCITT CRC-16 (I think the original code was in a book called "Serial Protocols")
'Although it uses longs you will notice that the top 16 bits are always zero.(I used longs as there are no unsigned ints in VB)
'hope this helps
' Call InitCRC16 once before using
' Set lCRC to zero before calling UpdateCRC
Public lCrc                   As Long

Private lCRC16Table(0 To 255) As Long

'***************************************************************************
'InitCRC16
'Purpose: Initialises the CRC lookup table. Should only be run once
'Passed:  none
'Returns: none
'***************************************************************************
Public Sub InitCrc16()

    'Tablo Doğru oluşturuluyor.
    Dim i, J, lCrc, lTemp As Long

    For i = 0 To 255
        lCrc = i * 256

        For J = 0 To 7

            If ((lCrc And &H8000&) > 0) Then
                lTemp = &H1021&
            Else
                lTemp = 0
            End If

            lCrc = (lCrc * 2) Xor (lTemp)
        Next J

        lCRC16Table(i) = lCrc And &HFFFF&
    Next i

End Sub

'******************************************************************************
'Update CRC
'Purpose: Updates the CRC with the string s
'Passed:  string to update with (currently only supports 1 char)
'Returns: none
'******************************************************************************
Public Function UpdateCrc(s As String)

    Dim lIndex As Long

    Dim i      As Integer

    Dim lLen   As Long

    lLen = Len(s)

    For i = 1 To lLen
        lIndex = (CLng(lCrc \ 256) Xor CLng(Asc(Mid(s, i, 1)))) And &HFF&
        lCrc = lCRC16Table(lIndex) Xor (lCrc * 256)
        lCrc = lCrc And &HFFFF&
    Next i

End Function
'Kim Pedersen [vbCode Magician] <codemagic...@get2net.dk> wrote in message
'news:u5hhKraj$GA.243@cppssbbsa02.microsoft.com...