Skip to content

Instantly share code, notes, and snippets.

@wqweto
Last active Dec 10, 2019
Embed
What would you like to do?
CRC32 calculation benchmark
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
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
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment