My VBA MD5 function returns 16 characters instead of 32?

[trini]

hi there,

I found this code on your forum for which I am glad because I can use it pretty well IF there's a way to alter it and get a 32-character hashcode instead of 16! Anybody knows what's wrong here?

Thnx
------------------------------------------------------------------------------------------------------------
Working Code:

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 dwDataLen 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, _
    pdwDataLen As Long, _
    ByVal dwFlags As Long) As Long


Private Const PROV_RSA_FULL As Long = 1


Private Const ALG_CLASS_HASH = 32768


Private Const ALG_TYPE_ANY = 0

Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4


Enum HashAlgorithm2
  md2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
  md4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
  MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
  SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
End Enum

'The other block of code that has the delcare statements

Private Const HP_HASHVAL = 2
Private Const HP_HASHSIZE = 4


Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000

Function HashString(ByVal Str As String, Optional ByVal Algorithm As HashAlgorithm = MD5) As String

'' THIS IS THE PASSWORD CRYPTO MODULE

Dim hCtx As Long
Dim hHash As Long
Dim lRes As Long
Dim lLen As Long
Dim lIdx As Long
Dim abData() As Byte

lRes = CryptAcquireContext(hCtx, vbNullString, _
    vbNullString, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)
If lRes <> 0 Then
  lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)
  If lRes <> 0 Then
    lRes = CryptHashData(hHash, ByVal Str, Len(Str), 0)
    If lRes <> 0 Then
      lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)
      If lRes <> 0 Then
        ReDim abData(0 To lLen - 1)
        lRes = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0)
        If lRes <> 0 Then
          HashString = StrConv(abData, vbUnicode)
        End If
      End If
    End If
    CryptDestroyHash hHash
  End If
End If
CryptReleaseContext hCtx, 0
If lRes = 0 Then Err.Raise Err.LastDllError

End Function

----------------------------------------------------------------------------------------------

Sub test()
  a = "test"
  Debug.Print HashString(a)
  Debug.Print Len(HashString(a))
End Sub

RETURNS:
kÍF!ÓsÊÞNƒ&'´ö
16

[trini]

---------------------------------------------------------------------------------
The following code converts the 16-hexadecimal hashkey to a 32-character one:

txtUSERPWD_hash = HashString(TextLine)
For i = 1 To 16
    c = Asc(Mid(txtUSERPWD_hash, i, 1))
    strHash = strHash + Hex(c)
Next i

[fbakhache]

You'd better use this instead

For i = 1 To 16
    c = Asc(Mid(txtUSERPWD_hash, i, 1))
    strHash = strHash + Format(Hex(c), "00") 
Next i

where the format function adds a leading 0 when it is omitted in the hexadecimal number. So without formatting it won't work 100%.

[drbob]

You'd better use this instead

For i = 1 To 16
c = Asc(Mid(txtUSER PWD_hash, i, 1))
strHash = strHash + Format(Hex(c), "00")
Next i

where the format function adds a leading 0 when it is omitted in the hexadecimal number. So without formatting it won't work 100%.

I'm stil finding some mismatch with "help" php md5 give:
657f8b8da628ef8 3cf69101b681715 0a
and vba give's
657f8b8da628ef8 3cf69101b681715 a

so i'm missing a 0

[Killer42]

I'm stil finding some mismatch with "help" php md5 give:
657f8b8da628ef8 3cf69101b681715 0a
and vba give's
657f8b8da628ef8 3cf69101b681715 a
so i'm missing a 0

I'm not surprised. Format doesn't work in this case, so you'd be missing every leading zero. The "0A" at the end just happens to be the first one you hit. Another possibility would be to use Right$("0"&Hex$ (c),2).

[drbob]

I'm not surprised. Format doesn't work in this case, so you'd be missing every leading zero. The "0A" at the end just happens to be the first one you hit. Another possibility would be to use Right$("0"&Hex$ (c),2).

i guess that i should use it this way?

For i = 1 To 16
c = Asc(Mid(hash_finished, i, 1))
strHash = strHash + Format(Right$("0" & Hex$(c), 2))
Next i

then i get this output:
657f8b8da628ef8 3cf69101b681715 0:00:00

where i want this:
657f8b8da628ef8 3cf69101b681715 0a

again with the word help

[Killer42]

I think this would be closer to what you want...

For i = 1 To 16
  c = Asc(Mid(hash_finished, i, 1))
  strHash = strHash & Right$("0" & Hex$(c), 2)
Next i

[drbob]

Thanks, i've been testing for a while, and there the same as from the php script.
It was nice that you could help me so fast.

Bob

[Killer42]

Thanks, i've been testing for a while, and there the same as from the php script.
It was nice that you could help me so fast.

Well, rapid development was always the strength of VB. :)

Glad we could help.

[lee weaver]

I am trying to implement this code also

on this line

Function HashString(ByVal Str As String, Optional ByVal Algorithm As HashAlgorithm = MD5) As String

i'm getting the error User defined type not defined.

I copied the entire code block at the top and placed it in it's own module.