'CRC Checksum Class
'------------------------------------
'
'A very fast solution to calculate the
'CRC Checksum (at the moment CRC16 and
'CRC32 values) with the help of some
'pre-compiled assembler code
'
'(c) 2000, Fredrik Qvarfort
'
 
Option Explicit
 
Private CRC32 As Long
Private CRC32Asm() As Byte
Private CRC32Table(0 To 255) As Long
 
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
  ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal _
  wParam As Long, ByVal lParam As Long) As Long
 
Public Function AddBytes(ByteArray() As Byte) As Variant
 
  Dim ByteSize As Long
 
  'We need to add a simple error trapping
  'here because if the bytearray is not
  'dimensioned we want it to just skip
  'the assembler code call below
  On Local Error GoTo NoData
 
  'Precalculate the size of the byte array
  ByteSize = UBound(ByteArray) - LBound(ByteArray) + 1
 
  'No error trapping needed, if something
  'goes bad below something is definitely
  'fishy with your computer
  On Local Error GoTo 0
 
  'Run the pre-compiled assembler code
  'for the current selected algorithm
   Call CallWindowProc(VarPtr(CRC32Asm(0)), VarPtr(CRC32), VarPtr(ByteArray( _
     LBound(ByteArray))), VarPtr(CRC32Table(0)), ByteSize)
 
NoData:
  'Return the current CRC value
  AddBytes = Value
 
End Function
Public Function AddString(Text As String) As Variant
 
  'Convert the string into a byte array
  'and send it to the function that can
  'handle bytearrays
  AddString = AddBytes(StrConv(Text, vbFromUnicode))
 
End Function
 
Public Function CalculateBytes(ByteArray() As Byte) As Variant
 
  'Reset the current CRC calculation
  Call Clear
 
  'Calculate the CRC from the bytearray
  'and return the current CRC value
  CalculateBytes = AddBytes(ByteArray)
 
End Function
 
Public Function CalculateFile(Filename As String) As Variant
 
  Dim Filenr As Integer
  Dim ByteArray() As Byte
 
  'Make sure the file contains data
  'to avoid errors later below
  If (FileLen(Filename) = 0) Then Exit Function
 
  'Open the file in binary mode, read
  'the data into a bytearray and then
  'close the file
  Filenr = FreeFile
  Open Filename For Binary As #Filenr
  ReDim ByteArray(0 To LOF(Filenr) - 1)
  Get #Filenr, , ByteArray()
  Close #Filenr
 
  'Now send the bytearray to the function
  'that can calculate a CRC from it
  CalculateFile = CalculateBytes(ByteArray)
 
End Function
Public Function CalculateString(Text As String)
 
  'Convert the string into a bytearray
  'and send it to the function that
  'calculates the CRC from a bytearray
  CalculateString = CalculateBytes(StrConv(Text, vbFromUnicode))
 
End Function
Public Property Get Value() As Variant
 
    Value = (Not CRC32)
 
End Property
 
Public Property Let Value(New_Value As Variant)
 
    CRC32 = New_Value
 
End Property
 
Public Sub Clear()
 
  'Here can be sloppy and reset both
  'crc variables (this procedure will
  'be more advanced when adding more
  'checksums algorithms..)
'Create a bytearray to hold the
  'precompiled assembler code
  sASM = _
    "5589E557565053518B45088B008B750C8B7D108B4D1431DB8A1E30C3C1E80833049F46497" & _
    "F28B4D088901595B585E5F89EC5DC21000"
  ReDim CRC32Asm(0 To Len(sASM)  2 - 1)
  For i = 1 To Len(sASM) Step 2
    CRC32Asm(i  2) = Val("&H" & Mid$(sASM, i, 2))
  Next
 
End Sub
Private Sub Class_Initialize()
 
    InitializeCRC32
 
End Sub