'CoreHashLibrary: 

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. 
'*	
'*********************************************************	

















Class HashHelper
	Private chrsz As Integer 'bits per input character. 8 - ASCII; 16 - Unicode 
	Private b64pad As String 'base-64 pad character. "=" for strict RFC compliance
	
	Sub new
		chrsz = 8
		b64pad = "="
	End Sub
	
	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
		' Big Endian Words
		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 pad_l (message As String) As Variant
' Little Endian Words	
		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)), ((i Mod 4) * 8))
		Next
		
		pad_l = m
	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 binb2hex(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
		
		binb2hex = str1
	End Function
	
	Function binl2b64(binarray) As String
		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 * ((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 * ( (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 * ((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
		
		binl2b64 = str1
		
	End Function
	
	Function binl2str(binarray) As 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)),i Mod 32) And mask)
		Next
		binl2str = str1
	End Function  
	
	Function binl2hex(binarray)
		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))), ((x Mod 4)*8+4)) And &hF )+1, 1) + _
			Mid(strTAB,( RShift(Clng(binarray(RShift(x,2))), ((x Mod 4)*8)) And &hF )+1, 1)
		Next
		
		binl2hex = str1
	End Function
	
End Class