Results 1 to 8 of 8

Thread: how to Get Sha512 Fast by vb6 use api CryptCreateHash

  1. #1

    Thread Starter
    Fanatic Member
    Join Date
    Jan 2020
    Posts
    637

    Unhappy 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.

  2. #2
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Posts
    2,694

    Re: how to Get Sha512 Fast by vb6 use api CryptCreateHash

    You have everything to figure it out in the code you posted.

    Which part is slow for you? Have you micro-benchmarked it already?

    cheers,
    </wqw>

  3. #3

    Thread Starter
    Fanatic Member
    Join Date
    Jan 2020
    Posts
    637

    Re: how to Get Sha512 Fast by vb6 use api CryptCreateHash

    len(str)=30
    i test 10000 counts,used time:3000ms (i5 8600k),If multithreading is used, the speed of 6-core CPU can be increased by 3-5 times

  4. #4
    Frenzied Member
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    1,703

    Re: how to Get Sha512 Fast by vb6 use api CryptCreateHash

    10,000 tests of Len(str) = 30 takes 3000ms on your machine? Can you post your test code?

  5. #5

    Thread Starter
    Fanatic Member
    Join Date
    Jan 2020
    Posts
    637

    Re: how to Get Sha512 Fast by vb6 use api CryptCreateHash

    Quote Originally Posted by jpbro View Post
    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

  6. #6
    PowerPoster
    Join Date
    Feb 2006
    Posts
    21,864

    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

    Seems fast enough on this really old PC:

    Name:  sshot.png
Views: 56
Size:  3.1 KB

    Minimum supported client: Windows Vista
    Attached Files Attached Files

  7. #7

    Thread Starter
    Fanatic Member
    Join Date
    Jan 2020
    Posts
    637

    Re: how to Get Sha512 Fast by vb6 use api CryptCreateHash

    Quote Originally Posted by dilettante View Post
    How fast does it need to be?
    I'd use CNG instead of legacy crypto:
    it's only base64,do you have sha512 api or other code function ?
    you can try base64 without api,only use vb6 code,and test speed

  8. #8
    PowerPoster
    Join Date
    Feb 2006
    Posts
    21,864

    Re: how to Get Sha512 Fast by vb6 use api CryptCreateHash

    Quote Originally Posted by xiaoyao View Post
    it's only base64

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