CRC32 calculation benchmark

Form1.frm

Option Explicit

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Private Declare Function RtlComputeCrc32 Lib "ntdll" (ByVal dwInitial As Long, pData As Any, ByVal iLen As Long) As Long

Private Sub Form_Click()
    Const ITERS         As Long = 100000
    Dim baBuffer()      As Byte
    Dim lIdx            As Long
    Dim lACrc32         As Long
    Dim lBCrc32         As Long
    Dim lCCrc32         As Long
    Dim lDCrc32         As Long
    Dim dblTimer        As Double
    
    baBuffer = ReadBinaryFile("d:\temp\aaa.png")
    dblTimer = TimerEx
    For lIdx = 1 To ITERS
        lACrc32 = A_CRC32(baBuffer)
    Next
    Print "A_CRC32=" & Hex$(lACrc32) & ", Elapsed " & Format$((TimerEx - dblTimer) * 1000, "0.0") & " ms"
    DoEvents
    
    dblTimer = TimerEx
    For lIdx = 1 To ITERS
        lBCrc32 = B_CRC32(baBuffer)
    Next
    Print "B_CRC32=" & Hex$(lBCrc32) & ", Elapsed " & Format$((TimerEx - dblTimer) * 1000, "0.0") & " ms"
    DoEvents
    
    dblTimer = TimerEx
    With New cZipArchive
        For lIdx = 1 To ITERS
            lCCrc32 = .CalcCrc32Array(baBuffer)
        Next
    End With
    Print "C_CRC32=" & Hex$(lCCrc32) & ", Elapsed " & Format$((TimerEx - dblTimer) * 1000, "0.0") & " ms"
    DoEvents
    
    dblTimer = TimerEx
    For lIdx = 1 To ITERS
        lDCrc32 = RtlComputeCrc32(0, baBuffer(0), UBound(baBuffer) + 1)
    Next
    Print "D_CRC32=" & Hex$(lDCrc32) & ", Elapsed " & Format$((TimerEx - dblTimer) * 1000, "0.0") & " ms"
    DoEvents
End Sub

Public Function ReadBinaryFile(sFile As String) As Byte()
    With CreateObject("ADODB.Stream")
        .Open
        .Type = 1
        .LoadFromFile sFile
        ReadBinaryFile = .Read
    End With
End Function

Public Property Get TimerEx() As Double
    Dim cFreq           As Currency
    Dim cValue          As Currency
    
    Call QueryPerformanceFrequency(cFreq)
    Call QueryPerformanceCounter(cValue)
    TimerEx = cValue / cFreq
End Property

Module1.bas

Option Explicit

Dim Table(255) As Long
Dim RunOnce As Boolean
Dim TableReady As Boolean

Public Function A_CRC32(ByRef Data() As Byte) As Long
    Dim Remainder As Long
    Dim i As Long
    Dim j As Long
    
    If RunOnce = False Then 'Check if the table has already been generated.
        RunOnce = True
        For i = 0 To 255
            Remainder = i
            For j = 0 To 7
                If Remainder And 1 Then
                    Remainder = ShiftRight(Remainder) Xor &HEDB88320
                Else
                    Remainder = ShiftRight(Remainder)
                End If
            Next j
            Table(i) = Remainder
        Next i
        TableReady = True
    End If
    If TableReady = False Then Exit Function 'Check if table calculation has started, but not completed, on another thread.
    
    
    'Calculate A_CRC32 of data.
    A_CRC32 = &HFFFFFFFF
    For i = 0 To UBound(Data)
        A_CRC32 = ShiftRight8(A_CRC32) Xor Table((A_CRC32 And &HFF&) Xor Data(i))
    Next i
    A_CRC32 = Not A_CRC32
End Function


Private Function ShiftRight(ByVal Value As Long) As Long
    Dim TopBit As Boolean
    TopBit = Value And &H80000000
    ShiftRight = (Value And &H7FFFFFFF) \ 2
    If TopBit Then ShiftRight = ShiftRight Or &H40000000
End Function

Private Function ShiftRight8(ByVal Value As Long) As Long
    ShiftRight8 = ShiftRight(Value)
    ShiftRight8 = ShiftRight(ShiftRight8)
    ShiftRight8 = ShiftRight(ShiftRight8)
    ShiftRight8 = ShiftRight(ShiftRight8)
    ShiftRight8 = ShiftRight(ShiftRight8)
    ShiftRight8 = ShiftRight(ShiftRight8)
    ShiftRight8 = ShiftRight(ShiftRight8)
    ShiftRight8 = ShiftRight(ShiftRight8)
End Function

Module2.bas

Option Explicit

Dim Table(255) As Long
Dim RunOnce As Boolean
Dim TableReady As Boolean

Public Function B_CRC32(ByRef Data() As Byte) As Long
    Dim Remainder As Long
    Dim i As Long
    Dim j As Long
    
    If RunOnce = False Then 'Check if the table has already been generated.
        RunOnce = True
        For i = 0 To 255
            Remainder = i
            For j = 0 To 7
                If Remainder And 1 Then
                    Remainder = ShiftRight(Remainder) Xor &HEDB88320
                Else
                    Remainder = ShiftRight(Remainder)
                End If
            Next j
            Table(i) = Remainder
        Next i
        TableReady = True
    End If
    If TableReady = False Then Exit Function 'Check if table calculation has started, but not completed, on another thread.
    
    
    'Calculate B_CRC32 of data.
    B_CRC32 = &HFFFFFFFF
    For i = 0 To UBound(Data)
        B_CRC32 = ShiftRight8(B_CRC32) Xor Table((B_CRC32 And &HFF&) Xor Data(i))
    Next i
    B_CRC32 = Not B_CRC32
End Function


Private Function ShiftRight(ByVal Value As Long) As Long
    Dim TopBit As Boolean
    TopBit = Value And &H80000000
    ShiftRight = (Value And &H7FFFFFFF) \ 2
    If TopBit Then ShiftRight = ShiftRight Or &H40000000
End Function

Private Function ShiftRight8(ByVal Value As Long) As Long
    Dim TopBit As Boolean
    TopBit = Value And &H80000000
    ShiftRight8 = (Value And &H7FFFFFFF) \ 256
    If TopBit Then ShiftRight8 = ShiftRight8 Or &H800000
End Function