Convert String to MD5 Hash

[mintz]

I have this string
71140553442112312345ABCDE

I want to convert it to MD5 Hash
efd49dfb22292d6c42c0941f08cc4717

I found this function that converts takes the string from a file but in my case the string is stored in a variable

How do I edit the function so the input is a String rather than a File?

 

[JLalonde]

Sorry, I missed the info in the comment. It worked perfectly.

Now, I'll have to work on the the AHK function to get the same result with UTF-8 chars.

Thanks a lot, pgc ! If whenever you are interest in my app Quick Access Popup, let me know and I'll be happy to send you a sponsor code to thank you.

Jean

 

[pgc01]

I'm glad it helped Thanks for the feedback and thank you for the offer.

 

[JLalonde]

Hi pgc01,

I was back on this topic today and tried to use your function but found that the result from your function modified for testing ASCII 287 (renamed StringToMD5HexTest in the code below) is different from the result of the unmodified function used by passing the same value ChrW(287) as parameter. Normally, this should produce the same result, no?

The result of StringToMD5HexTest() is the same as online MD5 tools: 1f4707e216e56f3385d7be592b694bf6
The result passing the value as parameter to StringToMD5Hex() is different: b2f5ff47436671b6e533d8dc3614845d

Do you have the same results? Is there something wrong the way the "s" parameter is processed?

I'm using MS Excel 2016 MSO (16.0.43849.1000) 32 bits if this can make a difference.

Thanks.

Sub TestMD5()Dim s As String

    MsgBox ChrW(287)
    MsgBox StringToMD5HexTest(s) ' the parameter s is not used in this test
    MsgBox StringToMD5Hex(ChrW(287))

End Sub


Function StringToMD5HexTest(ByVal s As String) As String
Dim enc As Object
Dim bytes() As Byte
Dim pos As Long
Dim outstr As String

Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")

'bytes = StrConv(s, vbFromUnicode)
' test for character 287 = HC4 H9F
ReDim bytes(0 To 1) As Byte
bytes(0) = &HC4
bytes(1) = &H9F
bytes = enc.ComputeHash_2(bytes)

For pos = 1 To UBound(bytes) + 1
   outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2))
Next pos

StringToMD5HexTest = outstr
Set enc = Nothing
End Function




Function StringToMD5Hex(ByVal s As String) As String
Dim enc As Object
Dim bytes() As Byte
Dim pos As Long
Dim outstr As String

Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")

bytes = StrConv(s, vbFromUnicode)
bytes = enc.ComputeHash_2(bytes)

For pos = 1 To UBound(bytes) + 1
   outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2))
Next pos

StringToMD5Hex = outstr
Set enc = Nothing
End Function

 

[Fennek]

Hi,

try this

$someString = "Hello, World!"
$md5 = New-Object -TypeName System.Security.Cryptography.MD5CryptoServiceProvider
$utf8 = New-Object -TypeName System.Text.UTF8Encoding
$hash = [System.BitConverter]::ToString($md5.ComputeHash($utf8.GetBytes($someString)))
$hash

(Powershell)

 

[JLalonde]

Hi Fennek,

Thanks for the input but I need this to work in VBA for XL.

 

[John_w]

Hi pgc01,

I was back on this topic today and tried to use your function but found that the result from your function modified for testing ASCII 287 (renamed StringToMD5HexTest in the code below) is different from the result of the unmodified function used by passing the same value ChrW(287) as parameter. Normally, this should produce the same result, no?

The result of StringToMD5HexTest() is the same as online MD5 tools: 1f4707e216e56f3385d7be592b694bf6
The result passing the value as parameter to StringToMD5Hex() is different: b2f5ff47436671b6e533d8dc3614845d

Do you have the same results? Is there something wrong the way the "s" parameter is processed?

I'm using MS Excel 2016 MSO (16.0.43849.1000) 32 bits if this can make a difference.

Thanks.

I'm also using Excel 2016 32-bit and get the same results as you. The problem is that the StrConv function is unable to convert all Unicode characters to UTF-8 encoded bytes. There is a good explanation of this issue at https://www.di-mgt.com.au/howto-convert-vba-unicode-to-utf8.html, along with the function Utf8BytesFromString which correctly converts all Unicode characters to UTF-8 bytes, and should be called instead of StrConv.

Here is the complete code, including 2 declarations of the WideCharToMultiByte API function compatible with the old Excel VBA6 compiler and the latest VBA7 compiler on both 32-bit and 64-bit Excel.

Option Explicit

''' WinApi function that maps a UTF-16 (wide character) string to a new character string

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    'New VBA version 7 compiler, therefore >= Office 2010
    'PtrSafe means function works in 32-bit and 64-bit Office
    'LongPtr type alias resolves to Long (32 bits) in 32-bit Office, or LongLong (64 bits) in 64-bit Office
    Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( _
        ByVal CodePage As Long, _
        ByVal dwFlags As Long, _
        ByVal lpWideCharStr As LongPtr, _
        ByVal cchWideChar As Long, _
        ByVal lpMultiByteStr As LongPtr, _
        ByVal cbMultiByte As Long, _
        ByVal lpDefaultChar As LongPtr, _
        ByVal lpUsedDefaultChar As LongPtr) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    'Old VBA version 6 or earlier compiler, therefore <= Office 2007
    Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
        ByVal CodePage As Long, _
        ByVal dwFlags As Long, _
        ByVal lpWideCharStr As Long, _
        ByVal cchWideChar As Long, _
        ByVal lpMultiByteStr As Long, _
        ByVal cbMultiByte As Long, _
        ByVal lpDefaultChar As Long, _
        ByVal lpUsedDefaultChar As Long) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

' CodePage constant for UTF-8
Private Const CP_UTF8 = 65001


Sub TestMD5()
    Dim s As String

    Debug.Print StringToMD5HexTest(s) ' the parameter s is not used in this test
    Debug.Print StringToMD5Hex(ChrW(287))

End Sub


Function StringToMD5HexTest(ByVal s As String) As String
    Dim enc As Object
    Dim bytes() As Byte
    Dim pos As Long
    Dim outstr As String
    
    Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    
    'bytes = StrConv(s, vbFromUnicode)
    ' test for character 287 = HC4 H9F
    ReDim bytes(0 To 1) As Byte
    bytes(0) = &HC4
    bytes(1) = &H9F
    bytes = enc.ComputeHash_2(bytes)
    
    For pos = 1 To UBound(bytes) + 1
       outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2))
    Next pos
    
    StringToMD5HexTest = outstr
    Set enc = Nothing
End Function


Function StringToMD5Hex(ByVal s As String) As String
    Dim enc As Object
    Dim bytes() As Byte
    Dim pos As Long
    Dim outstr As String
    
    Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    
    bytes = Utf8BytesFromString(s)
    bytes = enc.ComputeHash_2(bytes)
    
    For pos = 1 To UBound(bytes) + 1
       outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2))
    Next pos
    
    StringToMD5Hex = outstr
    Set enc = Nothing
End Function


'https://www.di-mgt.com.au/howto-convert-vba-unicode-to-utf8.html
''' Return byte array with VBA "Unicode" string encoded in UTF-8
Public Function Utf8BytesFromString(strInput As String) As Byte()
    Dim nBytes As Long
    Dim abBuffer() As Byte
    ' Catch empty or null input string
    Utf8BytesFromString = vbNullString
    If Len(strInput) < 1 Then Exit Function
    ' Get length in bytes *including* terminating null
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, 0&, 0&, 0&, 0&)
    ' We don't want the terminating null in our byte array, so ask for 'nBytes-1' bytes
    ReDim abBuffer(nBytes - 2)  ' NB ReDim with one less byte than you need
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
    Utf8BytesFromString = abBuffer
End Function

 

[JLalonde]

I'm also using Excel 2016 32-bit and get the same results as you. The problem is that the StrConv function is unable to convert all Unicode characters to UTF-8 encoded bytes. There is a good explanation of this issue at https://www.di-mgt.com.au/howto-convert-vba-unicode-to-utf8.html, along with the function Utf8BytesFromString which correctly converts all Unicode characters to UTF-8 bytes, and should be called instead of StrConv.

Here is the complete code, including 2 declarations of the WideCharToMultiByte API function compatible with the old Excel VBA6 compiler and the latest VBA7 compiler on both 32-bit and 64-bit Excel.

Thanks John for posting this. This works perfectly. I now have a complete solution on both ends of my project (XL and AHK).

For the record, here are the two functions allowing to hash UTF-8 strings with identical MD5 results on both platforms.

Excel VBA (Office 2016) - Module header

Option Explicit

''' WinApi function that maps a UTF-16 (wide character) string to a new character string
' source: https://www.mrexcel.com/forum/excel-questions/973381-convert-string-md5-hash-post5368393.html#post5368393


'New VBA version 7 compiler, therefore >= Office 2010
'PtrSafe means function works in 32-bit and 64-bit Office
'LongPtr type alias resolves to Long (32 bits) in 32-bit Office, or LongLong (64 bits) in 64-bit Office
Private Declare PtrSafe Function WideCharToMultiByte Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpWideCharStr As LongPtr, _
    ByVal cchWideChar As Long, _
    ByVal lpMultiByteStr As LongPtr, _
    ByVal cbMultiByte As Long, _
    ByVal lpDefaultChar As LongPtr, _
    ByVal lpUsedDefaultChar As LongPtr) As Long


' CodePage constant for UTF-8
Private Const CP_UTF8 = 65001

VBA Functions (I renamed StringToMD5Hex to StringToMD5HexUtf8)

Function StringToMD5HexUtf8(ByVal s As String) As String' https://www.mrexcel.com/forum/excel-questions/973381-convert-string-md5-hash-post5368393.html#post5368393
    Dim enc As Object
    Dim bytes() As Byte
    Dim pos As Long
    Dim outstr As String
    
    Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    
    bytes = Utf8BytesFromString(s)
    bytes = enc.ComputeHash_2(bytes)
    
    For pos = 1 To UBound(bytes) + 1
       outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2))
    Next pos
    
    StringToMD5HexUtf8 = outstr
    Set enc = Nothing
End Function

''' Return byte array with VBA "Unicode" string encoded in UTF-8
' source: https://www.mrexcel.com/forum/excel-questions/973381-convert-string-md5-hash-post5368393.html#post5368393
Public Function Utf8BytesFromString(strInput As String) As Byte()
    Dim nBytes As Long
    Dim abBuffer() As Byte
    ' Catch empty or null input string
    Utf8BytesFromString = vbNullString
    If Len(strInput) < 1 Then Exit Function
    ' Get length in bytes *including* terminating null
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, 0&, 0&, 0&, 0&)
    ' We don't want the terminating null in our byte array, so ask for 'nBytes-1' bytes
    ReDim abBuffer(nBytes - 2)  ' NB ReDim with one less byte than you need
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
    Utf8BytesFromString = abBuffer
End Function

AutoHotkey function

bcrypt_md5(string, encoding := "utf-8")
; from jNizM (https://www.autohotkey.com/boards/viewtopic.php?t=23413 / https://github.com/jNizM/AHK_CNG/tree/master/src/hash/func)
{
    static BCRYPT_MD5_ALGORITHM := "MD5"
    static BCRYPT_OBJECT_LENGTH := "ObjectLength"
    static BCRYPT_HASH_LENGTH   := "HashDigestLength"

    try
    {
        ; loads the specified module into the address space of the calling process
        if !(hBCRYPT := DllCall("LoadLibrary", "str", "bcrypt.dll", "ptr"))
            throw Exception("Failed to load bcrypt.dll", -1)

        ; open an algorithm handle
        if (NT_STATUS := DllCall("bcrypt\BCryptOpenAlgorithmProvider", "ptr*", hAlg, "ptr", &BCRYPT_MD5_ALGORITHM, "ptr", 0, "uint", 0) != 0)
            throw Exception("BCryptOpenAlgorithmProvider: " NT_STATUS, -1)

        ; calculate the size of the buffer to hold the hash object
        if (NT_STATUS := DllCall("bcrypt\BCryptGetProperty", "ptr", hAlg, "ptr", &BCRYPT_OBJECT_LENGTH, "uint*", cbHashObject, "uint", 4, "uint*", cbData, "uint", 0) != 0)
            throw Exception("BCryptGetProperty: " NT_STATUS, -1)

        ; allocate the hash object
        VarSetCapacity(pbHashObject, cbHashObject, 0)
        ;    throw Exception("Memory allocation failed", -1)

        ; calculate the length of the hash
        if (NT_STATUS := DllCall("bcrypt\BCryptGetProperty", "ptr", hAlg, "ptr", &BCRYPT_HASH_LENGTH, "uint*", cbHash, "uint", 4, "uint*", cbData, "uint", 0) != 0)
            throw Exception("BCryptGetProperty: " NT_STATUS, -1)

        ; allocate the hash buffer
        VarSetCapacity(pbHash, cbHash, 0)
        ;    throw Exception("Memory allocation failed", -1)

        ; create a hash
        if (NT_STATUS := DllCall("bcrypt\BCryptCreateHash", "ptr", hAlg, "ptr*", hHash, "ptr", &pbHashObject, "uint", cbHashObject, "ptr", 0, "uint", 0, "uint", 0) != 0)
            throw Exception("BCryptCreateHash: " NT_STATUS, -1)

        ; hash some data
        VarSetCapacity(pbInput, (StrPut(string, encoding) - 1) * ((encoding = "utf-16" || encoding = "cp1200") ? 2 : 1), 0) && cbInput := StrPut(string, &pbInput, encoding) - 1
        if (NT_STATUS := DllCall("bcrypt\BCryptHashData", "ptr", hHash, "ptr", &pbInput, "uint", cbInput, "uint", 0) != 0)
            throw Exception("BCryptHashData: " NT_STATUS, -1)

        ; close the hash
        if (NT_STATUS := DllCall("bcrypt\BCryptFinishHash", "ptr", hHash, "ptr", &pbHash, "uint", cbHash, "uint", 0) != 0)
            throw Exception("BCryptFinishHash: " NT_STATUS, -1)

        loop % cbHash
            hash .= Format("{:02x}", NumGet(pbHash, A_Index - 1, "uchar"))
    }
    catch exception
    {
        ; represents errors that occur during application execution
        throw Exception
    }
    finally
    {
        ; cleaning up resources
        if (pbInput)
            VarSetCapacity(pbInput, 0)
        if (hHash)
            DllCall("bcrypt\BCryptDestroyHash", "ptr", hHash)
        if (pbHash)
            VarSetCapacity(pbHash, 0)
        if (pbHashObject)
            VarSetCapacity(pbHashObject, 0)
        if (hAlg)
            DllCall("bcrypt\BCryptCloseAlgorithmProvider", "ptr", hAlg, "uint", 0)
        if (hBCRYPT)
            DllCall("FreeLibrary", "ptr", hBCRYPT)
    }

    return hash
}

This has been tested with a variety of UTF-8 strings including Extended ASCII chars in the range 128-255 like e acute (as in "Bérubé") and 2-byte chars like n acute (as in "Bieńko") or accentuated g (as in "Doğan"). This only pitfall I encountered is not linked to the above code but the use of the Trim function in VBA or AHK when a string ends with a non-breakable space (ASCII 160). The standard VBA/AHK Trim() functions do not catch this invisible char. Make sure to remove it if you want to hash a word without its surrounding invisible chars (space, tab or non-breakable space). This is easy with AHK (there is an option for the Trim() function) but, AFAIK, this required a little more work on the VBA side.