Private Function CalcCrc(CRC As Integer, ByVal Char As Byte)
     Dim I As Byte
 
     For I = 1 To 8
          If CRC And &H8000 Then
               If CRC And &H4000 Then
                    CRC = ((CRC And &H3FFF) * &H2& Or &H8000) Or ((Char And _
                      &HFF80) \ &H80&) Xor &H1021
               Else
                    CRC = ((CRC And &H3FFF) * &H2& Or ((Char And &HFF80) \ _
                      &H80&)) Xor &H1021
               End If
          Else
               If CRC And &H4000 Then
                    CRC = ((CRC And &H3FFF) * &H2& Or &H8000) Or ((Char And _
                      &HFF80) \ &H80&)
               Else
                    CRC = ((CRC And &H3FFF) * &H2& Or ((Char And &HFF80) \ _
                      &H80&))
               End If
          End If
 
          Char = (Char * &H2&) And &HFF
     Next I
End Function
 
Public Sub ComputeCRC_CITT()
     Dim TmpStr As String, CRCInt As Integer, I As Integer
 
     TmpStr = "Hello World"
 
     CRCInt = 0
     For I = 1 To Len(TmpStr)
          Call CalcCrc(CRCInt, Asc(Mid$(TmpStr, I, 1)))
     Next I
     Debug.Print "CRC-CITT: " & Hex(CRCInt)
End Sub