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:
kF!sN&'
16
9 11153
---------------------------------------------------------------------------------
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
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%.
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
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).
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:
657f8b8da628ef83cf69101b6817150:00:00
where i want this:
657f8b8da628ef83cf69101b6817150a
again with the word help
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
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
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.
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.
Sign in to post your reply or Sign up for a free account.
Similar topics
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...
|
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...
|
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;...
|
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...
|
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.
...
|
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.
...
|
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"....
|
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...
|
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...
|
by: ryjfgjl |
last post by:
ExcelToDatabase: batch import excel into database automatically...
|
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...
|
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...
|
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...
|
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...
|
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...
|
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....
|
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
|
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...
| |