Results 1 to 8 of 8

Thread: How to calculate checksum of hash string.

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Dec 2021
    Posts
    16

    How to calculate checksum of hash string.

    I tried to obtain Checksum from hash string using CSHA256.cls class.
    for example:
    hash = "238dbd3bd53ee4c53c505ca2b56e1756e622aa0c"
    duoblSHA256 = SHA256Hash.SHA256(SHA256Hash.SHA256(hash)
    checksum = Mid$(duoblSHA256, 1, 4) Take the first 4 bytes
    checksum data =727a41f1

    but it gives a different checksum data in this link https://learnmeabitcoin.com/technical/checksum

    Can anyone help...
    Attached Files Attached Files

  2. #2
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,121

    Re: How to calculate checksum of hash string.

    First, you have to learn how to work with byte-arrays in crypto. Your "238dbd3bd53ee4c53c505ca2b56e1756e622aa0c" is a *string* literal -- so called hex dump of a byte-array. You need helper functions which convert a byte-array to/from a hex-dump string.

    Second, you need to research better crypto primitives which are *not* implemented in VB6. The pure VB6 class you intend to use for SHA-2 hashes while a nice exercise is completely unfit for production use as its god slow (and works with strings).

    There is new CNG API and legacy CryptoAPI in Windows which deal with crypto primitives consistently (hashes, HMAC, AES, signatures, etc.) and include hand optimized assembly implementations.

    cheers,
    </wqw>

  3. #3
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,121

    Re: How to calculate checksum of hash string.

    For instance try putting these helper functions in a module

    Code:
    '--- Module1.bas
    Option Explicit
    
    Private Declare Function CryptAcquireContext Lib "advapi32" Alias "CryptAcquireContextW" (phProv As Long, ByVal pszContainer As Long, ByVal pszProvider As Long, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
    Private Declare Function CryptCreateHash Lib "advapi32" (ByVal hProv As Long, ByVal AlgId As Long, ByVal hKey As Long, ByVal dwFlags As Long, phHash As Long) As Long
    Private Declare Function CryptDestroyHash Lib "advapi32" (ByVal hHash As Long) As Long
    Private Declare Function CryptHashData Lib "advapi32" (ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
    Private Declare Function CryptGetHashParam Lib "advapi32" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long
    
    Public Function CryptoHash(baRetVal() As Byte, ByVal lHashAlgId As Long, baInput() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1) As Boolean
        Const PROV_RSA_AES          As Long = 24
        Const CRYPT_VERIFYCONTEXT   As Long = &HF0000000
        Const HP_HASHVAL            As Long = 2
        Const LNG_FACILITY_WIN32    As Long = &H80070000
        Static hProv        As Long
        Dim hHash           As Long
        Dim lHashSize       As Long
        Dim lResult         As Long
        Dim sApiSource      As String
        
        If hProv = 0 Then
            If CryptAcquireContext(hProv, 0, 0, PROV_RSA_AES, CRYPT_VERIFYCONTEXT) = 0 Then
                lResult = Err.LastDllResult
                sApiSource = "CryptAcquireContext"
                GoTo QH
            End If
        End If
        If CryptCreateHash(hProv, lHashAlgId, 0, 0, hHash) = 0 Then
            lResult = Err.LastDllResult
            sApiSource = "CryptCreateHash"
            GoTo QH
        End If
        If Size < 0 Then
            Size = UBound(baInput) + 1
        End If
        If Size > 0 Then
            If CryptHashData(hHash, baInput(Pos), Size, 0) = 0 Then
                lResult = Err.LastDllResult
                sApiSource = "CryptHashData"
                GoTo QH
            End If
        End If
        lHashSize = 1024
        ReDim baRetVal(0 To lHashSize - 1) As Byte
        If CryptGetHashParam(hHash, HP_HASHVAL, baRetVal(0), lHashSize, 0) = 0 Then
            lResult = Err.LastDllResult
            sApiSource = "CryptGetHashParam"
            GoTo QH
        End If
        ReDim Preserve baRetVal(0 To lHashSize - 1) As Byte
        '--- success
        CryptoHash = True
    QH:
        If hHash <> 0 Then
            Call CryptDestroyHash(hHash)
        End If
        If LenB(sApiSource) <> 0 Then
            Err.Raise IIf(lResult < 0, lResult, lResult Or LNG_FACILITY_WIN32), sApiSource
        End If
    End Function
    
    Public Function ToHex(baText() As Byte, Optional Delimiter As String) As String
        Dim aText()         As String
        Dim lIdx            As Long
        
        If LenB(CStr(baText)) <> 0 Then
            ReDim aText(0 To UBound(baText)) As String
            For lIdx = 0 To UBound(baText)
                aText(lIdx) = Right$("0" & Hex$(baText(lIdx)), 2)
            Next
            ToHex = Join(aText, Delimiter)
        End If
    End Function
    
    Public Function FromHex(sText As String) As Byte()
        Dim baRetVal()      As Byte
        Dim lIdx            As Long
        
        On Error GoTo QH
        '--- check for hexdump delimiter
        If sText Like "*[!0-9A-Fa-f]*" Then
            ReDim baRetVal(0 To Len(sText) \ 3) As Byte
            For lIdx = 1 To Len(sText) Step 3
                baRetVal(lIdx \ 3) = "&H" & Mid$(sText, lIdx, 2)
            Next
        ElseIf LenB(sText) <> 0 Then
            ReDim baRetVal(0 To Len(sText) \ 2 - 1) As Byte
            For lIdx = 1 To Len(sText) Step 2
                baRetVal(lIdx \ 2) = "&H" & Mid$(sText, lIdx, 2)
            Next
        Else
            baRetVal = vbNullString
        End If
        FromHex = baRetVal
    QH:
    End Function
    Your double SHA-256 hash impl looks like this:

    Code:
    '--- Form1.frm
    Option Explicit
    
    Private Sub Form_Load()
        Const CALG_SHA_256  As Long = &H800C&
        Dim baInput()       As Byte
        Dim baHash()        As Byte
        
        baInput = FromHex("238dbd3bd53ee4c53c505ca2b56e1756e622aa0c")
        CryptoHash baHash, CALG_SHA_256, baInput
        CryptoHash baHash, CALG_SHA_256, baHash
        Debug.Print Left$(ToHex(baHash), 8)
        '--> 06B5FF76
    End Sub
    cheers,
    </wqw>

  4. #4

    Thread Starter
    Junior Member
    Join Date
    Dec 2021
    Posts
    16

    Re: How to calculate checksum of hash string.

    Thank you WQW for your help ...perfect result .
    I have never used API before. And I am a new in vb6.

    Is there a pure vb6 function without using API ? THANK YOU AGAIN...

  5. #5
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,121

    Re: How to calculate checksum of hash string.

    Well, you can use .NET implementation of SHA-2 like this

    Code:
    Private Sub Form_Click()
        Dim baInput()       As Byte
        Dim baHash()        As Byte
        
        baInput = FromHex("238dbd3bd53ee4c53c505ca2b56e1756e622aa0c")
        With CreateObject("System.Security.Cryptography.SHA256Managed")
            baHash = .ComputeHash_2(baInput)
            baHash = .ComputeHash_2(baHash)
        End With
        Debug.Print Left$(ToHex(baHash), 8)
        '--> 06B5FF76
    End Sub
    cheers,
    </wqw>

  6. #6

    Thread Starter
    Junior Member
    Join Date
    Dec 2021
    Posts
    16

    Re: How to calculate checksum of hash string.

    That's great. It is very helpful. Thank you for your time.

  7. #7
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,121

    Re: How to calculate checksum of hash string.

    Btw, here is a byte-arrays pure VB6 implementation based on your class but reduced to about 175 LOC by removing mostly unnecessary cruft:

    Code:
    '--- mdSHA256.bas
    '--- Based on clsSHA256 by Phil Fresle and David Midkiff
    Option Explicit
    DefObj A-Z
    
    Private PowerOf2(0 To 31)   As Long
    
    Private Function LShift(ByVal X As Long, ByVal n As Long) As Long
        If n = 0 Then
            LShift = X
        Else
            LShift = (X And (PowerOf2(31 - n) - 1)) * PowerOf2(n) Or -((X And PowerOf2(31 - n)) <> 0) * &H80000000
        End If
    End Function
    
    Private Function RShift(ByVal X As Long, ByVal n As Long) As Long
        If n = 0 Then
            RShift = X
        Else
            RShift = (X And &H7FFFFFFF) \ PowerOf2(n) Or -(X < 0) * PowerOf2(31 - n)
        End If
    End Function
    
    Private Function AddUnsigned(ByVal lX As Long, ByVal lY As Long) As Long
        If (lX Xor lY) > 0 Then
            AddUnsigned = (lX Xor &H80000000) + lY Xor &H80000000
        Else
            AddUnsigned = lX + lY
        End If
    End Function
    
    Private Function Ch(ByVal X As Long, ByVal Y As Long, ByVal Z As Long) As Long
        Ch = ((X And Y) Xor ((Not X) And Z))
    End Function
    
    Private Function Maj(ByVal X As Long, ByVal Y As Long, ByVal Z As Long) As Long
        Maj = ((X And Y) Xor (X And Z) Xor (Y And Z))
    End Function
    
    Private Function RRotate(ByVal X As Long, ByVal n As Long) As Long
        ' RRotate = RShift(X, n) Or LShift(X, 32 - n)
        Debug.Assert n <> 0
        RRotate = ((X And &H7FFFFFFF) \ PowerOf2(n) - (X < 0) * PowerOf2(31 - n)) Or _
            ((X And (PowerOf2(n - 1) - 1)) * PowerOf2(32 - n) Or -((X And PowerOf2(n - 1)) <> 0) * &H80000000)
    End Function
    
    Private Function Sigma0(ByVal X As Long) As Long
        Sigma0 = (RRotate(X, 2) Xor RRotate(X, 13) Xor RRotate(X, 22))
    End Function
    
    Private Function Sigma1(ByVal X As Long) As Long
        Sigma1 = (RRotate(X, 6) Xor RRotate(X, 11) Xor RRotate(X, 25))
    End Function
    
    Private Function Gamma0(ByVal X As Long) As Long
        Gamma0 = (RRotate(X, 7) Xor RRotate(X, 18) Xor RShift(X, 3))
    End Function
    
    Private Function Gamma1(ByVal X As Long) As Long
        Gamma1 = (RRotate(X, 17) Xor RRotate(X, 19) Xor RShift(X, 10))
    End Function
    
    Private Sub ToBigEndian(aRetVal() As Long, baBuffer() As Byte)
        Dim lSize           As Long
        Dim lIdx            As Long
        Dim lOutSize        As Long
        Dim lOutIdx         As Long
        Dim lOffset         As Long
        
        lSize = UBound(baBuffer) + 1
        lOutSize = ((lSize + 8) \ 64 + 1) * 16
        ReDim aRetVal(0 To lOutSize - 1) As Long
        For lIdx = 0 To UBound(baBuffer)
            lOutIdx = lIdx \ 4
            lOffset = 24 - (lIdx Mod 4) * 8
            aRetVal(lOutIdx) = aRetVal(lOutIdx) Or LShift(baBuffer(lIdx), lOffset)
        Next
        lOutIdx = lIdx \ 4
        lOffset = 24 - (lIdx Mod 4) * 8
        aRetVal(lOutIdx) = aRetVal(lOutIdx) Or LShift(&H80, lOffset)
        aRetVal(lOutSize - 1) = LShift(lSize, 3)
        aRetVal(lOutSize - 2) = RShift(lSize, 29)
    End Sub
    
    Private Sub FromBigEndian(baRetVal() As Byte, aInput() As Long)
        Dim lIdx            As Long
        Dim lWord           As Long
        
        ReDim baRetVal(0 To UBound(aInput) * 4 + 3) As Byte
        For lIdx = 0 To UBound(aInput)
            lWord = aInput(lIdx)
            baRetVal(4 * lIdx + 0) = RShift(lWord, 24) And &HFF&
            baRetVal(4 * lIdx + 1) = (lWord And &HFF0000) \ &H10000 And &HFF&
            baRetVal(4 * lIdx + 2) = (lWord And &HFF00) \ &H100& And &HFF&
            baRetVal(4 * lIdx + 3) = lWord And &HFF&
        Next
    End Sub
    
    Public Sub CryptoSHA256(baRetVal() As Byte, baBuffer() As Byte)
        Static K(0 To 63)   As Long
        Dim HASH(0 To 7)    As Long
        Dim M()             As Long
        Dim W(0 To 63)      As Long
        Dim A               As Long
        Dim B               As Long
        Dim C               As Long
        Dim D               As Long
        Dim E               As Long
        Dim F               As Long
        Dim G               As Long
        Dim H               As Long
        Dim I               As Long
        Dim J               As Long
        Dim T1              As Long
        Dim T2              As Long
        Dim vElem           As Variant
        
        If PowerOf2(0) = 0 Then
            For I = 0 To 30
                PowerOf2(I) = 2& ^ I
            Next
            PowerOf2(31) = &H80000000
            For Each vElem In Split("428A2F98 71374491 B5C0FBCF E9B5DBA5 3956C25B 59F111F1 923F82A4 AB1C5ED5 D807AA98 12835B01 243185BE 550C7DC3 72BE5D74 80DEB1FE 9BDC06A7 C19BF174 E49B69C1 EFBE4786 FC19DC6 240CA1CC 2DE92C6F 4A7484AA 5CB0A9DC 76F988DA 983E5152 A831C66D B00327C8 BF597FC7 C6E00BF3 D5A79147 6CA6351 14292967 27B70A85 2E1B2138 4D2C6DFC 53380D13 650A7354 766A0ABB 81C2C92E 92722C85 A2BFE8A1 A81A664B C24B8B70 C76C51A3 D192E819 D6990624 F40E3585 106AA070 19A4C116 1E376C08 2748774C 34B0BCB5 391C0CB3 4ED8AA4A 5B9CCA4F 682E6FF3 748F82EE 78A5636F 84C87814 8CC70208 90BEFFFA A4506CEB BEF9A3F7 C67178F2")
                K(J) = "&H" & vElem
                J = J + 1
            Next
        End If
        HASH(0) = &H6A09E667
        HASH(1) = &HBB67AE85
        HASH(2) = &H3C6EF372
        HASH(3) = &HA54FF53A
        HASH(4) = &H510E527F
        HASH(5) = &H9B05688C
        HASH(6) = &H1F83D9AB
        HASH(7) = &H5BE0CD19
        ToBigEndian M, baBuffer
        For I = 0 To UBound(M) Step 16
            A = HASH(0)
            B = HASH(1)
            C = HASH(2)
            D = HASH(3)
            E = HASH(4)
            F = HASH(5)
            G = HASH(6)
            H = HASH(7)
            For J = 0 To 63
                If J < 16 Then
                    W(J) = M(J + I)
                Else
                    W(J) = AddUnsigned(AddUnsigned(AddUnsigned(Gamma1(W(J - 2)), W(J - 7)), Gamma0(W(J - 15))), W(J - 16))
                End If
                T1 = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(H, Sigma1(E)), Ch(E, F, G)), K(J)), W(J))
                T2 = AddUnsigned(Sigma0(A), Maj(A, B, C))
                H = G
                G = F
                F = E
                E = AddUnsigned(D, T1)
                D = C
                C = B
                B = A
                A = AddUnsigned(T1, T2)
            Next
            HASH(0) = AddUnsigned(A, HASH(0))
            HASH(1) = AddUnsigned(B, HASH(1))
            HASH(2) = AddUnsigned(C, HASH(2))
            HASH(3) = AddUnsigned(D, HASH(3))
            HASH(4) = AddUnsigned(E, HASH(4))
            HASH(5) = AddUnsigned(F, HASH(5))
            HASH(6) = AddUnsigned(G, HASH(6))
            HASH(7) = AddUnsigned(H, HASH(7))
        Next
        FromBigEndian baRetVal, HASH
    End Sub
    Here is how to use it:

    Code:
    Private Sub Form_Click()
        Dim baInput()       As Byte
        Dim baHash()        As Byte
        
        baInput = FromHex("238dbd3bd53ee4c53c505ca2b56e1756e622aa0c")
        CryptoSHA256 baHash, baInput
        CryptoSHA256 baHash, baHash
        Debug.Print Left$(ToHex(baHash), 8)
        '--> 06B5FF76
    End Sub
    cheers,
    </wqw>

  8. #8

    Thread Starter
    Junior Member
    Join Date
    Dec 2021
    Posts
    16

    Re: How to calculate checksum of hash string.

    Wow, I have tested it.. Really it's more faster than before.
    I prefer the pure script. for understanding

    I appreciate it.
    Thanks bro.

Tags for this Thread

Posting Permissions

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



Click Here to Expand Forum to Full Width