'libHMAC_SHA1: 

Option Public
Option Explicit

'*********************************************************
'*	Copyright (c) 2008 Tom O'Neil 
'*	http://codepress.net/b/disclaimer/
'*	
'*	I only copyright the work in order for users of the code to maintain the disclaimer below.
'*	
'*	This is a LotusScript implementation of Julian Robichaux's SHA-1 hash algorithm @ http://www.nsftools.com and 
'*	Paul Johnston's (and Greg Holt, Andrew Kepert, Ydnar, Lostinet)
'*	sha-1/HMAC script @ http://pajhome.org.uk/crypt/md5/sha1src.html
'*	Please follow the disclaimers at their websites. 
'*	
'*	Easy to use functions for HMAC_SHA1:
'*	
'*	HEX: myHexString = HMAC_SHA1_HEX(key,text)
'*	STR: myString = HMAC_SHA1_STR(key,text)
'*	B64: myString = HMAC_SHA1_B64(key,text)
'*********************************************************	








Const chrsz = 8 'bits per input character. 8 - ASCII; 16 - Unicode 
Const b64pad = "=" 'base-64 pad character. "=" for strict RFC compliance

Function rshift (value As Long, count As Integer) As Long
	'** bit shift right
	Dim binstr As String
	binstr = Left(String(count, "0") & tobin(value), 32)
	rshift = bin2dec(binstr) 
End Function
Function lshift (value As Long, count As Integer) As Long
	'** bit shift left
	Dim binstr As String
	binstr = Right(tobin(value) & String(count, "0"), 32)
	lshift = bin2dec(binstr)
End Function
Function add32 (a As Long, b As Long) As Long
	'** 2's complement addition, returning only the first 32-bits of the sum
	'** (this version is from Damien Katz's BitOperations library)
	If ((a Eqv b) And &h80000000&) Then
		add32 = ((&h80000000& Xor a) + b) Xor &h80000000&
	Else
		add32 = a + b		
	End If
%REM
	'** original version, with some optimizations (easier to understand than above,
	'** but many more steps and hence much slower)
	Dim bina As String, binb As String
	Dim result As String, carry As Integer
	Dim total As Integer
	Dim i As Integer
	
	bina = tobin(a)
	binb = tobin(b)
	result = ""
	carry = 0
	
	For i = 1 To 32
		total = Cint(Mid(bina, 33-i, 1)) + Cint(Mid(binb, 33-i, 1)) + carry
		carry = Abs(total > 1)
		result = Cstr(1 And total) & result
	Next
	
	add32 = bin2dec(result)
%END REM
End Function
Function f (b As Long, c As Long, d As Long, t As Long) As Long
	Select Case t
	Case Is < 20 :
		f = (b And c) Or ((Not b) And d)
	Case Is < 40 :
		f = b Xor c Xor d
	Case Is < 60 :
		f = (b And c) Or (b And d) Or (c And d)
	Case Else :
		f = b Xor c Xor d
	End Select	
End Function
Function k (t As Long) As Long
	Select Case t
	Case Is < 20 :
		k = &H5A827999		'** 1518500249 in decimal
	Case Is < 40 :
		k = &H6ED9EBA1		'** 1859775393 in decimal
	Case Is < 60 :
		k = &H8F1BBCDC		'** -1894007588 in decimal
	Case Else :
		k = &HCA62C1D6		'** -899497514 in decimal
	End Select
End Function
Function pad (message As String) As Variant
	Dim l As Integer, n As Integer, i As Integer
	
	l = Len(message)
	n = (((l+8) \ 64) + 1)*16
	
	Redim m(0 To n-1) As Long
	
	For i = 0 To l-1
		m(i\4) = m(i\4) Or lshift(Asc(Mid(message, i+1, 1)), (24 - (i Mod 4) * 8))
	Next
	
	pad = m
End Function
Function core_SHA1 (m,len1 As Long) As Variant
	Dim h0 As Long, h1 As Long, h2 As Long, h3 As Long, h4 As Long
	Dim a As Long, b As Long, c As Long, d As Long, e As Long
	Dim temp As Long
	Dim l As Integer, n As Integer
	Dim block As Integer, t As Long
	Dim w(0 To 79) As Long
	Dim tempblanks()
	
	' Padding m
	If (Ubound(m) < 31) Then
		Redim x(31 - Ubound(m) - 1)
		m = Arrayappend(m,x)
	End If
	
	m(RShift(len1,5)) = m(RShift(len1,5)) Or LShift(&h80,(24 - len1 Mod 32))
	m(LShift(RShift(len1 + 64,9),4) + 15) = len1	
	
	h0 = &H67452301		'** 1732584193 in decimal
	h1 = &HEFCDAB89	'** -271733879 in decimal
	h2 = &H98BADCFE	'** -1732584194 in decimal
	h3 = &H10325476		'** 271733878 in decimal
	h4 = &HC3D2E1F0	'** -1009589776 in decimal
	
	For block = 0 To Ubound(m) Step 16
		a = h0
		b = h1
		c = h2
		d = h3
		e = h4
		
		For t = 0 To 79
			If t < 16 Then
				w(t) = m(block + t)
			Else
				w(t) = rol(w(t-3) Xor w(t-8) Xor w(t-14) Xor w(t-16),1)
			End If
			temp = add32(rol(a,5), add32(f(b,c,d,t), add32(e, add32(w(t),k(t)))))
			e = d
			d = c
			c = rol(b,30)
			b = a
			a = temp
		Next
		
		h0 = add32(h0, a)
		h1 = add32(h1, b)
		h2 = add32(h2, c)
		h3 = add32(h3, d)
		h4 = add32(h4, e)
	Next
	Dim returnArray(4)
	
	returnArray(0) = h0
	returnArray(1) = h1
	returnArray(2) = h2
	returnArray(3) = h3
	returnArray(4) = h4
	
	core_SHA1 = returnArray
	
End Function
Sub Initialize
	
End Sub
Function core_HMAC_SHA1(key As String, text As String) As Variant
	Dim x As Integer
	Dim y As Integer
	Dim returnval As Variant
	Dim hash As Variant
	
	Dim bkey As Variant
	bkey = pad(key)
	
	If (Ubound(bkey) > 15) Then
		bkey = core_SHA1(bkey,Len(key) * chrsz)
	End If
	
	Dim ipad(15)
	Dim opad(15)
	
	For y=0 To 15
		ipad(y) = &h36363636
		opad(y) = &h5C5C5C5C
	Next
	
	For x = 0 To 15
		ipad(x) = ipad(x) Xor bkey(x)
		opad(x) = opad(x) Xor bkey(x)
	Next
	
	
	hash = core_SHA1(Arrayappend(ipad,pad(text)),512 + Len(text) * chrsz)
	returnval = core_SHA1(Arrayappend(opad,hash), 512 + 160)
	
	core_HMAC_SHA1 = returnval
	
End Function
Function tobin (value As Long) As String
	tobin = Right(String(32, "0") & Bin(value), 32)
End Function
Function rol (value As Long, count As Integer) As Long
	'** circular left-shift
	Dim binstr As String
	binstr = tobin(value)
	rol = bin2dec(Right(binstr, 32-count) & Left(binstr, count))
End Function
Function binb2b64(binarray) As String
	' Convert an array of big endian words to Base 64
	Dim strTAB As String
	strTAB = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
	Dim str1 As String
	str1 = ""
	Dim triplet As Long
	Dim tripBreak1 As Long
	Dim tripBreak2 As Long
	Dim tripBreak3 As Long
	Dim i As Integer
	Dim j As Integer
	
	
	For i=0 To ((Ubound(binarray)+1) * 4) Step 3		
		' If the result > than the bounds of the array... set the long to 0
		If (RShift(Clng(i),2) > Ubound(binarray)) Then
			tripBreak1 = 0
		Else
			tripBreak1 = LShift((RShift(Clng(binarray(RShift(Clng(i),2))),8 * (3 - (i) Mod 4)) And &HFF), 16)
		End If
		
		If (RShift(Clng(i+1),2) > Ubound(binarray)) Then
			tripBreak2 = 0
		Else
			tripBreak2 = LShift((RShift(Clng(binarray(RShift(Clng(i+1),2))),8 * (3 - (i+1) Mod 4)) And &HFF), 8)
		End If
		
		If (RShift(Clng(i+2),2) > Ubound(binarray)) Then
			tripBreak3 = 0
		Else
			tripBreak3 = (RShift(Clng(binarray(RShift(Clng(i+2),2))),8 * (3 - (i+2) Mod 4)) And &HFF)
		End If
		
		triplet = tripBreak1 Or tripBreak2 Or tripbreak3
		
		For j = 0 To 3
			If (i * 8 + j * 6 > (Ubound(binarray) + 1) * 32) Then
				str1 = str1 + b64pad
			Else
				str1 = str1 + Mid(strTab,(RShift(triplet,6*(3-j)) And &H3F) + 1,1)
			End If
		Next
	Next
	
	binb2b64 = str1
	
End Function
Function binb2str(binarray) As String
	' Convert an array of big endian words to a string
	Dim str1 As String
	Dim mask As Long
	Dim i As Integer
	Dim testBounds As Long
	
	mask = LShift(1,chrsz) - 1
	For i=0 To ((Ubound(binarray)+1) * 32) Step chrsz	
		If (Rshift(Clng(i),5) > Ubound(binarray)) Then
			testBounds = 0
		Else
			testBounds = Rshift(Clng(i),5)
		End If
		str1 = str1 + Uchr(Rshift(Clng(binarray(testBounds)),32 - chrsz - i Mod 32) And mask)
	Next
	binb2str = str1
End Function
Function bin2dec (binstr As String) As Long
	bin2dec = Clng(Val("&B" & binstr & "&"))
End Function 
Function binl2hex(binarray)
	' Convert an array of big endian words to Hex
	Dim strTAB As String
	strTAB = "0123456789abcdef"
	Dim str1 As String
	str1 = ""
	
	Dim x As Long
	
	For x=0 To ((Ubound(binarray)+1) * 4) - 1
		str1 = str1 + Mid(strTAB,( RShift(Clng(binarray(RShift(x,2))), ((3- x Mod 4)*8+4)) And &hF )+1, 1) + _
		Mid(strTAB,( RShift(Clng(binarray(RShift(x,2))), ((3- x Mod 4)*8)) And &hF )+1, 1)
	Next
	
	binl2hex = str1
End Function
Function HMAC_SHA1_B64(key As String, text As String) As String
	HMAC_SHA1_B64 = binb2b64(core_HMAC_SHA1(key,text))
End Function
Function HMAC_SHA1_HEX(key As String, text As String) As String
	HMAC_SHA1_HEX = binl2hex(core_HMAC_SHA1(key,text))
End Function
Function HMAC_SHA1_STR(key As String, text As String) As String
	HMAC_SHA1_STR = binb2str(core_HMAC_SHA1(key,text))
End Function