Fandom

Visual Basic Wiki

SHA-CryptoAPI.bas

69pages on
this wiki
Add New Page
Talk0 Share

DescriptionEdit

This function uses CryptoAPI to calculate MD5 and SHA-1 hashes. Input is byte array, return value is a string but you can easily modify it to return a byte array. Using API to calculate hashes turned up to be 100+ times faster than pure VB6 implementations.

CodeEdit

'--- for CryptAcquireContext
Private Const MS_DEFAULT_PROVIDER           As String = "Microsoft Base Cryptographic Provider v1.0"
Private Const PROV_RSA_FULL                 As Long = 1
Private Const CRYPT_VERIFYCONTEXT           As Long = &HF0000000
'--- for CryptGetHashParam
Private Const HP_HASHVAL                    As Long = 2
Private Const HP_HASHSIZE                   As Long = 4

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 CryptReleaseContext Lib "Advapi32" (ByVal hProv 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 CryptHashData Lib "Advapi32" (ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDestroyHash Lib "Advapi32" (ByVal hHash 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 Enum UcsHashAlgorithmType
    CALG_MD5 = &H8003&
    CALG_SHA1 = &H8004&
End Enum

Public Function GetHash(baData() As Byte, ByVal eType As UcsHashAlgorithmType) As String
    Dim hBaseProvider   As Long
    Dim hHash           As Long
    Dim lSize           As Long
    Dim baBuffer()      As Byte
    Dim lIdx            As Long
    
    If CryptAcquireContext(hBaseProvider, 0, StrPtr(MS_DEFAULT_PROVIDER), PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) <> 0 Then
        If CryptCreateHash(hBaseProvider, eType, 0, 0, hHash) <> 0 Then
            If CryptHashData(hHash, baData(0), UBound(baData) + 1, 0) <> 0 Then
                If CryptGetHashParam(hHash, HP_HASHSIZE, lSize, 4, 0) <> 0 Then
                    ReDim baBuffer(0 To lSize - 1) As Byte
                    If CryptGetHashParam(hHash, HP_HASHVAL, baBuffer(0), lSize, 0) <> 0 Then
                        For lIdx = 0 To UBound(baBuffer)
                            GetHash = GetHash & Right$("0" & Hex(baBuffer(lIdx)), 2)
                        Next
                    End If
                End If
            End If
            Call CryptDestroyHash(hHash)
        End If
        Call CryptReleaseContext(hBaseProvider, 0)
    End If
End Function

Ad blocker interference detected!


Wikia is a free-to-use site that makes money from advertising. We have a modified experience for viewers using ad blockers

Wikia is not accessible if you’ve made further modifications. Remove the custom ad blocker rule(s) and the page will load as expected.