[RESOLVED] I need SHA256 hashing code (not WinAPI based)

[Dragokas]

Hi,

I need SHA256 calculation code, that is working on Windows XP SP3 (even those not fully updated).

Requirement:
- portability (no additional dll)

XP has:
- no bcrypt.dll
- no MS_ENH_RSA_AES_PROV "Microsoft Enhanced RSA and AES Cryptographic Provider"

Looks like I'm limited with pure mathematics algorithm.
Does somebody have one / ready implementation / or something very similar / or alternative API that I missed?

Thank you.

[Dragokas]

Solved.

Found my old backup of Phil Fresle's forks.
Just need to add binary data support, and I will be fine )

If somebody need:

Hashing:
- MD5
- SHA-256 (SHA-2)

Encryption:

- RC2, RC4
- Rijndael AES Block Cipher

Source: http://www.frez.co.uk/free/vb6code (not work)

[wqweto]

Does somebody have one / ready implementation / or something very similar / or alternative API that I missed?

PROV_RSA_AES provider *type* works with Crypto API on XP SP3 just fine (Edit: SP3 is required, SHA-256 is not available on SP2), just pass NULL for pszProvider *name* instead of some finicky strings that change with OS version.

Here is an MD5/SHA-1/SHA-2 combo GetHash function in ~40 LOC:

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

Private Sub Form_Click()
    Const CALG_MD5      As Long = &H8003&
    Const CALG_SHA1     As Long = &H8004&
    Const CALG_SHA_256  As Long = &H800C&
    Const CALG_SHA_384  As Long = &H800D&
    Const CALG_SHA_512  As Long = &H800E&
    Dim baHash()        As Byte
    Dim lIdx            As Long
    
    baHash = GetHash(CALG_SHA_256, "Test" & Timer)
    For lIdx = 0 To UBound(baHash)
        Print Right$("0" & Hex$(baHash(lIdx)), 2); " ";
    Next
    Print
End Sub

Private Function GetHash(ByVal lHashAlgId As Long, baInput() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1) As Byte()
    Const PROV_RSA_AES  As Long = 24
    Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
    Const HP_HASHVAL    As Long = 2
    Dim hProv           As Long
    Dim hHash           As Long
    Dim lHashSize       As Long
    Dim baRetVal()      As Byte
    
    If CryptAcquireContext(hProv, 0, 0, PROV_RSA_AES, CRYPT_VERIFYCONTEXT) = 0 Then
        GoTo QH
    End If
    If CryptCreateHash(hProv, lHashAlgId, 0, 0, hHash) = 0 Then
        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
            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
        GoTo QH
    End If
    ReDim Preserve baRetVal(0 To lHashSize - 1) As Byte
    GetHash = baRetVal
QH:
    If hHash <> 0 Then
        Call CryptDestroyHash(hHash)
    End If
    If hProv <> 0 Then
        Call CryptReleaseContext(hProv, 0)
    End If
End Function

cheers,
</wqw>

[Dragokas]

Ahh, I see, thank you. With 0, 0 it's working. I misread docs, looks like in XP it uses "Microsoft Enhanced RSA and AES Cryptographic Provider (Prototype)", which is by default when you specify 0 for PROV_RSA_AES.

[wqweto]

The weird part is that HMAC with SHA-256 does *not* need the enhanced PROV_RSA_AES and works even with base PROV_RSA_FULL but SHA-256 alone is not supported by base PROV_RSA_FULL -- go figure :-))

For instance this GetHmac function works w/ PROV_RSA_FULL on XP SP3 just fine

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
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 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
Private Declare Function CryptSetHashParam Lib "advapi32" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, ByVal dwFlags As Long) As Long
Private Declare Function CryptImportKey Lib "advapi32" (ByVal hProv As Long, pbData As Any, ByVal dwDataLen As Long, ByVal hPubKey As Long, ByVal dwFlags As Long, phKey As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32" (ByVal hKey As Long) As Long

Private Type BLOBHEADER
    bType               As Byte
    bVersion            As Byte
    reserved            As Integer
    aiKeyAlg            As Long
    cbKeySize           As Long
    Buffer(0 To 255)    As Byte
End Type

Private Type HMAC_INFO
    HashAlgid           As Long
    pbInnerString       As Long
    cbInnerString       As Long
    pbOuterString       As Long
    cbOuterString       As Long
End Type

Private Sub Form_Click()
    Const CALG_MD5      As Long = &H8003&
    Const CALG_SHA1     As Long = &H8004&
    Const CALG_SHA_256  As Long = &H800C&
    Const CALG_SHA_384  As Long = &H800D&
    Const CALG_SHA_512  As Long = &H800E&
    Dim baKey()         As Byte
    Dim baHmac()        As Byte
    Dim lIdx            As Long
    
    baKey = "s3cr3t"
    baHmac = GetHmac(baKey, CALG_SHA_256, "Test" & Timer)
    For lIdx = 0 To UBound(baHmac)
        Print Right$("0" & Hex$(baHmac(lIdx)), 2); " ";
    Next
    Print
End Sub

Private Function GetHmac(baKey() As Byte, ByVal lHashAlgId As Long, baInput() As Byte, Optional ByVal Pos As Long, Optional ByVal Size As Long = -1) As Byte()
    Const PROV_RSA_FULL     As Long = 1
    Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
    Const PLAINTEXTKEYBLOB  As Long = 8
    Const CUR_BLOB_VERSION  As Long = 2
    Const CALG_RC2          As Long = &H6602&
    Const CALG_HMAC         As Long = &H8009&
    Const CRYPT_EXPORTABLE  As Long = &H1
    Const CRYPT_IPSEC_HMAC_KEY As Long = &H100
    Const HP_HASHVAL        As Long = 2
    Const HP_HMAC_INFO      As Long = 5
    Const sizeof_BLOBHEADER As Long = 12
    Dim hProv           As Long
    Dim uBlob           As BLOBHEADER
    Dim hKey            As Long
    Dim hHash           As Long
    Dim uInfo           As HMAC_INFO
    Dim lHashSize       As Long
    Dim baRetVal()      As Byte
    
    If CryptAcquireContext(hProv, 0, 0, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT) = 0 Then
        GoTo QH
    End If
    uBlob.bType = PLAINTEXTKEYBLOB
    uBlob.bVersion = CUR_BLOB_VERSION
    uBlob.aiKeyAlg = CALG_RC2
    Debug.Assert UBound(uBlob.Buffer) >= UBound(baKey)
    uBlob.cbKeySize = UBound(baKey) + 1
    Call CopyMemory(uBlob.Buffer(0), baKey(0), uBlob.cbKeySize)
    If CryptImportKey(hProv, uBlob, sizeof_BLOBHEADER + uBlob.cbKeySize, 0, CRYPT_EXPORTABLE Or CRYPT_IPSEC_HMAC_KEY, hKey) = 0 Then
        GoTo QH
    End If
    If CryptCreateHash(hProv, CALG_HMAC, hKey, 0, hHash) = 0 Then
        GoTo QH
    End If
    uInfo.HashAlgid = lHashAlgId
    If CryptSetHashParam(hHash, HP_HMAC_INFO, uInfo, 0) = 0 Then
        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
            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
        GoTo QH
    End If
    ReDim Preserve baRetVal(0 To lHashSize - 1) As Byte
    GetHmac = baRetVal
QH:
    If hHash <> 0 Then
        Call CryptDestroyHash(hHash)
    End If
    If hKey <> 0 Then
        Call CryptDestroyKey(hKey)
    End If
    If hProv <> 0 Then
        Call CryptReleaseContext(hProv, 0)
    End If
End Function

cheers,
</wqw>

[wqweto]

JFYI, there is [VB6/VBA] Pure VB6 impl of SHA-2 thread in the CodeBank which has SHA-224, SHA-256, SHA-384, SHA-512, SHA-512/224 and SHA-512/256 variants incl. HMAC on top of these both for VB6 and with VBA source level support built-in.

Support for LongLong in VBA7 (both x86 and x64 versions) is crucial for the core performance of SHA-512 based hashes -- the SHA-384, SHA-512, SHA-512/224 and SHA-512/256 -- which were conceived by their creators as a separate (second) SHA-2 hash function geared more towards server x64 CPUs (w/ AVX instruction set support) and this is why in the submission above their impl is kept in a separate .bas module so to be easily excluded when not needed.

cheers,
</wqw>

[Dragokas]

Cool! Thank you!