hermanlaksko
Programmer
I have the following code to handle hashstrings:
Code Start:
Option Compare Database
Option Explicit
#If Win64 Then
Private Declare PtrSafe 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 PtrSafe Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As LongPtr, ByVal Algid As LongPtr, ByVal hKey As LongPtr, ByVal dwFlags As LongPtr, ByRef phHash As Long) As Long
Private Declare PtrSafe Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As LongPtr) As Long
Private Declare PtrSafe Function CryptHashData Lib "advapi32.dll" (ByVal hHash As LongPtr, pbData As Any, ByVal dwDataLen As LongPtr, ByVal dwFlags As Long) As Long
Private Declare PtrSafe 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
#Else
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
#End If
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 HashAlgorithm
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, hHash As Long, lRes As Long, lLen As Long, lIdx As Long, 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
CryptDestroyHash hHash
End If
End If
CryptReleaseContext hCtx, 0
If lRes = 0 Then Err.Raise Err.LastDllError
End Function
End code
The code works fine in 32bit, the first iRes returns a 1 as it should, but when it gets to "lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)" it returns a 0 in stead of the 1, and likewise for the following iRes.
I have tryed to have different Dim sections for 64bit and 32bit, but no change, in 32 it works fine but fails in 64.
I have googled for help but find nothing to enlighten me...
Code Start:
Option Compare Database
Option Explicit
#If Win64 Then
Private Declare PtrSafe 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 PtrSafe Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As LongPtr, ByVal Algid As LongPtr, ByVal hKey As LongPtr, ByVal dwFlags As LongPtr, ByRef phHash As Long) As Long
Private Declare PtrSafe Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As LongPtr) As Long
Private Declare PtrSafe Function CryptHashData Lib "advapi32.dll" (ByVal hHash As LongPtr, pbData As Any, ByVal dwDataLen As LongPtr, ByVal dwFlags As Long) As Long
Private Declare PtrSafe 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
#Else
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
#End If
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 HashAlgorithm
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, hHash As Long, lRes As Long, lLen As Long, lIdx As Long, 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
CryptDestroyHash hHash
End If
End If
CryptReleaseContext hCtx, 0
If lRes = 0 Then Err.Raise Err.LastDllError
End Function
End code
The code works fine in 32bit, the first iRes returns a 1 as it should, but when it gets to "lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)" it returns a 0 in stead of the 1, and likewise for the following iRes.
I have tryed to have different Dim sections for 64bit and 32bit, but no change, in 32 it works fine but fails in 64.
I have googled for help but find nothing to enlighten me...