VB6 Hash

Option Explicit

Private Const CALG_SHA_256 As Long = 0x0000800C
Private Const HP_HASHVAL As Long = 2
Private Const PROV_RSA_FULL As Long = 1

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 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 CryptHashData Lib "advapi32.dll" _
    (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long

Private Declare Function CryptGetHashParam Lib "advapi32.dll" _
    (ByVal hHash As Long, ByVal dwParam As Long, ByRef pbData As Any, ByRef pdwDataLen 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

Public Function CalculateSHA256Hash(ByVal inputString As String) As String
    Dim hCryptProv As Long
    Dim hHash As Long
    Dim hashValue() As Byte
    Dim i As Long

    ' Acquire a cryptographic context
    If CryptAcquireContext(hCryptProv, vbNullString, vbNullString, PROV_RSA_FULL, 0) = 0 Then
        MsgBox "Error acquiring cryptographic context."
        Exit Function
    End If

    ' Create a hash object
    If CryptCreateHash(hCryptProv, CALG_SHA_256, 0, 0, hHash) = 0 Then
        MsgBox "Error creating hash object."
        CryptReleaseContext hCryptProv, 0
        Exit Function
    End If

    ' Hash the input data
    If CryptHashData(hHash, ByVal inputString, Len(inputString), 0) = 0 Then
        MsgBox "Error hashing data."
        CryptReleaseContext hCryptProv, 0
        CryptDestroyHash hHash
        Exit Function
    End If

    ' Get the hash value
    ReDim hashValue(31)
    If CryptGetHashParam(hHash, HP_HASHVAL, hashValue(0), 32, 0) = 0 Then
        MsgBox "Error retrieving hash value."
        CryptReleaseContext hCryptProv, 0
        CryptDestroyHash hHash
        Exit Function
    End If

    ' Release resources
    CryptDestroyHash hHash
    CryptReleaseContext hCryptProv, 0

    ' Convert the byte array to a hex string
    Dim hexHash As String
    For i = 0 To UBound(hashValue)
        hexHash = hexHash & Right("0" & Hex(hashValue(i)), 2)
    Next i

    CalculateSHA256Hash = hexHash
End Function

Private Sub Form_Load()
    ' Example usage
    MsgBox "SHA-256 Hash: " & CalculateSHA256Hash("Hello, World!")
End Sub