Option Explicit

'Вычисляет CRC-сумму -Public Function CRC(ByVal s As String, ByVal IsCRC32 As Boolean) As String

Public Function CRC(ByVal s As String, ByVal IsCRC32 As Boolean) As String
   ' Initializes CRC, updates CRC for each char in S, and finishes
   ' off at the end.
   ' Examining this function, and "CRCUpdate", should make it obvious
   ' how to do a CRC of a large binary file.
   ' 32 bit Returns zero for zero length string (probably why the CRC is
   ' complimented at the end.)
   Dim L As Long
   Dim LCRC As Long
   Dim ICRC As Integer
   
   Select Case IsCRC32
      Case True
         ' Initialise: this is part of the CRC32 protocol.
         LCRC = &HFFFFFFFF
         
         ' Update for each byte in S
         For L =  1  To Len(s): CRCUpdate LCRC, Asc(Mid$(s, L)): Next
         
         ' Finally flip all bits, again, just part of the prorocol.
         LCRC = Not LCRC
         
         ' Format the long CRC value as a hex string.
         ' Insert leading zeros if required.
         CRC = Hex$(LCRC): Do While Len(CRC) <  8 : CRC = "0" & CRC: Loop
         
      Case Else
         ' Initialise. Integer maths used.
         ICRC = &HFFFF
         
         ' Update for each byte in S
         For L =  1  To Len(s): CRCUpdate ICRC, Asc(Mid$(s, L)): Next
         
         ' Format the long CRC value as a hex string.
         ' Insert leading zeros if required.
         CRC = Hex$(ICRC): Do While Len(CRC) <  4 : CRC = "0" & CRC: Loop
         
   End Select
End Function

Private Sub CRCUpdate(ByRef CRC, ByVal b As Byte)
   ' Note no type declaration for CRC, as a long or integer can be passed.
   Const Polynomial16 As Integer = &HA001
   Const Polynomial32 As Long = &HEDB88320
   Dim Bits As Byte
   
   CRC = CRC Xor b
   For Bits =  0  To  7 
      Select Case (CRC And &H1) ' test LSB
            Case  0 
               ' LSB zero, just shift.
               CRC = rightShift(CRC)
            Case Else
               ' only xor with polynomial if lsb set.
               Select Case VarType(CRC)
                  Case vbLong
                     CRC = rightShift(CRC) Xor Polynomial32
                  Case Else
                     CRC = rightShift(CRC) Xor Polynomial16
               End Select
      End Select
   Next
End Sub

Private Function rightShift(ByVal V) As Long
   ' Note no type declaration for V, as a long or integer can be passed.
   ' Self-explanatory. The final line is essential (maybe
   ' not obvious) because the number is signed.
   Select Case VarType(V)
      Case vbLong
         rightShift = V And &HFFFFFFFE
         rightShift = rightShift \ &H2
         rightShift = rightShift And &H7FFFFFFF
      Case Else
         rightShift = V And &HFFFE
         rightShift = rightShift \ &H2
         rightShift = rightShift And &H7FFF
   End Select
End Function