dcsimg
Results 1 to 33 of 33

Thread: vb Fast Crc32 (crc32str,Crc32File)

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    vb Fast Crc32 (crc32str,Crc32File)

    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?
    Name:  FunctionSpeedTesting.jpg
Views: 70
Size:  47.6 KB
    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 Function
    method2:
    Code:
    '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 Function
    METHOD3: GetCrcByASM.CLS
    Code:
    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 Sub
    method 4:
    Code:
    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
    Last edited by xiaoyao; May 23rd, 2020 at 09:17 AM.

  2. #2
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    18,993

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Few things for your consideration...

    1. Don't really see any logic change that would indicate a speed improvement over other routines. For example, this is a loop I use that is nearly identical to yours. Since the CRC32 algorithm is fairly set in stone, any speed improvements would be getting the data into the array faster or reading from disk more efficiently.
    Code:
        crc32val = &HFFFFFFFF
        For i = StartPos To StartPos + CRCLen - 1&
            iLookup = (crc32val And &HFF) Xor theArray(i)
            crc32val = (((crc32val And &HFFFFFF00) \ &H100&) And &HFFFFFF) Xor CRC32LUT(iLookup)
        Next i
    2. Strings can be done faster. There is no need to create a separate array from a passed string, i.e., StrConv is not needed. With the use of APIs, we can overlay an array structure onto the string. That does not copy the data as StrConv does.

    3. Regarding CRC on files & strings, there is no unicode support. Many CRC routines offer unicode support, i.e., CRC unicode text.

    4. Returning a hex string seems odd. Most people that need a CRC value want it as a numeric value. That means that 99.9% of the people that would use your code would then need to convert the returned hex string to a numeric value.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  3. #3
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,882

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by LaVolpe View Post
    3. Regarding CRC on files & strings, there is no unicode support. Many CRC routines offer unicode support, i.e., CRC unicode text.
    Any Hashing-Routine (be that CRC32, CRC64, MD5, SHA1, a.s.o.) should only accept ByteArrays as Input.
    This way the responsibility for "passing the right byte-content" into the hash-routine, would be shifted to the Caller of that function
    (who can then decide himself, whether he will convert his Strings in an extra-line into ByteArrays in their UTF8/UTF16 or ANSI -representation).

    Quote Originally Posted by LaVolpe View Post
    4. Returning a hex string seems odd. Most people that need a CRC value want it as a numeric value.
    ACK - in case of a CRC32 - a returned Long-Value would be "short, proper and unambigous"
    (and easy to convert via VBs Hex-Function).

    For longer Hashes (MD5, SHA1), I usually return the Hash-Result in ByteArrays as well
    (or alternatively as a Hex-String, when an optional Param was set appropriately).

    Olaf

  4. #4
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    18,993

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by Schmidt View Post
    Any Hashing-Routine (be that CRC32, CRC64, MD5, SHA1, a.s.o.) should only accept ByteArrays as Input.
    This way the responsibility for "passing the right byte-content" into the hash-routine, would be shifted to the Caller of that function
    No problem there. But looking at the code in post #1, how does one pass a unicode string to the crc32str function and return a CRC on all bytes? You can't unless that function takes an array. However, if wanting a string vs. array parameter, a simple tweak would allow the user to dictate whether the passed string should be unicode or ANSI by passing an optional boolean parameter. Then that code can loop through the string data Step 1 (unicode) or Step 2 (ANSI) if using an array overlay. Otherwise can use B() = String for unicode & B() = StrConv() for ANSI.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  5. #5

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Code:
    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

  6. #6
    Frenzied Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    1,974

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Or this

    Code:
    Function crc32byte2(B() As Byte) As Long
        Dim i As Long
        Dim 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
        crc32byte2 = iCRC Xor &HFFFFFFFF
    End Function
    cheers,
    </wqw>

  7. #7

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by wqweto View Post
    Or this

    Code:
    Function crc32byte2(B() As Byte) As Long
        Dim i As Long
        Dim 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
        crc32byte2 = iCRC Xor &HFFFFFFFF
    End Function
    cheers,
    </wqw>
    thank you

  8. #8

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    TestObject UsedTime(Ms)
    ChecksumDataEx UsedTime(Ms) 568.80
    Crc32Api UsedTime(Ms) 660.31
    Crc32FromByte UsedTime(Ms) 937.35
    Crc32FromByte2 UsedTime(Ms) 940.08
    Crc32_LaVolpe UsedTime(Ms) 941.35

  9. #9
    PowerPoster
    Join Date
    Feb 2006
    Posts
    20,957

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Accepting a String is about as goofy as returning a hex String.

    Including the conversion from Unicode to ANSI within the function is just strange. If it made sense in a particular program then I'd name it something like "CrcOfAnsiOfString" instead.

    However if you want that you probably need the text encoded in ANSI anyway, so just do it once and then use the ANSI encoding. For example:

    • Convert to ANSI in a Byte array.
    • Transmit the Byte array.
    • Transmit Crc(Byte array), where the Crc() function returns a Byte array 4 bytes in length, in network byte order.


    Don't return a Long value, because even when receiving you'll need network byte order to do the comparison with the received CRC.

  10. #10
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    18,993

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Any timings you provide are not really useful unless the application is compiled.

    P.S. Using ASM in a local array will trigger DEP on many systems. That option should not be used in deployed applications unless the users have the ability to disable DEP on their systems.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  11. #11

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    TestObject UsedTime(Ms)
    Crc32ByAsm UsedTime(Ms) 573.88
    Crc32Api UsedTime(Ms) 665.31
    Crc32FromByte UsedTime(Ms) 737.25
    Crc32_LaVolpe UsedTime(Ms) 739.31

  12. #12
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    18,993

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Out of curiosity, what is Crc32_LaVolpe? I did not provide any CRC routine.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  13. #13
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,882

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by xiaoyao View Post
    TestObject UsedTime(Ms)
    Crc32ByAsm UsedTime(Ms) 573.88
    Crc32Api UsedTime(Ms) 665.31
    Crc32FromByte UsedTime(Ms) 737.25
    Crc32_LaVolpe UsedTime(Ms) 739.31
    And that's still not showing the optimum the VB6-native-compiler can achieve,
    unless you've checked all the extended Compiler-Options...

    Olaf

  14. #14

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    bbs post reply #2
    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

  15. #15

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by Schmidt View Post
    And that's still not showing the optimum the VB6-native-compiler can achieve,
    unless you've checked all the extended Compiler-Options...

    Olaf
    Compiler-Options ... for cpu(Pentium Pro(Tm)---select

  16. #16
    Frenzied Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    1,974

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Can you try this one too:

    Code:
    Function Crc32_Wqweto(Buffer() As Byte) As Long
        Static oZip As New cZipArchive
        Crc32_Wqweto = oZip.CalcCrc32Array(Buffer)
    End Function
    You'll need the cZipArchive class to run it though.

    Also note that second run will be faster (amortized initialization).

    cheers,
    </wqw>

  17. #17
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,882

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by xiaoyao View Post
    Compiler-Options ... for cpu(Pentium Pro(Tm)---select
    No, I mean these Check-Options here (it's a german-localized IDE-ScreenShot, but you'll get the idea):


    HTH

    Olaf

  18. #18

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    https://github.com/wqweto/VbAsyncSocket
    do you have websocket.cls?ws,wss?

  19. #19

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Oh my god, a miracle happened, incredible!

    (USE 320M File,7z format)
    Evaluation object, average time
    ----------------Advanced optimization:
    249.41 Crc32_Wqweto
    555.39 Crc32ByAsm
    648.79 Crc32Api

    905.41 Crc32_LaVolpe
    906.42 Crc32FromByte

  20. #20

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    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

  21. #21

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Why is this so fast, the speed has doubled, can anyone explain?
    320M Size File
    test times:10 TestObject
    255.62 Crc32_cZipArc
    573.29 Crc32ByAsm
    664.54 Crc32Api
    936.84 Crc32FromByte
    -------------
    161M file
    test times:30 TestObject
    126.30 cZipArc_SubDim
    284.13 Crc32ByAsm
    329.44 Crc32Api
    464.69 Crc32FromByte
    ---------------
    EasyCrc.cls from cZipArchive.cls
    Code:
    Public m_lCurrentFile          As Long  'no need
    Private m_uRtbl                 As UcsZlibRelocTableType
    
    Private Const STR_THUNK1 As String = _
        "UYtEJAhTi1wkEFWLbCQYVleLeEQD64tEJCSJbCQQiwD2wwN0HDvddBQPthNDD7bIM9HB6AgzBJf2wwN16IlcJByL1cdEJBgAAAAAK9OD4vyNDBqDwgPB6gI7yxvJ99EjyolMJCB0eYvpjaQkAAAAAIsbi8vB6QgPtvGLyMHpCA+2yTPxi8vB6RAPttGLyMHpEIu0twAIAAAPtskz0YvIwekYM7SXAAQAAIvTweoYM9EPtsgPtsOLXCQcM8iDwwQzNJeJXCQcM7SPAAwAAItMJBiLxkGJTCQYO811lItsJBCLzTP2K8s76xvt99Uj6XQWD7YTjVsBD7bIRjPRwegIMwSXO/V16otMJCRfXl2JAVtZwhAAzMzMzMzMzMzMzMzMVot0JBCF9n41i1QkDE6LRCQIwe4ERoMCAYsKdQP/QgSJCItKBIlIBMdACAAAAADHQAwAAAAAg8AQg+4BddhewhAAzMzMzMzMzMzMzMzMzMyLVCQMhdJ0GotEJAhWi3Qk" & _
        "CCvwigwGjUABMEj/g+oBdfJewhAAzMzMzMzMzMzMzMyDfCQMAItEJASLSAyJTCQED46OAAAAU1VWi3QkFFeLfCQgi++D5QGD5wKNmwAAAACKHoXtdBWLSAiDyQKL0YPyAQ+v0cHqCDLTiBaF/3QCih4PthBGD7bLi1wkFDPRiwjB6QiLFJOLWAgz0Q+2ygNIBGnJBYQICIkQD7bTwesIQYlIBA+2SAcz0YtMJBQzHJGLTCQcSYlYCIlMJByFyX+QX15dW8IQAMzMzMzMzMzMzFaLdCQIV2oMi0Yo/9CL+FeJN+gJCQAAi04oahT/0cdAEAAAAADHQAwAAAAAiUcIi8dfXsIQAMzMzMzMzMzMzMxWi3QkCFeLPv92CItHMP/Q/3YEi0cw/9CLRzBW/9BfXsIQAMzMzMzMzMzMzMzMzMyLRCQMVot0JAxXi3wkDIXAdA1Q/3YE/zb/N+gh/f///3YcjUYM/3YY/3YU/3YQUI1GCFD/dgT/NlfoIgkAAF9e" & _
        "whAAzMzMzMzMzMzMzMzMzP90JATo5w8AAMIQAMzMzMxWi3QkCItODI1GDFeLPoXJdAw7TgR0B1BW6IIRAACLThCNRhCFyXQMO04IdAdQVuhsEQAAg34UAI1GFHQHUFboXBEAAI1GBFBW6FIRAACNRghQVuhIEQAAi0cwVv/QX17CEADMzMzMzMzMzMzMzMzMi0QkCFNVi2wkDFZXjVgMU414CFf/cAT/MFXoIQkAAItMJByL8IXJdBiF9nQUiweFwHQMUf8zUP91AOgx/P//i8ZfXl1bwhAAzMzMzMzMzMxWi3QkCIPK/4uGBIAEAA+3TMYCjQTGZjvKdAkPv8FmiRTG6xCLQASD+P90CGaJlEYIgAQAi4YEgAQAi0wkEIlMxgSLhgSABABmiVTGAo0UTouOBIAEAA+3ggiABABmiQTOi4YEgAQAD78Mxg+3wGaJggiABACD+f90DGaLhgSABABmiUTOAouOBIAEAIpEJAyIhA4AAAQAi4YEgAQAQCX/" & _
        "fwAAiYYEgAQAXsIMAMzMzIPsDFNVi2wkIFZXi3wkIDP2i38EiXwkGDm3DIAGAA+O4gAAAIuPDIAGAIvBK8YDxYP4BA+MnAAAAItUJCQ78X0KD7aEPgiABgDrCIvGK8EPtgQQjV4CiEQkFI1D/zvBfQoPtoQ+CYAGAOsJi8YrwQ+2RBABiEQkFTvZfQoPtoQ+CoAGAOsJi8YrwQ+2RBACiEQkFo1DATvBfQoPtoQ+C4AGAOsJi8YrwQ+2RBADiEQkF4tEJBRpyL2nNR7B6RBRUFfoiv7//0Y7twyABgAPjFH////rMYvOO7cMgAYAfSeNlwiABgDrCY2kJAAAAACL/4qEDwiABgCNUgGIQv9BO48MgAYAfOoptwyABgCF7Q+O9QEAAOsKjaQkAAAAAI1JAItcJCSD/QQPjFkBAACLhwAABAAz7YmHAIAEAGkDvac1HsHoEA+/lEcIgAQAg/r/D4QxAQAAi48EgAQAi8Irwb4AgAAAJf9/AAAr8CvOgeH/" & _
        "fwAAi4Q5AAAEADsDdQ6JtK8QgAYARTtsJCx9CQ+/FNeD+v91wIXtD47pAAAAi0QkKDlEJDB+BolEJDDrBItEJDC+BAAAADvGfnGNmwAAAACKBB4zyTPbiEQkE4XtfliQi5SPEIAGAIvGK8J5GIuHBIAEACvCA8Yl/38AAIqEOAAABADrC4t8JCSKBDiLfCQYOEQkE3UIiZSfEIAGAENBO818vYP7AX4Pi0QkMEaL64tcJCQ78HyZi1wkJItsJCg79X09i5cQgAYAi84ryo0sGoXJeRiLhwSABAArwgPGJf9/AACKhDgAAAQA6wOKBBk4BCl1CEZBO3QkKHzUi2wkKFb/txCABgD/dCQo6KAOAACF9n596ziLTCQgigM8j4sRi3EID7bIi0I8dwkPtkQIMGoI6w0PtgQIagmNBEUBAAAAUFZS6EcSAAC+AQAAAItsJCiD/QR8FmkDvac1HsHoEFAPtgNQV+h1/P//6xWLjwyABgCKA4iEDwiABgD/hwyA" & _
        "BgBOQ02F9n/JiWwkKIlcJCSF7Q+PF/7//19eXVuDxAzCFADMzMzMzMzMzMzMzMzMg+wUU1WLbCQoVleLfCQoM/aLfwSJfCQgObcMgAYAD47iAAAAi48MgAYAi8ErxgPFg/gED4ycAAAAi1QkLDvxfQoPtoQ+CIAGAOsIi8YrwQ+2BBCNXgKIRCQYjUP/O8F9Cg+2hD4JgAYA6wmLxivBD7ZEEAGIRCQZO9l9Cg+2hD4KgAYA6wmLxivBD7ZEEAKIRCQajUMBO8F9Cg+2hD4LgAYA6wmLxivBD7ZEEAOIRCQbi0QkGGnIvac1HsHpEFFQV+hq+///Rju3DIAGAA+MUf///+sxi847twyABgB9J42XCIAGAOsJjaQkAAAAAIv/ioQPCIAGAI1SAYhC/0E7jwyABgB86im3DIAGADPAM8mJRCQUiUwkGIlEJByF7Q+OCQIAAOsKjaQkAAAAAI1JAItcJCyD/QQPjMABAACLhwAABAAz7YmHAIAEAGkDvac1" & _
        "HsHoEA+/lEcIgAQAg/r/D4SYAQAAi48EgAQAi8Irwb4AgAAAJf9/AAAr8CvOgeH/fwAAi4Q5AAAEADsDdQ6JtK8QgAYARTtsJDR9CQ+/FNeD+v91wIXtD45MAQAAi1QkMItEJDg7wn4Gi8KJRCQ4vgQAAAA7xn53igQeM8kz24hEJBOF7X5g6weNpCQAAAAAi5SPEIAGAIvGK8J5GIuHBIAEACvCA8Yl/38AAIqEOAAABADrC4t8JCyKBDiLfCQgOEQkE3UIiZSfEIAGAENBO818vYP7AX4Pi0QkOEaL64tcJCw78HyRi1wkLItUJDA78n05i5cQgAYAi84ryo0sGoXJeRiLhwSABAArwgPGJf9/AACKhDgAAAQA6wOKBBk4BCl1CEZBO3QkMHzUi2wkFIXtfl6NRQE78H5Pi0QkKIsQi2gIi0QkHDyPD7bIi0I8dwkPtkQIMGoI6w0PtgQIagmNBEUBAAAAUFVS6CAPAAAPtgOLjxCABgCJTCQYiXQk" & _
        "FIlEJBzpkAAAAItEJBhVUOsli4cQgAYAiUQkGA+2A4l0JBSJRCQc63GLTCQYi2wkFIXtfjJVUf90JDDo8AoAADPAjXX/iUQkFIX2f1KLbCQwi0wkGIXtD48D/v//X15dW4PEFMIUAItMJCiKAzyPixGLcQgPtsiLQjx3CQ+2RAgwagjrDQ+2BAhqCY0ERQEAAABQVlLodg4AAL4BAAAAi2wkMIP9BHwWaQO9pzUewegQUA+2A1BX6KT4///rFYuPDIAGAIoDiIQPCIAGAP+HDIAGAE5DTYX2f8mJbCQwiVwkLOlq////zMzMzMzMzMzMVleLfCQMaLCPBgCLB4tAKP/Qi/CF9nUFX17CBACJdwSNTgK6AIAAAIPI/+sDjUkAx0EC/////41JCGaJQfhmiUH2g+oBdemNvgiABAC5AIAAAPOrX4mWBIAEAI1CAYmWDIAGAF7CBADMzMzMzMzMzFZXi3wkDLkSAAAAvgBQ51W4kCnnVfOli0wkEIPAYF9e" & _
        "xwEAEOdViUEEx0EIoEDnVcdBDHhE51XCCADMzMzMzMxTi1wkCFZXaACAAACLO4tzCItHKP/QiQYzwDlEJCRqAw+VwMdGCACAAACDwALHRgQAAAAAUFZX6DQNAACDfCQoAP90JDD/dCQw/3QkIP90JCBTdAfoF/j//+sF6DD7//9qB2oAVlfoBQ0AAIN8JCQAdBiLThCFyXQRuAgAAAArwVBqAFZX6OYMAACLRCQciw5fiQiLRCQci04EXluJCLgBAAAAwiQAzMzMzMzMzMzMzFFTVVaLdCQUV2gAgAAAix6JXCQci0Mo/9CLbCQgiYakgQAAx4asgQAAAIAAAMeGqIEAAAAAAACF7X8Ng76cAQAAAA+OtgUAAIO+nAEAABiNvpwBAAB9KotUJBzrA41JAIXtfhkPtgJNiw9C0+AJhpgBAACNQQiJB4P4GHzjiVQkHItGGIXAdQnHRhgBAAAA66aD+AF1c4sXg/oDD4xdBQAAi4aYAQAAg8L90eiLyIkX" & _
        "wegCiYaYAQAAg+EDdR2LysdGGAoAAACD4Qcr0dPoiReJhpgBAADpXP///4P5AXUYi0YEiUYMi0YIiUYQx0YYBgAAAOk/////g/kCD4U2////iU4Y6S7///+D+AJ1bosXg/oOD4zlBAAAi46YAQAAi8GD4B/B6QUFAQEAAMdGLAAAAACJRiCLwYPgH8HpBUDHRhgDAAAAiUYki8GD4A/B6QSDwASJjpgBAACJRiiNQvKJBzPAiUZEiUZIiUZMiUZQZolGVIhGVum7/v//g/gDdW85Bw+MdQQAAItGLDtGKH0xgz8DfCyLS0CLRiyKlpgBAACA4gcPtgQBiFQwRP9GLItGLIMH/cGumAEAAAM7Rih8z4tGLDtGKA+Faf7//2oTjUZEUFboxgkAAIlGFMdGGAQAAADHRiwAAAAA6Uf+//+D+AQPheIAAACLRiSLTiADwTlGLHw/UY1GV1BW6I8JAAD/diSJRgyLRiCDwFcDxlBW6HoJAACNfhSJRhBXVui9"
    
    Private Const STR_THUNK_OFFSETS As String = "592|656|704|784|800|912|0|288|368|416|0|0|0|6896|7264|6640|7244"
    Private Const STR_THUNK_BUILDDATE As String = "12.1.2018 17:15:52"    '非必须
    Private Const PAGE_EXECUTE_READWRITE        As Long = &H40
    Private Const MEM_COMMIT                     As Long = &H1000
    Private Const CRYPT_STRING_BASE64           As Long = 1
    
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
    Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, Optional ByVal Msg As Long, Optional ByVal wParam As Long, Optional ByVal lParam As Long) As Long
    Private Declare Function GetEnvironmentVariable Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Declare Function SetEnvironmentVariable Lib "kernel32" Alias "SetEnvironmentVariableA" (ByVal lpName As String, ByVal lpValue As String) As Long
    Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
    Private Declare Function CryptStringToBinary Lib "crypt32" Alias "CryptStringToBinaryW" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByRef pcbBinary As Long, ByRef pdwSkip As Long, ByRef pdwFlags As Long) As Long
    '
    Private Type UcsZlibRelocTableType
        CompressInit        As Long
        CompressCleanup     As Long
        CompressBlock       As Long
        DecompressInit      As Long
        DecompressCleanup   As Long
        DecompressBlock     As Long
        CalcCrc32           As Long
        MemNonce            As Long
        MemXor              As Long
        ZipCrypt            As Long
        MallocImpl          As Long
        ReallocImpl         As Long
        FreeImpl            As Long
        LenCodes            As Long
        DistCodes           As Long
        MirrorBytes         As Long
        LenLenMap           As Long
        Crc32Table          As Long
    End Type
    '
    Private Enum UcsRelocIndexesEnum
        ucsIdx_CompressInit = 0
        ucsIdx_CompressCleanup
        ucsIdx_CompressBlock
        ucsIdx_DecompressInit
        ucsIdx_DecompressCleanup
        ucsIdx_DecompressBlock
        ucsIdx_CalcCrc32
        ucsIdx_MemNonce
        ucsIdx_MemXor
        ucsIdx_ZipCrypt
        ucsIdx_MallocImpl
        ucsIdx_ReallocImpl
        ucsIdx_FreeImpl
        ucsIdx_LenCodes
        ucsIdx_DistCodes
        ucsIdx_MirrorBytes
        ucsIdx_LenLenMap
    End Enum
    
    Private Sub Class_Initialize()
        pvInitRelocTable m_uRtbl
        m_lCurrentFile = -1
    End Sub
    Public Function CalcCrc32Array(baData() As Byte) As Long
        CalcCrc32Array = -1
        Call CallWindowProc(m_uRtbl.CalcCrc32, VarPtr(m_uRtbl), VarPtr(baData(0)), UBound(baData) + 1, VarPtr(CalcCrc32Array))
        CalcCrc32Array = CalcCrc32Array Xor -1
    End Function
    
    Public Sub CalcCrc32Ptr(ByVal lPtr As Long, ByVal lSize As Long, lCrc32 As Long)
        Call CallWindowProc(m_uRtbl.CalcCrc32, VarPtr(m_uRtbl), lPtr, lSize, VarPtr(lCrc32))
    End Sub
     
    Private Function pvInitRelocTable(uRtbl As UcsZlibRelocTableType) As Long
        Dim lpThunk         As Long
        Dim vSplit          As Variant
    
        lpThunk = pvGetThunkAddress()
        vSplit = Split(STR_THUNK_OFFSETS, "|")
        With uRtbl
    
            .CalcCrc32 = lpThunk + vSplit(ucsIdx_CalcCrc32)
    
            .Crc32Table = pvGetCrc32Table()
        End With
    End Function
    '
    Private Function pvGetThunkAddress() As Long
        Static lpThunk      As Long
        Dim baThunk()       As Byte
        Dim sBuffer         As String
    
        If lpThunk = 0 Then
            sBuffer = String$(50, 0)
            Call GetEnvironmentVariable("_ZIP_THUNK_" & GetCurrentProcessId() & "_" & STR_THUNK_BUILDDATE, sBuffer, Len(sBuffer) - 1)
            lpThunk = Val(sBuffer)
            If lpThunk = 0 Then
                baThunk = FromBase64Array(STR_THUNK1)
                lpThunk = VirtualAlloc(0, UBound(baThunk) + 1, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
                Call CopyMemory(ByVal lpThunk, baThunk(0), UBound(baThunk) + 1)
                Call SetEnvironmentVariable("_ZIP_THUNK_" & GetCurrentProcessId() & "_" & STR_THUNK_BUILDDATE, lpThunk)
            End If
        End If
        pvGetThunkAddress = lpThunk
    End Function
    
    Private Function pvGetCrc32Table() As Long
        Static aTable()     As Long
        Static bIsInit      As Boolean
        Dim lIdx            As Long
        Dim lJdx            As Long
        Dim lReminder       As Long
        Dim lValue          As Long
    
        If Not bIsInit Then
            '--- table mem allocated: 4KB
            ReDim aTable(0 To &H3FF) As Long
            For lIdx = 0 To &H3FF
                If lIdx < &H100 Then
                    lReminder = 0
                    lValue = lIdx
                Else
                    lReminder = aTable(lIdx - &H100)
                    lValue = 0
                End If
                For lJdx = 1 To 8
                    If ((lReminder Xor lValue) And 1) <> 0 Then
                      lReminder = (lReminder And &HFFFFFFFE) \ 2 And &H7FFFFFFF Xor &HEDB88320
                    Else
                      lReminder = (lReminder And &HFFFFFFFE) \ 2 And &H7FFFFFFF
                    End If
                    lValue = (lValue And &HFFFFFFFE) \ 2 And &H7FFFFFFF
                Next
                aTable(lIdx) = lReminder
            Next
            bIsInit = True
        End If
        pvGetCrc32Table = VarPtr(aTable(0))
    End Function
      
    Private Function FromBase64Array(sText As String) As Byte()
        Dim lSize           As Long
        Dim dwDummy         As Long
        Dim baOutput()      As Byte
    
        Call CryptStringToBinary(StrPtr(sText), Len(sText), CRYPT_STRING_BASE64, 0, lSize, 0, dwDummy)
        ReDim baOutput(0 To lSize - 1) As Byte
        Call CryptStringToBinary(StrPtr(sText), Len(sText), CRYPT_STRING_BASE64, VarPtr(baOutput(0)), lSize, 0, dwDummy)
        FromBase64Array = baOutput
    End Function
    Last edited by xiaoyao; May 22nd, 2020 at 10:35 PM.

  22. #22
    Frenzied Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    1,974

    Re: vb Fast Crc32 (crc32str,Crc32File)

    https://github.com/wqweto/ZipArchive....c#L1511-L1543

    It's processing 4-bytes in a single step. You can write it in VB6 and get comparable speed. Just have to use 16x bigger lookup table (~4KB).

    You can even experiment with crc32_slice8 from libdeflate for 8-bytes in a single step algorithm.

    cheers,
    </wqw>

  23. #23

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    why Rc5cCollection remove items slowly?
    The dictionary algorithm was wrongly restored to CRC32, fainted

    TestObject usedtime(ms)
    cHashD_add 743.86
    cHashD_Read 2790.86
    cHashD_remove 60.76
    Dictionary2_add 17156.78
    Dictionary2_Read 6353.52
    Dictionary2_remove 643.06
    MsDictionary_add 41987.04
    MsDictionary_Read 40559.94
    MsDictionary_remove 4828.38
    Rc5cCollection#add 1435.34
    Rc5cCollection#Read 928.89
    Rc5cCollection#remove 8288.76
    TrickHashTable_add 27521.39
    TrickHashTable_Read 27180.05
    TrickHashTable_remove 8595.08

    Attachment 177215
    Last edited by xiaoyao; May 23rd, 2020 at 09:14 AM.

  24. #24

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by wqweto View Post
    https://github.com/wqweto/ZipArchive....c#L1511-L1543
    It's processing 4-bytes in a single step. You can write it in VB6 and get comparable speed. Just have to use 16x bigger lookup table (~4KB).
    You can even experiment with crc32_slice8 from libdeflate for 8-bytes in a single step algorithm.
    cheers,</wqw>
    Can you write an algorithm for the 8-bit look-up table method? thank you very much!

    I don't have this ability yet, you look at me high, haha.
    For the CRC algorithm, the research time is too long, it seems a bit obsessive-compulsive disorder, like crazy.
    However, because of this test, I built a complete test system (algorithm name "multiple function implementation" test plan "test records, and then generated visual reports such as line charts and column charts.
    It's very interesting. In fact, the speed of functions, functions, number of lines of code, and readability are all important. Conscientious, focused, optimized, and try to be better.
    Of course, sometimes there is no need to spend too much time, otherwise it will become a horn.
    Maybe the CRC32 algorithm is rarely used. Dictionaries, collections, MD5, and BASE64 are probably the most used.
    Sincerely ask, I want to make an automatic file backup tool. I need to check whether the entire hard disk file has been modified many times a day. What algorithm is the fastest? HASH? MD5? CRC32?

  25. #25
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,882

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by xiaoyao View Post
    why Rc5cCollection remove items slowly?
    Not sure, what exactly you are testing (because you never include any of your testcode).

    I certainly cannot reproduce that here (in a test with 100Tsd Key/Items-Pairs):



    The RC5.cCollection (in the same way as the RC5.cSortedDictionary ... and also cHashD for that matter),
    was designed to behave "well-balanced in any discipline", so the outlier in Remove-Performance shouldn't happen,
    unless you try to stuff Millions of entries into that container (it normally behaves well, up to about 300Tsd entries).


    Here is my test-code which produced the above results:
    Code:
    Option Explicit
    
    Private Declare Function QueryPerformanceFrequency& Lib "kernel32" (x@)
    Private Declare Function QueryPerformanceCounter& Lib "kernel32" (x@)
     
    Private Sub Form_Click()
      AutoRedraw = True: Cls
      Const Count As Long = 100000
      If App.LogMode = 0 Then Print "Please compile natively, to compare the results!": Exit Sub
      
      '-------------------- Scripting-Dictionary -----------------------
      Dim SD As Scripting.Dictionary, i As Long, T@
      Set SD = New Scripting.Dictionary
      
      T = msTimer
        For i = 1 To Count: SD.Add "Key " & i, i: Next
      Print "MSDict-AddItems", msTimer - T, SD.Count
      
      T = msTimer
        For i = 1 To Count: i = SD.Item("Key " & i): Next
      Print "MSDict-KeyAcc", msTimer - T, SD.Count
      
      T = msTimer
        For i = 1 To Count Step 2: SD.Remove "Key " & i: Next
      Print "MSDict-Remove", msTimer - T, SD.Count
      
      T = msTimer
        For i = 1 To Count Step 2: SD.Add "Key " & i, i: Next
      Print "MSDict-ReAdd", msTimer - T, SD.Count
      
      Print
      
      '-------------------- RC5.cCollection -----------------------
      Dim CC As cCollection
      Set CC = New_c.Collection(False, BinaryCompare, False)
     
      T = msTimer
        For i = 1 To Count: CC.Add i, "Key " & i: Next
      Print "RC5.cColl-AddItems", msTimer - T, CC.Count
      
      T = msTimer
        For i = 1 To Count: i = CC.Item("Key " & i): Next
      Print "RC5.cColl-KeyAcc", msTimer - T, CC.Count
      
      T = msTimer
        For i = 1 To Count Step 2: CC.Remove "Key " & i: Next
      Print "RC5.cColl-Remove", msTimer - T, CC.Count
    
      T = msTimer
        For i = 1 To Count Step 2: CC.Add i, "Key " & i: Next
      Print "RC5.cColl-ReAdd", msTimer - T, CC.Count
    
      Print
      
      '-------------------- cHashD -----------------------
      Dim HD As cHashD
      Set HD = New cHashD
          HD.ReInit Count '<- optional,... but useful when you know the "expected entries-count" beforehand
    
      T = msTimer
        For i = 1 To Count: HD.Add "Key " & i, i: Next
      Print "cHashD-AddItems", msTimer - T, HD.Count
    
      T = msTimer
        For i = 1 To Count: i = HD.Item("Key " & i): Next
      Print "cHashD-KeyAcc", msTimer - T, HD.Count
    
      T = msTimer
        For i = 1 To Count Step 2: HD.Remove "Key " & i: Next
      Print "cHashD-Remove", msTimer - T, HD.Count
    
      T = msTimer
        For i = 1 To Count Step 2: HD.Add "Key " & i, i: Next
      Print "cHashD-ReAdd", msTimer - T, HD.Count
      
      
      'just some final validation, whether the contents of the probands are still the same
      For i = 1 To Count
        If HD.Item("Key " & i) <> SD.Item("Key " & i) Then MsgBox "Shouldn't happen"
      Next
    End Sub
    
    Function msTimer@()
      Dim x@, Frq@
      QueryPerformanceFrequency Frq
      If QueryPerformanceCounter(x) Then msTimer = CCur(x / Frq) * 1000@
    End Function
    I also don't get, what you are after (smells a bit like "premature optimization-efforts" to me).
    Also, don't mix topics - if you want to compare "Key/Value-Pair-Containers", then open up a new thread.

    Olaf

  26. #26

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Fast CRC32 (30ms to 0.03 ms) ,16byte table for crc32
    https://create.stephan-brumme.com/crc32/

  27. #27

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    test is easy ,only add,read,remove
    Code:
    n=1000000
        oTime.start
        For i = 1 To n
            dic.Add "kaaabbb" & i, "hello" & i
        Next
        
        lstOut.AddItem TestName & "add" & n & ",USED TIME: " & oTime.UsedTime & " ms"
        DoEvents
        
        
        oTime.start
        For i = 1 To n
            V = dic.Item("kaaabbb" & i)
        Next
        
     
        
        oTime.start
        For i = 1 To n/10
            dic.Remove "kaaabbb" & i 
        Next '

  28. #28
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,882

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by xiaoyao View Post
    test is easy ,only add,read,remove
    Code:
    n=1000000
        oTime.start
        For i = 1 To n
            dic.Add "kaaabbb" & i, "hello" & i
        Next
        
        lstOut.AddItem TestName & "add" & n & ",USED TIME: " & oTime.UsedTime & " ms"
        DoEvents
        
        
        oTime.start
        For i = 1 To n
            V = dic.Item("kaaabbb" & i)
        Next
        
     
        
        oTime.start
        For i = 1 To n/10
            dic.Remove "kaaabbb" & i 
        Next '
    Ok, so you did perform your test with 1Mio Items...

    But there's still something wrong with it, regarding the results
    (have now included the RC5.cSortedDictionary instead of the MS-Scripting.Dictionary, because the Process was not responding, even after I waited a minute):

    Comparison of cSortedDictionary, cCollection and cHashD - native compiled, 1Mio-items - 0.5Mio items in the Remove-Op):


    Here the slightly changed Test-Code again:
    Code:
    Option Explicit
    
    Private Declare Function QueryPerformanceFrequency& Lib "kernel32" (x@)
    Private Declare Function QueryPerformanceCounter& Lib "kernel32" (x@)
     
    Private Sub Form_Click()
      AutoRedraw = True: Cls
      Const Count As Long = 1000000
      If App.LogMode = 0 Then Print "Please compile natively, to compare the results!": Exit Sub
      
      '-------------------- Scripting-Dictionary -----------------------
      Dim SD As cSortedDictionary, i As Long, T@
      Set SD = New_c.SortedDictionary(BinaryCompare, False)
      
      T = msTimer
        For i = 1 To Count: SD.Add "Key " & i, i: Next
      Print "RC5.cSortD-AddItems", msTimer - T, SD.Count
    
      T = msTimer
        For i = 1 To Count: i = SD.Item("Key " & i): Next
      Print "RC5.cSortD-KeyAcc", msTimer - T, SD.Count
    
      T = msTimer
        For i = 1 To Count Step 2: SD.Remove "Key " & i: Next
      Print "RC5.cSortD-Remove", msTimer - T, SD.Count
    
      T = msTimer
        For i = 1 To Count Step 2: SD.Add "Key " & i, i: Next
      Print "RC5.cSortD-ReAdd", msTimer - T, SD.Count
      
      Print: DoEvents
      
      '-------------------- RC5.cCollection -----------------------
      Dim CC As cCollection
      Set CC = New_c.Collection(False, BinaryCompare, False)
     
      T = msTimer
        For i = 1 To Count: CC.Add i, "Key " & i: Next
      Print "RC5.cColl-AddItems", msTimer - T, CC.Count
      
      T = msTimer
        For i = 1 To Count: i = CC.Item("Key " & i): Next
      Print "RC5.cColl-KeyAcc", msTimer - T, CC.Count
      
      T = msTimer
        For i = 1 To Count Step 2: CC.Remove "Key " & i: Next
      Print "RC5.cColl-Remove", msTimer - T, CC.Count
    
      T = msTimer
        For i = 1 To Count Step 2: CC.Add i, "Key " & i: Next
      Print "RC5.cColl-ReAdd", msTimer - T, CC.Count
    
      Print: DoEvents
      
      '-------------------- cHashD -----------------------
      Dim HD As cHashD
      Set HD = New cHashD
          HD.ReInit Count '<- optional,... but useful when you know the "expected entries-count" beforehand
    
      T = msTimer
        For i = 1 To Count: HD.Add "Key " & i, i: Next
      Print "cHashD-AddItems", msTimer - T, HD.Count
    
      T = msTimer
        For i = 1 To Count: i = HD.Item("Key " & i): Next
      Print "cHashD-KeyAcc", msTimer - T, HD.Count
    
      T = msTimer
        For i = 1 To Count Step 2: HD.Remove "Key " & i: Next
      Print "cHashD-Remove", msTimer - T, HD.Count
    
      T = msTimer
        For i = 1 To Count Step 2: HD.Add "Key " & i, i: Next
      Print "cHashD-ReAdd", msTimer - T, HD.Count
      
      
      'just some final validation, whether the contents of the 2 probands are still the same
      For i = 1 To Count
        If HD.Item("Key " & i) <> SD.Item("Key " & i) Then MsgBox "Shouldn't happen"
      Next
    End Sub
    
    Function msTimer@()
      Dim x@, Frq@
      QueryPerformanceFrequency Frq
      If QueryPerformanceCounter(x) Then msTimer = CCur(x / Frq) * 1000@
    End Function
    Olaf

  29. #29

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by Schmidt View Post
    Ok, so you did perform your test with 1Mio Items...

    But there's still something wrong with it, regarding the results
    (have now included the RC5.cSortedDictionary instead of the MS-Scripting.Dictionary, because the Process was not responding, even after I waited a minute):

    Comparison of cSortedDictionary, cCollection and cHashD - native compiled, 1Mio-items - 0.5Mio items in the Remove-Op):


    Here the slightly changed Test-Code again:
    Olaf
    your code is add long value,i need string value:
    For i = 1 To n
    dic.Add "kaaabbb" & i, "hello" & i
    Next
    For i = 1 To n/2
    dic.remove "kaaabbb" & i
    Next
    remove "kaaabbb" & i

    you can uese the same key ,and the same string value type
    Last edited by xiaoyao; May 23rd, 2020 at 06:56 PM.

  30. #30
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,882

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by xiaoyao View Post
    your code is add long value,i need string value:
    For i = 1 To n
    dic.Add "kaaabbb" & i, "hello" & i
    Next

    remove "kaaabbb" & i

    you can uese the samve key ,and the samve string value
    It should be you, adapting my test-example to the different Key/Value-pairs.

    If you'd have done these adaptions yourself, perhaps you'd have realized,
    that you've messed up the Parameter-Order in the cCollection.Add method (in your own code).
    It is: .Add Value, Key ... and not .Add Key, Value (as the Dictionaries prefer)

    Anyway, here's my changes to the Key/Value pairs you apparently prefer:

    Code:
    Option Explicit
    
    Private Declare Function QueryPerformanceFrequency& Lib "kernel32" (x@)
    Private Declare Function QueryPerformanceCounter& Lib "kernel32" (x@)
     
    Private Sub Form_Click()
      AutoRedraw = True: Cls
      Const Count As Long = 1000000
      If App.LogMode = 0 Then Print "Please compile natively, to compare the results!": Exit Sub
      
      '-------------------- Scripting-Dictionary -----------------------
      Dim SD As cSortedDictionary, i As Long, T@, S$
      Set SD = New_c.SortedDictionary(BinaryCompare, False)
      
      T = msTimer
        For i = 1 To Count: SD.Add "kaaabbb" & i, "hello" & i: Next
      Print "RC5.cSortD-AddItems", msTimer - T, SD.Count
    
      T = msTimer
        For i = 1 To Count: S = SD.Item("kaaabbb" & i): Next
      Print "RC5.cSortD-KeyAcc", msTimer - T, SD.Count
    
      T = msTimer
        For i = 1 To Count Step 2: SD.Remove "kaaabbb" & i: Next
      Print "RC5.cSortD-Remove", msTimer - T, SD.Count
    
      T = msTimer
        For i = 1 To Count Step 2: SD.Add "kaaabbb" & i, "hello" & i: Next
      Print "RC5.cSortD-ReAdd", msTimer - T, SD.Count
      
      Print: DoEvents
      
      '-------------------- RC5.cCollection -----------------------
      Dim CC As cCollection
      Set CC = New_c.Collection(False, BinaryCompare, False)
     
      T = msTimer
        For i = 1 To Count: CC.Add "hello" & i, "kaaabbb" & i: Next
      Print "RC5.cColl-AddItems", msTimer - T, CC.Count
      
      T = msTimer
        For i = 1 To Count: S = CC.Item("kaaabbb" & i): Next
      Print "RC5.cColl-KeyAcc", msTimer - T, CC.Count
      
      T = msTimer
        For i = 1 To Count Step 2: CC.Remove "kaaabbb" & i: Next
      Print "RC5.cColl-Remove", msTimer - T, CC.Count
    
      T = msTimer
        For i = 1 To Count Step 2: CC.Add "hello" & i, "kaaabbb" & i: Next
      Print "RC5.cColl-ReAdd", msTimer - T, CC.Count
    
      Print: DoEvents
      
      '-------------------- cHashD -----------------------
      Dim HD As cHashD
      Set HD = New cHashD
          HD.ReInit Count '<- optional,... but useful when you know the "expected entries-count" beforehand
    
      T = msTimer
        For i = 1 To Count: HD.Add "kaaabbb" & i, "hello" & i: Next
      Print "cHashD-AddItems", msTimer - T, HD.Count
    
      T = msTimer
        For i = 1 To Count: S = HD.Item("kaaabbb" & i): Next
      Print "cHashD-KeyAcc", msTimer - T, HD.Count
    
      T = msTimer
        For i = 1 To Count Step 2: HD.Remove "kaaabbb" & i: Next
      Print "cHashD-Remove", msTimer - T, HD.Count
    
      T = msTimer
        For i = 1 To Count Step 2: HD.Add "kaaabbb" & i, "hello" & i: Next
      Print "cHashD-ReAdd", msTimer - T, HD.Count
     
      'just some final validation, whether the contents of the 2 probands are still the same
      For i = 1 To Count
        If HD.Item("Key " & i) <> SD.Item("Key " & i) Then MsgBox "Shouldn't happen"
      Next
    End Sub
    
    Function msTimer@()
      Dim x@, Frq@
      QueryPerformanceFrequency Frq
      If QueryPerformanceCounter(x) Then msTimer = CCur(x / Frq) * 1000@
    End Function
    And here's the result (which are not that much different from the ones, which were storing Long-Values instead of Strings):


    Olaf

  31. #31

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Now our time difference may not be much.
    Code:
    ' I used to REMOVE method
    FOR I=1 TO 50000
       DIC.REMOVE ***
    NEXT
    
    'YOUR CODE (Remove Fast)
       For i = 1 To 100000 Step 2
            dic.Remove ****
        Next
    TestObject TIME(MS)
    cHashD_add 67.32
    cHashD_Read 57.94
    cHashD_remove 29.74
    Dictionary2_add 1815.62
    Dictionary2_Read 664.07
    Dictionary2_remove 325.48
    MsDictionary_add 322.22
    MsDictionary_Read 273.02
    MsDictionary_remove 8522.25
    Rc5cCollection#add 146.53
    Rc5cCollection#Read 99.90
    Rc5cCollection#remove 61.02
    TrickHashTable_add 416.45
    TrickHashTable_Read 401.17
    TrickHashTable_remove 341.66
    Last edited by xiaoyao; May 23rd, 2020 at 07:19 PM.

  32. #32
    Frenzied Member
    Join Date
    Sep 2012
    Posts
    2,036

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Hi xiaoyao, maybe you will gradually understand why the performance of RC5 is far beyond your imagination.

  33. #33

    Thread Starter
    Hyperactive Member
    Join Date
    Jan 2020
    Posts
    405

    Re: vb Fast Crc32 (crc32str,Crc32File)

    Quote Originally Posted by dreammanor View Post
    Hi xiaoyao, maybe you will gradually understand why the performance of RC5 is far beyond your imagination.
    do you have a chm file about rc5.dll?
    I don't know how to use it.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width