Found this in some files I'd written a while back:
<% Option Explicit
' TITLE:
' Secure Hash Algorithm, SHA-1
'
' AUTHORS:
' Adapted by Ben Finnigan from VBA code by Iain Buchan
' http://wikisource.org/wiki/SHA-1_hash
' http://www.nwpho.man.ac.uk/Methods/Forms/DispForm.aspx?ID=6&Source=http:%2F%2Fwww.nwpho.man.ac.uk%2FMethods%2FForms%2FAllItems.aspx&RootFolder=%2FMethods
'
' PURPOSE:
' Creating a secure identifier from person-identifiable data
'
' The function SecureHash generates a 160-bit (20-hex-digit) message digest for a given message (String).
' It is computationally infeasable to recover the message from the digest.
' The digest is unique to the message within the realms of practical probability.
' The only way to find the source message for a digest is by hashing all possible messages and comparison of their digests.
' REFERENCES:
' For a fuller description see FIPS Publication 180-1:
' http://www.itl.nist.gov/fipspubs/fip180-1.htm
' SAMPLE:
' Message: "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
' Returns Digest: "84983E441C3BD26EBAAE4AA1F95129E5E54670F1"
' Message: "abc"
' Returns Digest: "A9993E364706816ABA3E25717850C26C9CD0D89D"
Function AndW(w1, w2)
Dim arr(3)
arr(0) = w1(0) And w2(0)
arr(1) = w1(1) And w2(1)
arr(2) = w1(2) And w2(2)
arr(3) = w1(3) And w2(3)
AndW = arr
End Function
Function OrW(w1, w2)
Dim arr(3)
arr(0) = w1(0) Or w2(0)
arr(1) = w1(1) Or w2(1)
arr(2) = w1(2) Or w2(2)
arr(3) = w1(3) Or w2(3)
OrW = arr
End Function
Function XorW(w1, w2)
Dim arr(3)
arr(0) = w1(0) Xor w2(0)
arr(1) = w1(1) Xor w2(1)
arr(2) = w1(2) Xor w2(2)
arr(3) = w1(3) Xor w2(3)
XorW = arr
End Function
Function NotW(w)
Dim arr(3)
arr(0) = Not w(0)
arr(1) = Not w(1)
arr(2) = Not w(2)
arr(3) = Not w(3)
NotW = arr
End Function
Function AddW(w1, w2)
Dim I, arr(3)
I = CLng(w1(3)) + w2(3)
arr(3) = I Mod 256
I = CLng(w1(2)) + w2(2) + (I \ 256)
arr(2) = I Mod 256
I = CLng(w1(1)) + w2(1) + (I \ 256)
arr(1) = I Mod 256
I = CLng(w1(0)) + w2(0) + (I \ 256)
arr(0) = I Mod 256
AddW = arr
End Function
Function CircShiftLeftW(w, n)
Dim d1, d2
d1 = WordToDouble(w)
d2 = d1
d1 = d1 * (2 ^ n)
d2 = d2 / (2 ^ (32 - n))
CircShiftLeftW = OrW(DoubleToWord(d1), DoubleToWord(d2))
End Function
Function WordToHex(w)
WordToHex = Right("0" & Hex(w(0)), 2) & Right("0" & Hex(w(1)), 2) & Right("0" & Hex(w(2)), 2) & Right("0" & Hex(w(3)), 2)
End Function
Function HexToWord(H)
HexToWord = DoubleToWord(CDbl("&H" & H))
End Function
Function DoubleToWord(n)
Dim arr(3)
arr(0) = Int(DMod(n, 2 ^ 32) / (2 ^ 24))
arr(1) = Int(DMod(n, 2 ^ 24) / (2 ^ 16))
arr(2) = Int(DMod(n, 2 ^ 16) / (2 ^ 8))
arr(3) = Int(DMod(n, 2 ^ 8))
DoubleToWord = arr
End Function
Function WordToDouble(w)
WordToDouble = (w(0) * (2 ^ 24)) + (w(1) * (2 ^ 16)) + (w(2) * (2 ^ 8)) + w(3)
End Function
Function DMod(value, divisor)
DMod = value - (Int(value / divisor) * divisor)
If DMod < 0 Then DMod = DMod + divisor
End Function
Function F(t, B, C, D)
Dim casenum
If t <= 19 Then casenum = 1
If t <= 39 And t > 19 Then casenum = 2
If t <= 59 And t > 39 Then casenum = 3
If t > 59 Then casenum = 4
Select Case casenum
Case 1
F = OrW(AndW(B, C), AndW(NotW(B), D))
Case 2
F = XorW(XorW(B, C), D)
Case 3
F = OrW(OrW(AndW(B, C), AndW(B, D)), AndW(C, D))
Case 4
F = XorW(XorW(B, C), D)
End Select
End Function
Function sha1(inMessage)
Dim inLenW
Dim w(79)
Dim temp
Dim A, B, C, D, E
Dim H0, H1, H2, H3, H4
Dim K(3)
Dim arr(3)
Dim inLen, padMessage, numBlocks, blockText, wordText, I, t
inLen = Len(inMessage)
inLenW = DoubleToWord(CDbl(inLen) * 8)
padMessage = inMessage & Chr(128) & String((128 - (inLen Mod 64) - 9) Mod 64, Chr(0)) & String(4, Chr(0)) & Chr(inLenW(0)) & Chr(inLenW(1)) & Chr(inLenW(2)) & Chr(inLenW(3))
numBlocks = Len(padMessage) / 64
' initialize constants
K(0) = HexToWord("5A827999")
K(1) = HexToWord("6ED9EBA1")
K(2) = HexToWord("8F1BBCDC")
K(3) = HexToWord("CA62C1D6")
'initialize 160-bit (5 words) buffer
H0 = HexToWord("67452301")
H1 = HexToWord("EFCDAB89")
H2 = HexToWord("98BADCFE")
H3 = HexToWord("10325476")
H4 = HexToWord("C3D2E1F0")
'each 512 byte message block consists of 16 words (W) but W is expanded to 80 words
For I = 0 To numBlocks - 1
blockText = Mid(padMessage, (I * 64) + 1, 64)
'initialize a message block
For t = 0 To 15
wordText = Mid(blockText, (t * 4) + 1, 4)
arr(0) = Asc(Mid(wordText, 1, 1))
arr(1) = Asc(Mid(wordText, 2, 1))
arr(2) = Asc(Mid(wordText, 3, 1))
arr(3) = Asc(Mid(wordText, 4, 1))
w(t) = arr
Next
'create extra words from the message block
For t = 16 To 79
'W(t) = S^1 (W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
w(t) = CircShiftLeftW(XorW(XorW(XorW(w(t - 3), w(t - 8)), w(t - 14)), w(t - 16)), 1)
Next
'make initial assignments to the buffer
A = H0
B = H1
C = H2
D = H3
E = H4
'process the block
For t = 0 To 79
temp = AddW(AddW(AddW(AddW(CircShiftLeftW(A, 5), F(t, B, C, D)), E), w(t)), K(t \ 20))
E = D
D = C
C = CircShiftLeftW(B, 30)
B = A
A = temp
Next
H0 = AddW(H0, A)
H1 = AddW(H1, B)
H2 = AddW(H2, C)
H3 = AddW(H3, D)
H4 = AddW(H4, E)
Next
sha1 = WordToHex(H0) & WordToHex(H1) & WordToHex(H2) & WordToHex(H3) & WordToHex(H4)
End Function
%>
If you find it useful, please post a comment letting me know.
