SHA256 HASH function

[kusk0r]

Hi, I am looking for a function to hash sensitive data of a collum. After some searching I have found a class module that is supposed to work and imported it. I can't seem to be able to write a working module to call the function from the class module. I got the class module from http://www.frez.co.uk/ ( http://www.frez.co.uk/SHA.zip).

I would appreciate any help with this.

 

[StevenHB]

Re: How I got it to work in 2007

This was quite helpful. Perhaps you can answer one more question about the hashing algorithm: I need to specify the key to use during the process, as well as the string to be hashed. Do you know how I might do that?

 

[Ralajer]

I am not entirely sure what you are asking as hashing functions such SHA256 don't have a key per se because they are one way encryption . If you want to add a key to make a brute force crack harder, concatenate it to the string to be hashed.

B1 = String to be hashed
K1 = Key

=SHADD256(B1&K1)

I am not sure if that is what you were looking for but let me know either way.

 

[StevenHB]

This website (http://hash.online-convert.com/sha256-generator) allows you to specify a "Shared secret key for the HMAC variant." For my application, I need to use such a shared key.

 

[Ralajer]

Ok I see what you wanted. Reading/searching the CLS file, used above, I don't see the HMAC functionality in there.

I found many implementation of HMAC SHA256; however, none of them were in VBA. You could keep looking or adapt it from one of the other language's implementation.

The below are two implementations I found

Pseudocode - http://en.wikipedia.org/wiki/HMAC#Implementation.
Visual Basic - http://msdn.microsoft.com/en-us/library/system.security.cryptography.hmacsha256.aspx
​

Good luck.

 

[Ralajer]

I end up looking around more and I found this http://www.vbforums.com/showthread.php?t=635398 it a VB Class like the above. It seems to be more what you're looking for but I haven't had the time to test it out but an example of the class in use is in the Form1.frm file.

 

[StevenHB]

Rob: I can't thank you enough. The vbforums link worked out great.

 

[omnipotentmero]

Re: How I got it to work in 2007

...Finally, what I did to put it all together and get it working for me was...

I am using Excel 2010 and after following your instructions, I still was getting #NAME errors. However, using "HashUnique", rather than SHADD256 fixed the problem.

Another helpful tip I just learned, is how to turn all of this into an add-in to share. http://office.microsoft.com/en-us/e...s-in-excel-2007-HA010218996.aspx#BMmakingyour On a side note, windows 7 stores the add-ins here

%AppData%\Microsoft\AddIns

 

[chrisfeas]

Re: How I got it to work in 2007

I know this thread is old but I think more people are going to stumble upon it as I have due to the rise in popularity of SHA256 and the move away from md5 hashing when dealing with sensitive data, especially in the EU.

I thought I would share my experience of trying to follow the steps mentioned in this thread as a novice user.

1) Download the file that kusk0r mentions in the first post of the thread. - This link no longer works but can be found here http://web.archive.org/web/20070808024050if_/http://www.frez.co.uk/SHA.zip

2) Edit line 563 and 637 of the file CSHA256.CLS that is included in the ZIP so that the function SHA256 is renamed. I renamed it to SHADD256 for some reason. Save the file.
3) In Excel 2007, go to Developer Tab, Click on Visual Basic.
4) In the IDE, do File|Import File. Locate your CSHA256.CLS file and load it. It will load as a class module.

I'm using Excel on Office365 and importing this cls file created a module rather than a class module so I opened the cls file in notepad, modified the rows as described above and pasted the text into a class module. I later then found I needed to name the class module CSHA256 which is done in the properties window in the bottom left of the screen

5) You will need something that actually makes it work, though, and that's the part that kusk0r posted. Right-click in the Project area of the Visual Basic IDE. Choose Insert|Module. It will create a module named Module1 which shows up in the tree. Open it. Paste kusk0r's code from his post earlier, but edit it to reflect the new, longer function that you've renamed so as to avoid Excel 2007+ thinking it's a cell reference. So, in my case, I made it:

Public Function SHADD256(sMessage As String)

Dim clsX As CSHA256
Set clsX = New CSHA256

SHADD256 = clsX.SHADD256(sMessage)

Set clsX = Nothing

End Function
As this isn't really an area I know anything about I don't know whether I wasn't following the instructions properly or if the application has changed but I think other people may find themselves on this page with a similar level of experience to me and encountering the same problem.

 

[keiranwyllie]

I know this is dragging up a slightly older thread however I'm interested to know whether this can be applied to passwords used within a spreadsheet. I've configured password access to either unhide various columns on a sheet, or multiple sheets in a workbook. The password is kept on a 'settings' page in its 'encrypted' form. I also use a 'change password' userform which then updates to the new password in its 'encrypted' form. This works great using the code below.

Global Const sKey As String = "E12W2^!cH6lG2bgT"   'Sets the key

'Code for Xor function
Function XorC(ByVal sData As String, ByVal sKey As String) As String
    Dim l As Long, i As Long, byIn() As Byte, byOut() As Byte, byKey() As Byte
    Dim bEncOrDec As Boolean
     'confirm valid string and key input:
    If Len(sData) = 0 Or Len(sKey) = 0 Then XorC = "Invalid argument(s) used": Exit Function
     'check whether running encryption or decryption (flagged by presence of "A^#" at start of sData):
    If Left$(sData, 3) = "A^#" Then
        bEncOrDec = False 'decryption
        sData = Mid$(sData, 4)
    Else
        bEncOrDec = True 'encryption
    End If
     'assign strings to byte arrays (unicode)
    byIn = sData
    byOut = sData
    byKey = sKey
    l = LBound(byKey)
    For i = LBound(byIn) To UBound(byIn) - 1 Step 2
        byOut(i) = ((byIn(i) + Not bEncOrDec) Xor byKey(l)) - bEncOrDec 'avoid Chr$(0) by using bEncOrDec flag
        l = l + 2
        If l > UBound(byKey) Then l = LBound(byKey) 'ensure stay within bounds of Key
    Next i
    XorC = byOut
    If bEncOrDec Then XorC = "A^#" & XorC 'add "A^#" onto encrypted text
End Function


'Function to update password when changed and when input to access hidden columns or sheets
Public Function sPassword(key As String)
Application.ScreenUpdating = False
With Sheets("Settings")
    .Unprotect ("protection password")
    sPassword = XorC(Sheets("Settings").Range("P4").Value, key)
    If Left(Sheets("Settings").Range("P4").Value, 3) <> "A^#" Then Sheets("Settings").Range("P4").Value = sPassword
    .Protect ("protection password")
End With
Application.ScreenUpdating = True
End Function

'Code in userform for password input
Private Sub tb_password_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        If SettingsPassword = True Then
            If tb_password = sPassword(sKey) Then
                PasswordOk = True
                SettingsPassword = False
            End If
        End If
        Hide
    End If
End Sub

'Code for Change Password userform
Private Sub btnOK_Click()
Dim pw1, pw2, pw3 As String
pw1 = txtPw1.Text
pw2 = txtPw2.Text
pw3 = txtPw3.Text

If pw1 <> sPassword(sKey) Then
    yenah = MsgBox("The current password is incorrect, please try again.", vbCritical + vbRetryCancel, "Error")
        Select Case yenah: Case vbRetry: clrall: Case vbCancel: Unload Me:  End Select
Else
    If Len(pw2) < 6 Then
        YN = MsgBox("The password needs to be more than 5 characters long.", vbExclamation + vbRetryCancel, "Error")
            Select Case YN: Case vbRetry: clrn:  Case vbCancel: Unload Me: End Select
    Else
        If pw2 <> pw3 Then
            yenahbro = MsgBox("The new passwords do not match, please try again.", vbCritical + vbRetryCancel, "Error")
                Select Case yenahbro: Case vbRetry: clrn: Case vbCancel: Unload Me: End Select
        Else
            If pw1 = pw2 Then
                yenahyenah = MsgBox("The old and new passwords match, please try again.", vbExclamation + vbRetryCancel, "Error")
                    Select Case yenahyenah: Case vbRetry: clrn: Case vbCancel: Unload Me:  End Select
            Else
                Application.ScreenUpdating = False
                With Sheets("Settings")
                    .Unprotect ("protection password")
                    .Range("P4").Value = pw2
                    .Protect ("protection password")
                    pw3 = sPassword(sKey)
                End With
                        
                wsCou = ActiveWorkbook.Worksheets.count
                    For i = 1 To wsCou
                        If ActiveWorkbook.Worksheets(i).ProtectContents = True And ActiveWorkbook.Worksheets(i).name <> "Settings" Then
                            ActiveWorkbook.Worksheets(i).Unprotect (pw1)
                            ActiveWorkbook.Worksheets(i).Protect (pw2), DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFiltering:=True
                        End If
                    Next i

                PasChgSettings.Hide
                Application.ScreenUpdating = True
                a = MsgBox("Password has successfully been changed from '" & pw1 & "' to '" & pw2 & "'." & vbNewLine & vbNewLine & "Please ensure the new password is remembered as resetting a forgotten password can only be achieved with assistance from the original programmers.", vbInformation, "Personnel Status Tracker - Password Change")
                Unload Me
            End If
        End If
    End If
End If
End Sub

What I've tried doing is using the following code to use SHA256 encryption instead of XOR.

Option Explicit

Public Function get_HASH_SHA256(ByVal sInput As String) As String
get_HASH_SHA256 = SHA256(sInput)
End Function

Public Function SHA256(sInput As String, Optional bB64 As Boolean = 0) As String

    Dim Encoder As Object
Set Encoder = CreateObject("System.Text.UTF8Encoding")

Dim Encoder_SHA256 As Object
Set Encoder_SHA256 = CreateObject("System.Security.Cryptography.SHA256Managed")

Dim TextToHash() As Byte
TextToHash = Encoder.GetBytes_4(sInput)

Dim bytes() As Byte
bytes = Encoder_SHA256.ComputeHash_2((TextToHash))

If bB64 = True Then
SHA256 = ConvToBase64String(bytes)
Else
SHA256 = ConvToHexString(bytes)
End If

Set Encoder = Nothing
Set Encoder_SHA256 = Nothing
End Function

Public Function ConvToBase64String(vIn As Variant) As Variant

    Dim oD As Object

Set oD = CreateObject("MSXML2.DOMDocument")
With oD
.LoadXML "<root />"
.DocumentElement.DataType = "bin.base64"
.DocumentElement.nodeTypedValue = vIn
End With
ConvToBase64String = Replace(oD.DocumentElement.Text, vbLf, "")

    Set oD = Nothing

End Function

Public Function ConvToHexString(vIn As Variant) As Variant

    Dim oD As Object

Set oD = CreateObject("MSXML2.DOMDocument")

With oD
.LoadXML "<root />"
.DocumentElement.DataType = "bin.Hex"
.DocumentElement.nodeTypedValue = vIn
End With
ConvToHexString = Replace(oD.DocumentElement.Text, vbLf, "")

    Set oD = Nothing

End Function

The code works because I can call it in a worksheet and get a hashed value. I tried applying it in a similar fashion as the XorC function and, while it does indeed encrypt the password, it then encrypts the new hashed value again and returns "The current password is incorrect, please try again." msgbox.

Any suggestions how best to move forward with this?

TIA.

 

[keiranwyllie]

Well I had some good progress with this. Link to file attached for anyone that's interested.

Userform Password SHA256