JazzSP8
Well-known Member
- Joined
- Sep 30, 2005
- Messages
- 1,233
- Office Version
- 365
- Platform
- Windows
Hi All
Looking for a little steer here as this currently has me beat.
A long time ago I needed to use SHA1 to encrypt a string, I Googled and found this UDF; http://squarecontrol.com/index.php/blog/sha1-hash-function-vba
It worked, I moved on.
It has come up again, so I got the old workbook, blew the cobwebs off it and copied and pasted it over to a brand new sparkly workbook.
Where it doesn't work - It gives me a #REF error.
At first I thought it might be a Add In or a Reference that was missing, but I've checked the original workbook and can't see anything obvious, they look the same to me at least.
The only other difference I can think of is originally it was an Excel 2003 formatted workbook and now I'm running Excel 2010
Another thing to note is that when I drag a formula with =SHA1(A1) down it becomes =SHA2(A2) in the new workbook, but it does recognise =SHA1() as a formula when I'm typing in the the little cell help box - This didn't happen in the Excel 2003 book, when I drag it, it stays as =SHA1(A2)
(I've also visited the http://splinter.com.au/blog website mentioned in the code but I can't find any mention of this UDF and there is no search function on the site :-/ )
Does this sound familiar to anyone? What am I missing? :-/
Thanks in advance for any help that can be provided.
Looking for a little steer here as this currently has me beat.
A long time ago I needed to use SHA1 to encrypt a string, I Googled and found this UDF; http://squarecontrol.com/index.php/blog/sha1-hash-function-vba
Code:
Option Explicit
Private Type FourBytes
A As Byte
B As Byte
C As Byte
D As Byte
End Type
Private Type OneLong
L As Long
End Type
Function EncodeBase64(text As String) As String
Dim arrData() As Byte
arrData = StrConv(text, vbFromUnicode)
Dim objXML
Dim objNode
Set objXML = CreateObject("MSXML2.DOMDocument")
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.text
Set objNode = Nothing
Set objXML = Nothing
End Function
Function HexDefaultSHA1(Message() As Byte) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
DefaultSHA1 Message, H1, H2, H3, H4, H5
HexDefaultSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function
Function HexSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long) As String
Dim H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long
xSHA1 Message, Key1, Key2, Key3, Key4, H1, H2, H3, H4, H5
HexSHA1 = DecToHex5(H1, H2, H3, H4, H5)
End Function
Sub DefaultSHA1(Message() As Byte, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
xSHA1 Message, &H5A827999, &H6ED9EBA1, &H8F1BBCDC, &HCA62C1D6, H1, H2, H3, H4, H5
End Sub
Sub xSHA1(Message() As Byte, ByVal Key1 As Long, ByVal Key2 As Long, ByVal Key3 As Long, ByVal Key4 As Long, H1 As Long, H2 As Long, H3 As Long, H4 As Long, H5 As Long)
'CA62C1D68F1BBCDC6ED9EBA15A827999 + "abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
'"abc" = "A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D"
Dim U As Long, P As Long
Dim FB As FourBytes, OL As OneLong
Dim i As Integer
Dim W(80) As Long
Dim A As Long, B As Long, C As Long, D As Long, E As Long
Dim T As Long
H1 = &H67452301: H2 = &HEFCDAB89: H3 = &H98BADCFE: H4 = &H10325476: H5 = &HC3D2E1F0
U = UBound(Message) + 1: OL.L = U32ShiftLeft3(U): A = U \ &H20000000: LSet FB = OL 'U32ShiftRight29(U)
ReDim Preserve Message(0 To (U + 8 And -64) + 63)
Message(U) = 128
U = UBound(Message)
Message(U - 4) = A
Message(U - 3) = FB.D
Message(U - 2) = FB.C
Message(U - 1) = FB.B
Message(U) = FB.A
While P < U
For i = 0 To 15
FB.D = Message(P)
FB.C = Message(P + 1)
FB.B = Message(P + 2)
FB.A = Message(P + 3)
LSet OL = FB
W(i) = OL.L
P = P + 4
Next i
For i = 16 To 79
W(i) = U32RotateLeft1(W(i - 3) Xor W(i - 8) Xor W(i - 14) Xor W(i - 16))
Next i
A = H1: B = H2: C = H3: D = H4: E = H5
For i = 0 To 19
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key1), ((B And C) Or ((Not B) And D)))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i
For i = 20 To 39
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key2), (B Xor C Xor D))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i
For i = 40 To 59
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key3), ((B And C) Or (B And D) Or (C And D)))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i
For i = 60 To 79
T = U32Add(U32Add(U32Add(U32Add(U32RotateLeft5(A), E), W(i)), Key4), (B Xor C Xor D))
E = D: D = C: C = U32RotateLeft30(B): B = A: A = T
Next i
H1 = U32Add(H1, A): H2 = U32Add(H2, B): H3 = U32Add(H3, C): H4 = U32Add(H4, D): H5 = U32Add(H5, E)
Wend
End Sub
Function U32Add(ByVal A As Long, ByVal B As Long) As Long
If (A Xor B) < 0 Then
U32Add = A + B
Else
U32Add = (A Xor &H80000000) + B Xor &H80000000
End If
End Function
Function U32ShiftLeft3(ByVal A As Long) As Long
U32ShiftLeft3 = (A And &HFFFFFFF) * 8
If A And &H10000000 Then U32ShiftLeft3 = U32ShiftLeft3 Or &H80000000
End Function
Function U32ShiftRight29(ByVal A As Long) As Long
U32ShiftRight29 = (A And &HE0000000) \ &H20000000 And 7
End Function
Function U32RotateLeft1(ByVal A As Long) As Long
U32RotateLeft1 = (A And &H3FFFFFFF) * 2
If A And &H40000000 Then U32RotateLeft1 = U32RotateLeft1 Or &H80000000
If A And &H80000000 Then U32RotateLeft1 = U32RotateLeft1 Or 1
End Function
Function U32RotateLeft5(ByVal A As Long) As Long
U32RotateLeft5 = (A And &H3FFFFFF) * 32 Or (A And &HF8000000) \ &H8000000 And 31
If A And &H4000000 Then U32RotateLeft5 = U32RotateLeft5 Or &H80000000
End Function
Function U32RotateLeft30(ByVal A As Long) As Long
U32RotateLeft30 = (A And 1) * &H40000000 Or (A And &HFFFC) \ 4 And &H3FFFFFFF
If A And 2 Then U32RotateLeft30 = U32RotateLeft30 Or &H80000000
End Function
Function DecToHex5(ByVal H1 As Long, ByVal H2 As Long, ByVal H3 As Long, ByVal H4 As Long, ByVal H5 As Long) As String
Dim H As String, L As Long
DecToHex5 = "00000000 00000000 00000000 00000000 00000000"
H = Hex(H1): L = Len(H): Mid(DecToHex5, 9 - L, L) = H
H = Hex(H2): L = Len(H): Mid(DecToHex5, 18 - L, L) = H
H = Hex(H3): L = Len(H): Mid(DecToHex5, 27 - L, L) = H
H = Hex(H4): L = Len(H): Mid(DecToHex5, 36 - L, L) = H
H = Hex(H5): L = Len(H): Mid(DecToHex5, 45 - L, L) = H
End Function
' Convert the string into bytes so we can use the above functions
' From Chris Hulbert: http://splinter.com.au/blog
Public Function SHA1(str)
Dim i As Integer
Dim arr() As Byte
ReDim arr(0 To Len(str) - 1) As Byte
For i = 0 To Len(str) - 1
arr(i) = Asc(Mid(str, i + 1, 1))
Next i
SHA1 = Replace(LCase(HexDefaultSHA1(arr)), " ", "")
End Function
It worked, I moved on.
It has come up again, so I got the old workbook, blew the cobwebs off it and copied and pasted it over to a brand new sparkly workbook.
Where it doesn't work - It gives me a #REF error.
At first I thought it might be a Add In or a Reference that was missing, but I've checked the original workbook and can't see anything obvious, they look the same to me at least.
The only other difference I can think of is originally it was an Excel 2003 formatted workbook and now I'm running Excel 2010
Another thing to note is that when I drag a formula with =SHA1(A1) down it becomes =SHA2(A2) in the new workbook, but it does recognise =SHA1() as a formula when I'm typing in the the little cell help box - This didn't happen in the Excel 2003 book, when I drag it, it stays as =SHA1(A2)
(I've also visited the http://splinter.com.au/blog website mentioned in the code but I can't find any mention of this UDF and there is no search function on the site :-/ )
Does this sound familiar to anyone? What am I missing? :-/
Thanks in advance for any help that can be provided.