Re: Hash a range, output a Long Integer?

From: Stephen Rasey (raseysm_at_wiserways.com)
Date: 06/12/04


Date: Fri, 11 Jun 2004 22:59:54 -0500

Re the GetMD5Hash function in the root message.
I have an improved function wwGetMD5Hash below:

The problem with GetMD5Hash is I get the same hash if the cell value is
 "aaa" or "ccc", but it will be different if it is "aaaa". (see below for
a table of sample hashes).
The problem centers around VarPtr(vValue). I get better results with
StrPtr(sValue).

When I replace the following from GetMD5Hash:
            vValue = oCell.Value
            lResult = CryptHashData(hHash, VarPtr(vValue), LenB(vValue), 0&)

With:
            Dim sValue as String
            ...
If Not IsEmpty(oCell.Value) Then
                  sValue = CStr(oCell.Value)
'rasey o40611
                  lResult = CryptHashData(hHash, StrPtr(sValue),
LenB(sValue), 0&) 'rasey 040611

I get a hash that that changes on the content of the cells.

I think VarPtr(vValue) must be returning a pointer to memory that "wraps"
the contents of the variant, not the contents of the variant itself.

When I use StrPtr(sValue), I must be getting a pointer to the contents of
the string.
The wwGetMD5Hash used below, not only changes the hash on changes in the
contents of a cell, but it also does not ignore empty cells.

Thanks to Stephen Bullen for the GetMD5Hash. I'd never gotten it myself.

Stephen M. Rasey
Houston, TX

\' wwGetMD5Hash(range) - return a 16 character hash string unique to the
contents of a many cell range.
' Afer GetMD5Hash (written by Stephen Bullen
' Newsgroups: microsoft.public.Excel.programming Date:
2004-02-05 12:50:20 PST )
' modified by Stephen Rasey (WiserWays) 040611
' Changes: Use StrPtr and coerse all cell values to strings
' Empty cells are not ignored, but the cell number in the
range
' is used to generate more data for the hash

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 wwGetMD5Hash(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 String
    Dim vU2 As Variant
    Dim lResult As Long
    Dim lcellCounter 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
            lcellCounter = 0
            For Each oCell In rngData.Cells
                lcellCounter = lcellCounter + 1
                If Not IsEmpty(oCell.Value) Then
                    vValue = CStr(oCell.Value)
'rasey o40611
                Else
                    ' must use a value for the empty cell not at all
likely to be used be accident.
                    vValue = "^ " & CStr(lcellCounter) 'rasey 040611
                End If
'rasey 040611
                lResult = CryptHashData(hHash, StrPtr(vValue), LenB(vValue),
0&) 'rasey 040611
            Next

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

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

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

            'Tidy up
            CryptDestroyHash hHash
        End If

        'Tidy up
        CryptReleaseContext hProv, 0
    End If

End Function

Example Data (1x3 range, Hash)
         | | |=wwgetmd5hash(A1:C1)
aaa | | |}"o&H''
aab | | |g8svFU^P
aaa | | |}"o&H''
aaaa | | |/덾ϩM7v
aaaaa | | |?e?"K.?"("
aaa | | |}"o&H''
aaa |10 | |~!/&,
aaa |20 | |Ezmk\?UX
aaa | | |20fLf(op'j
aab | | |g8svFU^P
baa | | |K?/*)<O&"
aaa | | |}"o&H''
AAA | | |el^cz'
         |AAA | |n<Ss.W's
         | |AAA |->'~vU

"Stephen Rasey" <raseysm@wiserways.com> wrote in message
news:O9xtlkmTEHA.332@TK2MSFTNGP11.phx.gbl...
> I noticed that the hash value does not change if I change a cell value
from
> 1 to 2 or 200 to 250. It does change if I change it form 1 to 10. or 200
to
> 2000.
>
> The MD5 Hash seems to be sensitive to the number of characters, not the
> actual value.
>
> I am going to research some of the other hashing methods. Does anyone
> have some suggestions to try?
>
> Thanks in advance.
>
> Stephen Rasey
>
> Houston
>



Relevant Pages

  • Re: Hash a range, output a Long Integer?
    ... I noticed that the hash value does not change if I change a cell value from ... > While Stephen's original function returns a 30 character string, ... > Dim hProv As Long ...
    (microsoft.public.excel.programming)
  • Re: Hash in Array speichern ?
    ... Um dann den Hash im folgenden Arrayindex abzulegen. ... > Dim myHash As New Hashtable ... > Dim myHash2 As New Hashtable ...
    (microsoft.public.de.german.entwickler.dotnet.vb)
  • Re: Question on a Chip Pearson macro
    ... ....best, Hash ... Martin Fishlock wrote: ... >> Deleting Duplicate Rows is something I want to do. ... >> Dim Col As Integer ...
    (microsoft.public.excel.programming)
  • Compare datasets with hash values or possibly another way?
    ... hash values of the datasets and compare those. ... ' Create a new instance of memory stream ... Dim formatter As New BinaryFormatter ...
    (microsoft.public.vstudio.general)