473,325 Members | 2,860 Online
Bytes | Software Development & Data Engineering Community
Post Job

Home Posts Topics Members FAQ

Join Bytes to post your question to a community of 473,325 software developers and data experts.

My VBA MD5 function returns 16 characters instead of 32?

2
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:
Expand|Select|Wrap|Line Numbers
  1. Private Declare Function CryptAcquireContext Lib "advapi32.dll" _
  2.     Alias "CryptAcquireContextA" ( _
  3.     ByRef phProv As Long, _
  4.     ByVal pszContainer As String, _
  5.     ByVal pszProvider As String, _
  6.     ByVal dwProvType As Long, _
  7.     ByVal dwFlags As Long) As Long
  8.  
  9.  
  10. Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _
  11.     ByVal hProv As Long, _
  12.     ByVal dwFlags As Long) As Long
  13.  
  14.  
  15. Private Declare Function CryptCreateHash Lib "advapi32.dll" ( _
  16.     ByVal hProv As Long, _
  17.     ByVal Algid As Long, _
  18.     ByVal hKey As Long, _
  19.     ByVal dwFlags As Long, _
  20.     ByRef phHash As Long) As Long
  21.  
  22.  
  23. Private Declare Function CryptDestroyHash Lib "advapi32.dll" ( _
  24.     ByVal hHash As Long) As Long
  25.  
  26.  
  27. Private Declare Function CryptHashData Lib "advapi32.dll" ( _
  28.     ByVal hHash As Long, _
  29.     pbData As Any, _
  30.     ByVal dwDataLen As Long, _
  31.     ByVal dwFlags As Long) As Long
  32.  
  33.  
  34. Private Declare Function CryptGetHashParam Lib "advapi32.dll" ( _
  35.     ByVal hHash As Long, _
  36.     ByVal dwParam As Long, _
  37.     pbData As Any, _
  38.     pdwDataLen As Long, _
  39.     ByVal dwFlags As Long) As Long
  40.  
  41.  
  42. Private Const PROV_RSA_FULL As Long = 1
  43.  
  44.  
  45. Private Const ALG_CLASS_HASH = 32768
  46.  
  47.  
  48. Private Const ALG_TYPE_ANY = 0
  49.  
  50. Private Const ALG_SID_MD2 = 1
  51. Private Const ALG_SID_MD4 = 2
  52. Private Const ALG_SID_MD5 = 3
  53. Private Const ALG_SID_SHA1 = 4
  54.  
  55.  
  56. Enum HashAlgorithm2
  57.   md2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
  58.   md4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
  59.   MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
  60.   SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
  61. End Enum
  62.  
  63. 'The other block of code that has the delcare statements
  64.  
  65. Private Const HP_HASHVAL = 2
  66. Private Const HP_HASHSIZE = 4
  67.  
  68.  
  69. Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000
  70.  
  71. Function HashString(ByVal Str As String, Optional ByVal Algorithm As HashAlgorithm = MD5) As String
  72.  
  73. '' THIS IS THE PASSWORD CRYPTO MODULE
  74.  
  75. Dim hCtx As Long
  76. Dim hHash As Long
  77. Dim lRes As Long
  78. Dim lLen As Long
  79. Dim lIdx As Long
  80. Dim abData() As Byte
  81.  
  82. lRes = CryptAcquireContext(hCtx, vbNullString, _
  83.     vbNullString, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)
  84. If lRes <> 0 Then
  85.   lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)
  86.   If lRes <> 0 Then
  87.     lRes = CryptHashData(hHash, ByVal Str, Len(Str), 0)
  88.     If lRes <> 0 Then
  89.       lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)
  90.       If lRes <> 0 Then
  91.         ReDim abData(0 To lLen - 1)
  92.         lRes = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0)
  93.         If lRes <> 0 Then
  94.           HashString = StrConv(abData, vbUnicode)
  95.         End If
  96.       End If
  97.     End If
  98.     CryptDestroyHash hHash
  99.   End If
  100. End If
  101. CryptReleaseContext hCtx, 0
  102. If lRes = 0 Then Err.Raise Err.LastDllError
  103.  
  104. End Function
  105.  
----------------------------------------------------------------------------------------------
Expand|Select|Wrap|Line Numbers
  1. Sub test()
  2.   a = "test"
  3.   Debug.Print HashString(a)
  4.   Debug.Print Len(HashString(a))
  5. End Sub
RETURNS:
kF!sN&'
16
Sep 13 '06 #1
9 11153
trini
2
---------------------------------------------------------------------------------
The following code converts the 16-hexadecimal hashkey to a 32-character one:
Expand|Select|Wrap|Line Numbers
  1. txtUSERPWD_hash = HashString(TextLine)
  2. For i = 1 To 16
  3.     c = Asc(Mid(txtUSERPWD_hash, i, 1))
  4.     strHash = strHash + Hex(c)
  5. Next i
Sep 18 '06 #2
You'd better use this instead
Expand|Select|Wrap|Line Numbers
  1. For i = 1 To 16
  2.     c = Asc(Mid(txtUSERPWD_hash, i, 1))
  3.     strHash = strHash + Format(Hex(c), "00") 
  4. 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%.
Feb 27 '07 #3
drbob
4
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%.
I'm stil finding some mismatch with "help" php md5 give:
657f8b8da628ef83cf69101b6817150a
and vba give's
657f8b8da628ef83cf69101b681715a

so i'm missing a 0
Mar 1 '07 #4
Killer42
8,435 Expert 8TB
I'm stil finding some mismatch with "help" php md5 give:
657f8b8da628ef83cf69101b6817150a
and vba give's
657f8b8da628ef83cf69101b681715a
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).
Mar 1 '07 #5
drbob
4
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?

Expand|Select|Wrap|Line Numbers
  1. For i = 1 To 16
  2. c = Asc(Mid(hash_finished, i, 1))
  3. strHash = strHash + Format(Right$("0" & Hex$(c), 2))
  4. Next i
then i get this output:
657f8b8da628ef83cf69101b6817150:00:00

where i want this:
657f8b8da628ef83cf69101b6817150a

again with the word help
Mar 1 '07 #6
Killer42
8,435 Expert 8TB
I think this would be closer to what you want...
Expand|Select|Wrap|Line Numbers
  1. For i = 1 To 16
  2.   c = Asc(Mid(hash_finished, i, 1))
  3.   strHash = strHash & Right$("0" & Hex$(c), 2)
  4. Next i
Mar 1 '07 #7
drbob
4
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
Mar 1 '07 #8
Killer42
8,435 Expert 8TB
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.
Mar 1 '07 #9
on this line
Expand|Select|Wrap|Line Numbers
  1. 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.
Jun 4 '10 #10

Sign in to post your reply or Sign up for a free account.

Similar topics

9
by: Penn Markham | last post by:
Hello all, I am writing a script where I need to use the system() function to call htpasswd. I can do this just fine on the command line...works great (see attached file, test.php). When my...
4
by: Mark Reed | last post by:
HI all, I have an Access XP database which on the whole, uses information pasted into 1 table from a text file. I then have another query which uses the 'Mid' function to break it down. One of the...
15
by: Eirik | last post by:
This is a little function I wrote, inspired by the thread "Urgent HELP! required for Caesar Cipher PLEASE" $ cat /home/keisar/bin/c/ymse/rot13.h char rot13(char character) { int changed;...
2
by: Fernando Barsoba | last post by:
Hi all, I'm trying to read from a binary file, and I'm using 'fread()' as indicated in function 'getfile()'. The variable 'bytesread' shows that I have read the 557,000 bytes from the file, but...
0
by: RobertoP | last post by:
Hello, I am trying to create a simple Oracle application that queries some data from Oracle. The problem is that it randomly returns trailing \0s instead of the characters of a string. ...
0
by: RobertoP | last post by:
Hello, I am trying to create a simple Oracle application that queries some data from Oracle. The problem is that it randomly returns trailing \0s instead of the characters of a string. ...
5
by: Sakharam Phapale | last post by:
Hi All, I am using an API function, which takes file path as an input. When file path contains special characters (@,#,$,%,&,^, etc), API function gives an error as "Unable to open input file"....
8
by: ais523 | last post by:
I use this function that I wrote for inputting strings. It's meant to return a pointer to mallocated memory holding one input string, or 0 on error. (Personally, I prefer to use 0 to NULL when...
22
by: Andrew Poelstra | last post by:
int gets_ws (char *buff, int maxlen, int sc, FILE *fh); This function reads up to maxlen characters from fh, stopping when it encounters whitespace, sc, or EOF. If EOF is encountered, the...
0
by: ryjfgjl | last post by:
ExcelToDatabase: batch import excel into database automatically...
0
isladogs
by: isladogs | last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM). In this month's session, we are pleased to welcome back...
1
isladogs
by: isladogs | last post by:
The next Access Europe meeting will be on Wednesday 6 Mar 2024 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM). In this month's session, we are pleased to welcome back...
0
by: Vimpel783 | last post by:
Hello! Guys, I found this code on the Internet, but I need to modify it a little. It works well, the problem is this: Data is sent from only one cell, in this case B5, but it is necessary that data...
0
by: jfyes | last post by:
As a hardware engineer, after seeing that CEIWEI recently released a new tool for Modbus RTU Over TCP/UDP filtering and monitoring, I actively went to its official website to take a look. It turned...
1
by: CloudSolutions | last post by:
Introduction: For many beginners and individual users, requiring a credit card and email registration may pose a barrier when starting to use cloud servers. However, some cloud server providers now...
1
by: Shllpp 09 | last post by:
If u are using a keypad phone, how do u turn on JavaScript, to access features like WhatsApp, Facebook, Instagram....
0
by: af34tf | last post by:
Hi Guys, I have a domain whose name is BytesLimited.com, and I want to sell it. Does anyone know about platforms that allow me to list my domain in auction for free. Thank you
0
by: Faith0G | last post by:
I am starting a new it consulting business and it's been a while since I setup a new website. Is wordpress still the best web based software for hosting a 5 page website? The webpages will be...

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.