Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations MikeeOK on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Hash encryption 64 bit

hermanlaksko

Programmer
Aug 26, 2001
945
DK
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...
 
Try the following:

Rich (BB code):
Public Function Hashit(strPassword As String) As String
    Dim oEnc As Object
    
    Dim Source() As Byte
    Source = StrConv(strPassword, vbFromUnicode)
  
    Set oEnc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider") 'or SHA256Managed or SHA512Managed   amongst others
    Source = oEnc.ComputeHash_2((Source))
  
    Hashit = StrConv(Source, vbUnicode)
    
End Function
 
(and of course if you want a proper digest, then this function may help
Rich (BB code):
Public Function hexdigest(bytearray) As String
    Dim lp As Long
    For lp = 0 To UBound(bytearray)
        hexdigest = hexdigest & Right("00" & Hex(bytearray(lp)), 2)
    Next
End Function
)
 

Part and Inventory Search

Sponsor

Back
Top