Printable View
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...
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>
For instance try putting these helper functions in a module
Your double SHA-256 hash impl looks like this: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
cheers,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
</wqw>
Thank you WQW for your help ...perfect result .:check:
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...
Well, you can use .NET implementation of SHA-2 like this
cheers,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
</wqw>
That's great. It is very helpful. Thank you for your time. :)
Btw, here is a byte-arrays pure VB6 implementation based on your class but reduced to about 175 LOC by removing mostly unnecessary cruft:
Here is how to use it: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
cheers,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
</wqw>
Wow, I have tested it.. Really it's more faster than before.
I prefer the pure script. for understanding :D
I appreciate it.:check:
Thanks bro.