[Stephen Bullen[_3_]]

Hi Ale,

i need i cell to get the Hash (MD5) value of a group of cells..

I just knocked this up from some similar code I did a while ago. The function can be called from a worksheet, giving it a range of cells.
Note that this routine puts the contents of each cell in a Variant, then adds the byte representation of the variant to the MD5 hash - so
for example if you calculate an MD5 hash for a specific string in another manner, it won't agree with this one, as this includes all the
extra stuff that's contained in a Variant. And watch out for word-wrap!

Regards

Stephen Bullen
Microsoft MVP - Excel
www.BMSLtd.co.uk


======================================
Option Explicit

Declare Function CryptAcquireContext Lib "advapi32" Alias "CryptAcquireContextA" (ByRef hProv As Long, ByVal sContainer As String, _
ByVal sProvider As String, ByVal lProvType As Long, ByVal lFlags As Long) As Long

Declare Function CryptCreateHash Lib "advapi32" (ByVal hProv As Long, ByVal lALG_ID As Long, _
ByVal hKey As Long, ByVal lFlags As Long, ByRef hHash As Long) As Long

Declare Function CryptHashData Lib "advapi32" (ByVal hHash As Long, ByVal lDataPtr As Long, ByVal lLen As Long, ByVal lFlags As Long) As
Long

Declare Function CryptGetHashParam Lib "advapi32" (ByVal hHash As Long, ByVal lParam As Long, ByVal sBuffer As String, _
ByRef lLen As Long, ByVal lFlags As Long) As Long

Declare Function CryptDestroyHash Lib "advapi32" (ByVal hHash As Long) As Long

Declare Function CryptReleaseContext Lib "advapi32" (ByVal hProv As Long, ByVal lFlags As Long) As Long

Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
Const PROV_RSA_FULL As Long = 1
Const CRYPT_NEWKEYSET As Long = 8
Const CALG_MD5 As Long = 32771
Const HP_HASHVAL As Long = 2

Public Function GetMD5Hash(rngData As Range) As String

Dim hProv As Long
Dim hHash As Long
Dim lLen As Long
Dim oCell As Range
Dim baData() As Byte
Dim sBuffer As String
Dim vValue As Variant
Dim lResult As Long

'Get/create a cryptography context
CryptAcquireContext hProv, vbNullString, MS_DEF_PROV, PROV_RSA_FULL, 0
If hProv = 0 Then
CryptAcquireContext hProv, vbNullString, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_NEWKEYSET
End If

'If we got one...
If hProv < 0 Then

'Create an MD5 Hash
CryptCreateHash hProv, CALG_MD5, 0, 0, hHash

'If that was OK...
If hHash < 0 Then

'Fill it with the contents of the range
For Each oCell In rngData.Cells
If Not IsEmpty(oCell.Value) Then
vValue = oCell.Value
lResult = CryptHashData(hHash, VarPtr(vValue), LenB(vValue), 0&)
End If
Next

'Create a buffer to store the hash value
sBuffer = Space(30)
lLen = 30

'Get the hash value
CryptGetHashParam hHash, HP_HASHVAL, sBuffer, lLen, 0

'Return the hash value
GetMD5Hash = Left$(sBuffer, lLen)

'Tidy up
CryptDestroyHash hHash
End If

'Tidy up
CryptReleaseContext hProv, 0
End If

End Function

[[email protected]]

Thank you for this solution!

However, this doesn't appear to work for Win7x64 or 64bit office (not sure which is causing the problem, the OS or the Office suite).

Is a simple search & replace on 32 - 64 likely to work?

On Thursday, February 5, 2004 1:50:20 PM UTC-7, Stephen Bullen wrote:
Hi Ale,

i need i cell to get the Hash (MD5) value of a group of cells..

I just knocked this up from some similar code I did a while ago. The function can be called from a worksheet, giving it a range of cells.
Note that this routine puts the contents of each cell in a Variant, then adds the byte representation of the variant to the MD5 hash - so
for example if you calculate an MD5 hash for a specific string in another manner, it won't agree with this one, as this includes all the
extra stuff that's contained in a Variant. And watch out for word-wrap!

Regards

Stephen Bullen
Microsoft MVP - Excel
www.BMSLtd.co.uk


======================================
Option Explicit

Declare Function CryptAcquireContext Lib "advapi32" Alias "CryptAcquireContextA" (ByRef hProv As Long, ByVal sContainer As String, _
ByVal sProvider As String, ByVal lProvType As Long, ByVal lFlags As Long) As Long

Declare Function CryptCreateHash Lib "advapi32" (ByVal hProv As Long, ByVal lALG_ID As Long, _
ByVal hKey As Long, ByVal lFlags As Long, ByRef hHash As Long) As Long

Declare Function CryptHashData Lib "advapi32" (ByVal hHash As Long, ByVal lDataPtr As Long, ByVal lLen As Long, ByVal lFlags As Long) As
Long

Declare Function CryptGetHashParam Lib "advapi32" (ByVal hHash As Long, ByVal lParam As Long, ByVal sBuffer As String, _
ByRef lLen As Long, ByVal lFlags As Long) As Long

Declare Function CryptDestroyHash Lib "advapi32" (ByVal hHash As Long) As Long

Declare Function CryptReleaseContext Lib "advapi32" (ByVal hProv As Long, ByVal lFlags As Long) As Long

Const MS_DEF_PROV = "Microsoft Base Cryptographic Provider v1.0"
Const PROV_RSA_FULL As Long = 1
Const CRYPT_NEWKEYSET As Long = 8
Const CALG_MD5 As Long = 32771
Const HP_HASHVAL As Long = 2

Public Function GetMD5Hash(rngData As Range) As String

Dim hProv As Long
Dim hHash As Long
Dim lLen As Long
Dim oCell As Range
Dim baData() As Byte
Dim sBuffer As String
Dim vValue As Variant
Dim lResult As Long

'Get/create a cryptography context
CryptAcquireContext hProv, vbNullString, MS_DEF_PROV, PROV_RSA_FULL, 0
If hProv = 0 Then
CryptAcquireContext hProv, vbNullString, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_NEWKEYSET
End If

'If we got one...
If hProv < 0 Then

'Create an MD5 Hash
CryptCreateHash hProv, CALG_MD5, 0, 0, hHash

'If that was OK...
If hHash < 0 Then

'Fill it with the contents of the range
For Each oCell In rngData.Cells
If Not IsEmpty(oCell.Value) Then
vValue = oCell.Value
lResult = CryptHashData(hHash, VarPtr(vValue), LenB(vValue), 0&)
End If
Next

'Create a buffer to store the hash value
sBuffer = Space(30)
lLen = 30

'Get the hash value
CryptGetHashParam hHash, HP_HASHVAL, sBuffer, lLen, 0

'Return the hash value
GetMD5Hash = Left$(sBuffer, lLen)

'Tidy up
CryptDestroyHash hHash
End If

'Tidy up
CryptReleaseContext hProv, 0
End If

End Function

[GS[_6_]]

As noted at the top, this is Robert Hubley's creation NOT mine. Glad,
though, that you were able to make use of it!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion