Private Sub ClacCRCTable(ByVal p As Integer)
     Dim I As Integer, HexInt As Integer, j As Byte
 
     Poly = Polynom
 
     For I = 0 To 255
          If I And &H80 Then
               HexInt = ((I And &H7F) * &H100) Or &H8000
          Else
               HexInt = ((I And &H7F) * &H100)
          End If
 
          For j = 1 To 8
               If HexInt And &H8000 Then
                    If HexInt And &H4000 Then
                         HexInt = ((HexInt And &H3FFF) * 2) Or &H8000
                    Else
                         HexInt = ((HexInt And &H3FFF) * 2)
                    End If
                    HexInt = HexInt Xor Polynom
               Else
                    If HexInt And &H4000 Then
                         HexInt = ((HexInt And &H3FFF) * 2) Or &H8000
                    Else
                         HexInt = ((HexInt And &H3FFF) * 2)
                    End If
               End If
          Next j
 
          CRCTbl(I) = HexInt
     Next I
End Sub
 
 
Private Function Reflect(ByVal rIn As Integer, Optional ByVal bReflect As _
  Integer = 16) As Integer
     Dim I As Integer, rOut As Integer, K As Integer
     Dim TmpInt As Integer, j As Integer, HiBit As Integer
 
     j = 1
     HiBit = 2 ^ (bReflect - 1)
     I = HiBit
 
     For K = 0 To bReflect - 1
          If rIn And I Then
               rOut = rOut Or j
          End If
 
          I = I / 2 And Not HiBit
 
          TmpInt = (j And &H3FFF) * 2
          If j And &H4000 Then
               j = TmpInt Or &H8000
          Else
               j = TmpInt
          End If
     Next K
     Reflect = rOut
End Function
 
 
Public Function CRC(ByRef bData() As Byte, cbData As Long) As Integer
     Dim I As Long, L As Integer, R As Integer, bXor As Boolean
     Dim TmpInt As Integer, CrcInit As Integer, TmpB As Integer
 
     CrcInit = Init
 
     If bIndirect Then
          For I = 0 To 15
               TmpInt = (CrcInit And &H3FFF) * 2
               If CrcInit And &H4000 Then
                    TmpInt = TmpInt Or &H8000
               End If
 
               If CrcInit And &H8000 Then
                    CrcInit = TmpInt Xor Poly
               Else
                    CrcInit = TmpInt
               End If
          Next I
     End If
 
     CRC = CrcInit
 
     For I = 0 To cbData - 1
          L = ((CRC And &H7F) * &H100)
          If CRC And &H80 Then L = L Or &H8000
 
          R = (CRC And &H7FFE) \ &H100
          If CRC And &H8000 Then R = (R Or (&H4000 \ &H80))
 
          If bReverseData Then
               TmpB = Reflect(bData(I), 8)
          Else
               TmpB = bData(I)
          End If
 
          CRC = (L And &HFF00) Xor CRCTbl(R Xor TmpB)
     Next I
 
     If bReverseCRC Then
          CRC = Reflect(CRC)
     End If
 
     CRC = CRC Xor Final
End Function
 
 
Public Function CRC_Str(ByVal StrData As String) As Integer
     Dim cbStr As Long, bStr() As Byte
 
     cbStr = Len(StrData)
     If cbStr > 0 Then
          ReDim bStr(cbStr - 1)
          WideCharToMultiByte 0, 0, ByVal StrPtr(StrData), cbStr * 2, bStr(0), _
            cbStr, "", 0
     End If
 
     CRC_Str = CRC(bStr, cbStr)
End Function

may be the force with you