Running speed test record: average time,Evaluation object
====================
use CbsPersist_20200521111942.log(161m),not 7z format
time(ms) TestObject
125.76 Crc32_Wqweto
281.03 Crc32ByAsm
326.17 Crc32Api
458.95 Crc32_LaVolpe
461.22 Crc32FromByte
====================
(USE 320M File,7z format)
----------------Advanced optimization：
249.41 Crc32_Wqweto
555.39 Crc32ByAsm
648.79 Crc32Api
905.41 Crc32_LaVolpe
906.42 Crc32FromByte
----------------Pentium Pro(Tm) optimization：
573.88 Crc32ByAsm UsedTime(Ms)
665.31 Crc32Api UsedTime(Ms)
737.25 Crc32FromByte UsedTime(Ms)
739.31 Crc32_LaVolpe UsedTime(Ms)
====================
Why is this forum picture compressed automatically? The total capacity of attachments uploaded at the same time is also pitiful？
Image may be NSFW.
Clik here to view.
method1:use api RtlComputeCrc32
method2:
METHOD3: GetCrcByASM.CLS
method 4:
====================
use CbsPersist_20200521111942.log(161m),not 7z format
time(ms) TestObject
125.76 Crc32_Wqweto
281.03 Crc32ByAsm
326.17 Crc32Api
458.95 Crc32_LaVolpe
461.22 Crc32FromByte
====================
(USE 320M File,7z format)
----------------Advanced optimization：
249.41 Crc32_Wqweto
555.39 Crc32ByAsm
648.79 Crc32Api
905.41 Crc32_LaVolpe
906.42 Crc32FromByte
----------------Pentium Pro(Tm) optimization：
573.88 Crc32ByAsm UsedTime(Ms)
665.31 Crc32Api UsedTime(Ms)
737.25 Crc32FromByte UsedTime(Ms)
739.31 Crc32_LaVolpe UsedTime(Ms)
====================
Why is this forum picture compressed automatically? The total capacity of attachments uploaded at the same time is also pitiful？
Image may be NSFW.
Clik here to view.
method1:use api RtlComputeCrc32
Code:
Private Declare Function RtlComputeCrc32 Lib "ntdll.dll" ( _
ByVal dwInitial As Long, _
ByVal pData As Long, _
ByVal iLen As Long) As Long
Public Function Crc32Api ( tBuff() As Byte) as long
Crc32Api = RtlComputeCrc32(0, VarPtr(tBuff(0)), UBound(tBuff) + 1)
End Function
Public Function GetStringCRC32(ByVal InString As String) As String
'123456789=CBF43926
Dim lRet As Long, tBuff() As Byte
tBuff = StrConv(InString, vbFromUnicode)
lRet = RtlComputeCrc32(0, VarPtr(tBuff(0)), UBound(tBuff) + 1)
GetStringCRC32 = Hex(lRet)
End FunctionCode:
'call InitCrc32 'First
Dim CRC32Table(255) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32 " (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32 " (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_ACP = 0 ' default to ANSI code page
Private Const CP_UTF8 = 65001 ' default to UTF-8 code page
'string to UTF8
Public Function EncodeToBytes(ByVal sData As String) As Byte() ' Note: Len(sData) > 0
Dim aRetn() As Byte
Dim nSize As Long
nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sData), -1, 0, 0, 0, 0) - 1
If nSize = 0 Then Exit Function
ReDim aRetn(0 To nSize - 1) As Byte
WideCharToMultiByte CP_UTF8, 0, StrPtr(sData), -1, VarPtr(aRetn(0)), nSize, 0, 0
EncodeToBytes = aRetn
Erase aRetn
End Function
Function Crc32FromByte(B() As Byte) As Long
Dim i As Long, iCRC As Long
iCRC = &HFFFFFFFF
For i = 0 To UBound(B)
iCRC = (((iCRC And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor CRC32Table((iCRC And &HFF) Xor B(i))
Next
Crc32FromByte = iCRC Xor &HFFFFFFFF
End Function
Function crc32byte(B() As Byte) As long
Dim i As Long, iCRC As Long, lngA As Long, ret As Long
dim bytT As Byte, bytC As Byte
iCRC = &HFFFFFFFF
For i = 0 To UBound(B)
bytC = B(i)
bytT = (iCRC And &HFF) Xor bytC
lngA = ((iCRC And &HFFFFFF00) \ &H100) And &HFFFFFF
iCRC = lngA Xor CRC32Table(bytT)
Next
ret = iCRC Xor &HFFFFFFFF
crc32byte =ret
End Function
'string's CRC32
Public Function crc32str(item As String) As String
Dim i As Long, iCRC As Long, lngA As Long, ret As Long
Dim B() As Byte, bytT As Byte, bytC As Byte
B = StrConv(item, vbFromUnicode)
iCRC = &HFFFFFFFF
For i = 0 To UBound(B)
bytC = B(i)
bytT = (iCRC And &HFF) Xor bytC
lngA = ((iCRC And &HFFFFFF00) \ &H100) And &HFFFFFF
iCRC = lngA Xor CRC32Table(bytT)
Next
ret = iCRC Xor &HFFFFFFFF
crc32str = Right("00000000" & Hex(ret), 8)
End Function
Public Function Crc32File(sFilePath As String, Optional Block As Long = 1024) As Long ' String
'改进后180M左右以上的文件更快了，超过GetFileCRC32_MapFile
Dim hFile As Long, i As Long, iCRC As Long, lngA As Long, Size As Long, ret As Long
Dim bytT As Byte, bytC As Byte
Dim sSize As Currency, total As Currency, Ub As Long
total = FileLen(sFilePath)
If total = 0 Then Exit Function 'Len(Dir(sFilePath))
If total < 0 Then total = total + 256 ^ 4
sSize = Block * 1024
hFile = FreeFile
Open sFilePath For Binary Access Read As #hFile
iCRC = &HFFFFFFFF
' Dim sSize2 As Long
' sSize2 = sSize + 1
'Dim sSizeX As Long
'sSizeX = sSize - 1
Ub = sSize - 1
ReDim B(Ub) As Byte
'sSize=8,sSizeX=7
While total >= sSize '>=8 '722-725
'While total > sSizeX '>7
'While total > sSize - 1 '慢去 '713-715
Get #hFile, , B
For i = 0 To Ub
bytC = B(i)
bytT = (iCRC And &HFF) Xor bytC
lngA = ((iCRC And &HFFFFFF00) \ &H100) And &HFFFFFF
iCRC = lngA Xor CRC32Table(bytT)
Next
total = total - sSize
Wend
If total > 0 Then '余下区块
Ub = total - 1
ReDim B(Ub) As Byte
Get #hFile, , B
For i = 0 To Ub
bytC = B(i)
bytT = (iCRC And &HFF) Xor bytC
lngA = ((iCRC And &HFFFFFF00) \ &H100) And &HFFFFFF
iCRC = lngA Xor CRC32Table(bytT)
Next
End If
Close #hFile
ret = iCRC Xor &HFFFFFFFF
Crc32File = ret
'Crc32File = Right("00000000" & Hex(ret), 8)
End Function
'CRC32 Table
Public Function InitCrc32(Optional ByVal Seed As Long = &HEDB88320, Optional ByVal Precondition As Long = &HFFFFFFFF) As Long
Dim i As Integer, j As Integer, CRC32 As Long, Temp As Long
For i = 0 To 255
CRC32 = i
For j = 0 To 7
Temp = ((CRC32 And &HFFFFFFFE) \ &H2) And &H7FFFFFFF
If (CRC32 And &H1) Then CRC32 = Temp Xor Seed Else CRC32 = Temp
Next
CRC32Table(i) = CRC32
Next
InitCrc32 = Precondition
End FunctionCode:
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
Private Declare Sub CpyMem4 Lib "msvbvm60.dll" Alias "GetMem4" (Source As Any, Destination As Any)
Dim ASMBL() As Byte
Dim Table(0 To 255) As Long
Function Crc32ByAsm(Data() As Byte) As Long
'0为下标的数组，原来函数名：ChecksumDataEx
Dim CRC32 As Long
CRC32 = &HFFFFFFFF
On Local Error GoTo ErrCB
CallWindowProc VarPtr(ASMBL(0)), VarPtr(CRC32), VarPtr(Data(0)), VarPtr(Table(0)), UBound(Data) + 1
ErrCB:
Crc32ByAsm = Not CRC32
End Function
Function ChecksumFileEx(Path As String) As Long
On Error GoTo ErrFC
Dim FreeF As Integer, Data() As Byte
FreeF = FreeFile
Open Path For Binary Access Read As #FreeF
ReDim Data(0 To LOF(FreeF) - 1) As Byte
Get #FreeF, , Data
Close #FreeF
ChecksumFileEx = Crc32ByAsm(Data)
ErrFC:
End Function
Function ChecksumFile(Path As String) As String
ChecksumFile = Hex(ChecksumFileEx(Path))
End Function
Function ChecksumTextEx(Text As String) As Long
If Len(Text) = 0 Then Exit Function
ChecksumTextEx = Crc32ByAsm(StrConv(Text, vbFromUnicode))
End Function
Function ChecksumText(Text As String) As String
ChecksumText = Hex(ChecksumTextEx(Text))
End Function
Function Crc32ByAsm2(Data() As Byte) As Long '非0下标
Dim CRC32 As Long
CRC32 = &HFFFFFFFF 'CRC32 初始值(必须)
On Local Error GoTo ErrCB
Dim DLen As Long
DLen = UBound(Data) - LBound(Data) + 1
CallWindowProc VarPtr(ASMBL(0)), VarPtr(CRC32), VarPtr(Data(LBound(Data))), VarPtr(Table(0)), DLen
ErrCB:
Crc32ByAsm2 = Not CRC32
End Function
Function ChecksumData(Data() As Byte) As String
ChecksumData = Hex(Crc32ByAsm(Data))
End Function
Function LngToBin(ipLong As Long) As Byte()
Dim tB() As Byte
ReDim tB(1 To 4)
CpyMem4 ipLong, tB(1)
LngToBin = tB
End Function
Function BinToLng(ipBin4() As Byte) As Long
CpyMem4 ipBin4(LBound(ipBin4)), BinToLng
End Function
Sub IntAsm()
Dim i As Long, j As Long
Const ASM As String = "5589E557565053518B45088B008B750C8B7D108B4D1431DB8A1E30C3C1E80833049F464975F28B4D088901595B585E5F89EC5DC21000"
' Decoded ASM source from HIEW 6.86 (Hacker's View)
'
' 55 PUSH BP
' 89E5 MOV BP,SP
' 57 PUSH DI
' 56 PUSH SI
' 50 PUSH AX
' 53 PUSH BX
' 51 PUSH CX
' 8B4508 MOV AX,DI[08]
' 8B00 MOV AX,BX[SI]
' 8B750C MOV SI,DI[0C]
' 8B7D10 MOV DI,DI[10]
' 8B4D14 MOV CX,DI[14]
' 31DB XOR BX,BX
' 8A1E30C3 MOV BL,0C330
' C1E808 SHR AX,008 <-.
' 3304 XOR AX,[SI] |
' 9F LAHF |
' 46 INC SI |
' 49 DEC CX |
' 75F2 JNE 000000018 -'
' 8B4D08 MOV CX,DI[08]
' 8901 MOV BX[DI],AX
' 59 POP CX
' 5B POP BX
' 58 POP AX
' 5E POP SI
' 5F POP DI
' 89EC MOV SP,BP
' 5D POP BP
' C21000 RETN 00010
ReDim ASMBL(0 To 53) 'Len(ASM) \ 2 - 1
For i = 1 To Len(ASM) - 1 Step 2
ASMBL(j) = Val("&H" & Mid(ASM, i, 2))
j = j + 1
Next i
Dim vCRC32 As Long, vB As Boolean
Const vXor32 As Long = &HEDB88320
For i = 0 To 255
vCRC32 = i
For j = 8 To 1 Step -1
vB = vCRC32 And 1
vCRC32 = ((vCRC32 And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
If vB Then vCRC32 = vCRC32 Xor vXor32
Next j
Table(i) = vCRC32
Next i
End Sub
Private Sub Class_Initialize()
IntAsm
End SubCode:
Function Crc32_LaVolpe(Buffer() As Byte) As Long
Dim crc32val As Long, i As Long
crc32val = &HFFFFFFFF
For i = 0 To UBound(Buffer)
crc32val = (((crc32val And &HFFFFFF00) \ &H100&) And &HFFFFFF) Xor CRC32Table((crc32val And &HFF) Xor Buffer(i))
Next i
Crc32_LaVolpe = crc32val Xor &HFFFFFFFF
End Function