how to Get Sha512 Fast by vb6 use api CryptCreateHash
best way by:
UPDATE: I PUT SPEED TEST CODE
Code:
'Solved: help with sha512 key Implementation in VB6 | Experts Exchange
'https://www.experts-exchange.com/questions/29116296/help-with-sha512-key-Implementation-in-VB6.html
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" _
(ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, _
ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" _
(ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" _
(ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, _
ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" _
(ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" _
(ByVal hHash As Long, pbData As Any, ByVal cbData As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" _
(ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, ByRef pcbData As Long, _
ByVal dwFlags As Long) As Long
Private Const PROV_RSA_FULL As Long = 1
Private Const PROV_RSA_AES As Long = 24
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
Private Const HP_HASHVAL As Long = 2
Private Const HP_HASHSIZE As Long = 4
Private Const ALG_TYPE_ANY As Long = 0
Private Const ALG_CLASS_HASH As Long = 32768
Private Const ALG_SID_MD2 As Long = 1
Private Const ALG_SID_MD4 As Long = 2
Private Const ALG_SID_MD5 As Long = 3
Private Const ALG_SID_SHA As Long = 4
Private Const ALG_SID_SHA_256 As Long = 12
Private Const ALG_SID_SHA_384 As Long = 13
Private Const ALG_SID_SHA_512 As Long = 14
Private Const CALG_MD2 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2)
Private Const CALG_MD4 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4)
Private Const CALG_MD5 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
Private Const CALG_SHA As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA)
Private Const CALG_SHA_256 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256)
Private Const CALG_SHA_384 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_384)
Private Const CALG_SHA_512 As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_512)
Private Declare Function timeBeginPeriod Lib "winmm.dll" _
(ByVal uPeriod As Long) As Long
Private Declare Function timeEndPeriod Lib "winmm.dll" _
(ByVal uPeriod As Long) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long '该声明得到系统开机到现在的时间(单位:毫秒)
Private Sub Form_Load()
timeBeginPeriod 1
End Sub
Private Sub Command1_Click()
SpeedTest
End Sub
Sub SpeedTest()
Dim strData As String
Dim StrArr() As String
Dim i As Long
Dim lenStr As Long
lenStr = 30
For i = 1 To lenStr
strData = strData & Right(i, 1)
Next
Dim Startid As Long, MinV As Long, CountUb As Long
MinV = 10000
CountUb = 9999
ReDim StrArr(0 To CountUb)
Startid = lenStr - 3
For i = MinV To MinV + CountUb
Mid(strData, Startid, 4) = Right(i, 4)
StrArr(i - MinV) = strData
Next
strData = "test"
Dim s As String * 128
Dim T As Long
T = timeGetTime
For i = 0 To CountUb
s = CreateHash(StrConv(StrArr(i), vbFromUnicode), CALG_SHA_512)
Next
MsgBox "UsedTime=" & timeGetTime - T
End Sub
Sub Test1()
Dim strData As String
strData = "test"
Dim s As String
s = CreateHash(StrConv(strData, vbFromUnicode), CALG_SHA_512)
MsgBox s
End Sub
Get Sha512 Fast by vb6 can't use CryptBinaryToString API.
it's base64 code
Code:
Private Declare Function CryptBinaryToStringA Lib "crypt32.dll" (ByVal pbBinary As Long, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As Long, ByRef pcchString As Long) As Long
Private Declare Function CryptStringToBinaryA Lib "crypt32.dll" (ByVal pszString As Long, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByRef pcbBinary As Long, ByVal pdwSkip As Long, ByVal pdwFlags As Long) As Long
Private Const CRYPT_STRING_BASE64 = &H1
Private Const CRYPT_STRING_BASE64_ANY = &H6
Private Sub Form_Load()
InputBox "", "1073741825", Hex(1073741825)
Dim a As String
a = Base64Encode(StrConv("TestStr", vbFromUnicode))
MsgBox a
MsgBox Decode(a)
MsgBox Base64Decode(a)
End Sub
Function Base64Decode(ByVal data As String) As String
Dim s As Long
Dim ret() As Byte
Dim retlen As Long
Dim b() As Byte
s = Len(data)
b = StrConv(data, vbFromUnicode)
'因为VB默认是Unicode字符,所以要转换成Ansi
Call CryptStringToBinaryA(VarPtr(b(0)), s, CRYPT_STRING_BASE64_ANY, StrPtr(ret), retlen, 0, 0)
If retlen = 0 Then Base64Decode = "": Exit Function
ReDim ret(retlen - 1)
Call CryptStringToBinaryA(VarPtr(b(0)), s, CRYPT_STRING_BASE64_ANY, VarPtr(ret(0)), retlen, 0, 0)
Base64Decode = StrConv(LeftB(ret, retlen), vbUnicode)
End Function
Function Base64Encode(data() As Byte) As String
Dim s As Long
Dim ret() As Byte
Dim retlen As Long
s = UBound(data) + 1
Call CryptBinaryToStringA(VarPtr(data(0)), s, 1073741825, StrPtr(ret), retlen)
If retlen = 0 Then Exit Function
'MsgBox retlen
ReDim ret(retlen - 1)
Call CryptBinaryToStringA(VarPtr(data(0)), s, 1073741825, VarPtr(ret(0)), retlen)
Base64Encode = StrConv(LeftB(ret, retlen), vbUnicode)
End Function
Last edited by xiaoyao; Jan 23rd, 2021 at 11:25 AM.
Re: how to Get Sha512 Fast by vb6 use api CryptCreateHash
Originally Posted by jpbro
10,000 tests of Len(str) = 30 takes 3000ms on your machine? Can you post your test code?
ok,i put test code at page first.
I hope you can try other methods to find the fastest way to calculate.
For example, will the speed of 64 bit exe be doubled?
VC++, VB.NET ,C#,virtual Freebasic,PYTHON
JS: (32BIT,64BIT),CHROME,quickjs,v8 js
YOU CAN TRY
Re: how to Get Sha512 Fast by vb6 use api CryptCreateHash
How fast does it need to be?
I'd use CNG instead of legacy crypto:
Code:
Option Explicit
Private Const WIN32_NULL As Long = 0&
Private Enum NTSTATUS
STATUS_SUCCESS = &H0&
STATUS_BUFFER_TOO_SMALL = &HC0000023
STATUS_DATA_ERROR = &HC000003E
STATUS_INVALID_BUFFER_SIZE = &HC0000206
STATUS_INVALID_HANDLE = &HC0000008
STATUS_INVALID_PARAMETER = &HC000000D
STATUS_INVALID_SIGNATURE = &HC000A000
STATUS_NOT_FOUND = &HC0000225
STATUS_NOT_SUPPORTED = &HC00000BB
STATUS_NO_MEMORY = &HC0000017
'Other encountered system values:
NTE_BAD_DATA = &H80090005
'Class defined extended values:
C_NO_DATA_TO_HASH = &HE0000001
End Enum
Private Declare Function BCryptCloseAlgorithmProvider Lib "bcrypt" ( _
ByVal hAlgorithm As Long, _
ByVal dwFlags As Long) As NTSTATUS
Private Declare Function BCryptCreateHash Lib "bcrypt" ( _
ByVal hAlgorithm As Long, _
ByRef hHash As Long, _
ByRef bHashObject As Any, _
ByVal cbHashObject As Long, _
ByVal pbSecret As Long, _
ByVal cbSecret As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function BCryptDestroyHash Lib "bcrypt" ( _
ByVal hHash As Long) As Long
Private Declare Function BCryptFinishHash Lib "bcrypt" ( _
ByVal hHash As Long, _
ByRef bOutput As Any, _
ByVal cbOutput As Long, _
ByVal dwFlags As Long) As Long
'BCryptGetProperty strings (subset used here).
Private Const BCRYPT_OBJECT_LENGTH As String = "ObjectLength"
Private Const BCRYPT_HASH_LENGTH As String = "HashDigestLength"
Private Declare Function BCryptGetProperty Lib "bcrypt" ( _
ByVal hObject As Long, _
ByVal pszProperty As Long, _
ByRef bOutput As Any, _
ByVal cbOutput As Long, _
ByRef cbResult As Long, _
ByVal dwFlags As Long) As NTSTATUS
Private Declare Function BCryptHashData Lib "bcrypt" ( _
ByVal hHash As Long, _
ByRef bInput As Any, _
ByVal cbInput As Long, _
ByVal dwFlags As Long) As Long
Private Const MS_PRIMITIVE_PROVIDER As String = "Microsoft Primitive Provider"
'Algorithm identifiers (subset used here).
Private Const BCRYPT_SHA512_ALGORITHM As String = "SHA512"
Private Declare Function BCryptOpenAlgorithmProvider Lib "bcrypt" ( _
ByRef hAlgorithm As Long, _
ByVal pszAlgId As Long, _
ByVal pszImplementation As Long, _
ByVal dwFlags As Long) As NTSTATUS
Private Const CRYPT_STRING_BASE64 = 1
Private Declare Function CryptBinaryToString Lib "Crypt32" _
Alias "CryptBinaryToStringW" ( _
ByRef bBinary As Byte, _
ByVal cbBinary As Long, _
ByVal dwFlags As Long, _
ByVal pszString As Long, _
ByRef cchString As Long) As Long
Private Declare Function timeGetTime Lib "winmm" () As Long
Private Function HashAnsi(ByRef UnicodeText As String, ByRef Base64 As String) As NTSTATUS
Dim hAlgorithm As Long
Dim cbHashObject As Long
Dim cbResult As Long
Dim cbHashBlock As Long
Dim HashObject() As Byte
Dim hHash As Long
Dim AnsiData() As Byte
Dim Hashed() As Byte
If Len(UnicodeText) < 1 Then
HashAnsi = C_NO_DATA_TO_HASH
Exit Function
End If
HashAnsi = BCryptOpenAlgorithmProvider(hAlgorithm, _
StrPtr(BCRYPT_SHA512_ALGORITHM), _
StrPtr(MS_PRIMITIVE_PROVIDER), _
0)
If HashAnsi <> STATUS_SUCCESS Then GoTo ExitAlg
HashAnsi = BCryptGetProperty(hAlgorithm, _
StrPtr(BCRYPT_OBJECT_LENGTH), _
cbHashObject, _
LenB(cbHashObject), _
cbResult, _
0)
If HashAnsi <> STATUS_SUCCESS Then GoTo ExitAlg
HashAnsi = BCryptGetProperty(hAlgorithm, _
StrPtr(BCRYPT_HASH_LENGTH), _
cbHashBlock, _
LenB(cbHashBlock), _
cbResult, _
0)
If HashAnsi <> STATUS_SUCCESS Then GoTo ExitAlg
ReDim HashObject(cbHashObject - 1)
HashAnsi = BCryptCreateHash(hAlgorithm, _
hHash, _
HashObject(0), _
cbHashObject, _
WIN32_NULL, _
0, _
0)
If HashAnsi <> STATUS_SUCCESS Then GoTo ExitAlg
AnsiData = StrConv(UnicodeText, vbFromUnicode)
HashAnsi = BCryptHashData(hHash, _
AnsiData(0), _
UBound(AnsiData) + 1, _
0)
If HashAnsi <> STATUS_SUCCESS Then GoTo ExitHash
ReDim Hashed(cbHashBlock - 1)
HashAnsi = BCryptFinishHash(hHash, _
Hashed(0), _
cbHashBlock, _
0)
If HashAnsi <> STATUS_SUCCESS Then GoTo ExitHash
CryptBinaryToString Hashed(0), _
cbHashBlock, _
CRYPT_STRING_BASE64, _
WIN32_NULL, _
cbResult
Base64 = String(cbResult, 0)
CryptBinaryToString Hashed(0), _
cbHashBlock, _
CRYPT_STRING_BASE64, _
StrPtr(Base64), _
cbResult
ExitHash:
BCryptDestroyHash hHash
ExitAlg:
BCryptCloseAlgorithmProvider hAlgorithm, 0
End Function
Private Sub Main()
Const ITERATION_COUNT As Long = "10,000"
Dim T0 As Long
Dim I As Long
Dim B64Hash As String
T0 = timeGetTime()
For I = 1 To ITERATION_COUNT
HashAnsi "test56789012345678901234567890", B64Hash
Next
Dlg.Message "Test results", ITERATION_COUNT, timeGetTime() - T0, B64Hash
End Sub
Re: how to Get Sha512 Fast by vb6 use api CryptCreateHash
SHA256 CODE:
Code:
Function HMACSHA256(strToSign As String, strKey() As Byte)
Dim lngLoop As Long
Dim oUTF, oEnc
Dim HMAC() As Byte
Dim lastrow As Long
On Error GoTo err_handler
Set oUTF = CreateObject("System.Text.UTF8Encoding")
Set oEnc = CreateObject("System.Security.Cryptography.HMACSHA256")
oEnc.Key = strKey
HMAC = oEnc.ComputeHash_2(oUTF.GetBytes_4(strToSign))
HMACSHA256 = HMAC
Exit Function
err_handler:
End Function
Re: how to Get Sha512 Fast by vb6 use api CryptCreateHash
Naming something strKey() As Byte is mind-boggling when you have strToSign As String in the very same code snippet.
Also note that this is *not* SHA256 CODE because it is computing a form of MAC (Message Authentication Code) the so called HMAC (Hash Message Authentication Code) which accepts as parameter a hash function in this particular case SHA-256 and a secret key (the unfortunately named strKey parameter).
My point being that HMAC-SHA256 as crypto primitive is very different than SHA-256 hash per se.
cheers,
</wqw>
Last edited by wqweto; Feb 27th, 2021 at 03:28 AM.