<%
Class MD5

Public OFFSET_4
Public MAXINT_4

Public S11
Public S12
Public S13
Public S14
Public S21
Public S22
Public S23
Public S24
Public S31
Public S32
Public S33
Public S34
Public S41
Public S42
Public S43
Public S44

Public State
Public ByteCounter
Public ByteBuffer

Public Function MD5Consts ()
	OFFSET_4 = 4294967296
	MAXINT_4 = 2147483647

	S11 = 7
	S12 = 12
	S13 = 17
	S14 = 22
	S21 = 5
	S22 = 9
	S23 = 14
	S24 = 20
	S31 = 4
	S32 = 11
	S33 = 16
	S34 = 23
	S41 = 6
	S42 = 10
	S43 = 15
	S44 = 21

	Redim State(4)
	Redim ByteBuffer(63)
	ByteCounter = 0
End Function

'--- Class Properties ---
Property Get RegisterA()
	RegisterA = State(1)
End Property

Property Get RegisterB()
	RegisterB = State(2)
End Property

Property Get RegisterC()
	RegisterC = State(3)
End Property

Property Get RegisterD()
	RegisterD = State(4)
End Property


' --- Class Functions ---

' Function to quickly digest a file into a hex string

'Public Function DigestFileToHexStr(FileName)
'Open FileName For Binary Access Read As #1
'MD5Init
'Do While Not EOF(1)
'Get #1, , ByteBuffer
'If Loc(1) < LOF(1) Then
'ByteCounter = ByteCounter + 64
'MD5Transform ByteBuffer
'End If
'Loop
'ByteCounter = ByteCounter + (LOF(1) Mod 64)
'Close #1
'MD5Final
'DigestFileToHexStr = GetValues
'End Function


' Function to digest a text string and output the result as a string
' of hexadecimal characters.

Public Function DigestStrToHexStr(SourceString)
	MD5Consts
	MD5Init
	MD5Update Len(SourceString), StringToArray(SourceString)
	MD5Final
	DigestStrToHexStr = GetValues
End Function


' A utility function which converts a string into an array of bytes.

Public Function StringToArray(InString)
	Dim I, bytBuffer()

	ReDim bytBuffer(Len(InString))
	For I = 0 To Len(InString) - 1
		bytBuffer(I) = Asc(Mid(InString, I + 1, 1))
	Next
	StringToArray = bytBuffer
End Function


' --- Concatenate the four state vaules into one string ---

Public Function GetValues()
	GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4))
End Function


' --- Convert a Long to a Hex string ---

Public Function LongToString(Num)
	Dim a, b, c, d

	a = Num And &HFF&
	If a < 16 Then
	    LongToString = "0" & Hex(a)
	Else
	    LongToString = Hex(a)
	End If

	b = (Num And &HFF00&) \ 256
	If b < 16 Then
		LongToString = LongToString & "0" & Hex(b)
	Else
		LongToString = LongToString & Hex(b)
	End If

	c = (Num And &HFF0000) \ 65536
	If c < 16 Then
		LongToString = LongToString & "0" & Hex(c)
	Else
		LongToString = LongToString & Hex(c)
	End If

	If Num < 0 Then
		d = ((Num And &H7F000000) \ 16777216) Or &H80&
	Else
		d = (Num And &HFF000000) \ 16777216
	End If

	If d < 16 Then
		LongToString = LongToString & "0" & Hex(d)
	Else
		LongToString = LongToString & Hex(d)
	End If
End Function


'	Initialize the class
'	This must be called before a digest calculation is started

Public Sub MD5Init()
	ByteCounter = 0
	State(1) = UnsignedToLong(1732584193)
	State(2) = UnsignedToLong(4023233417)
	State(3) = UnsignedToLong(2562383102)
	State(4) = UnsignedToLong(271733878)
End Sub


' --- MD5 Final ---

Public Sub MD5Final()
	Dim dblBits, lngBytesBuffered, padding(72)

	padding(0) = &H80

	dblBits = ByteCounter * 8

	' Pad out
	lngBytesBuffered = ByteCounter Mod 64
	If lngBytesBuffered <= 56 Then
		MD5Update 56 - lngBytesBuffered, padding
	Else
		MD5Update 120 - ByteCounter, padding
	End If

	padding(0) = UnsignedToLong(dblBits) And &HFF&
	padding(1) = UnsignedToLong(dblBits) \ 256 And &HFF&
	padding(2) = UnsignedToLong(dblBits) \ 65536 And &HFF&
	padding(3) = UnsignedToLong(dblBits) \ 16777216 And &HFF&
	padding(4) = 0
	padding(5) = 0
	padding(6) = 0
	padding(7) = 0

	MD5Update 8, padding
End Sub


' --- Break up input stream into 64 byte chunks ---

Public Sub MD5Update(InputLen, InputBuffer)
	Dim II, I, J, K, lngBufferedBytes, lngBufferRemaining, lngRem

	lngBufferedBytes = ByteCounter Mod 64
	lngBufferRemaining = 64 - lngBufferedBytes
	ByteCounter = ByteCounter + InputLen
	' Use up old buffer results first

	If InputLen >= lngBufferRemaining Then
		For II = 0 To lngBufferRemaining - 1
			ByteBuffer(lngBufferedBytes + II) = InputBuffer(II)
		Next
		MD5Transform ByteBuffer

		lngRem = (InputLen) Mod 64
		' The transfer is a multiple of 64 lets do some transformations
		For I = lngBufferRemaining To InputLen - II - lngRem Step 64
			For J = 0 To 63
				ByteBuffer(J) = InputBuffer(I + J)
			Next
			MD5Transform ByteBuffer
		Next

		lngBufferedBytes = 0
	Else
		I = 0
	End If

	' Buffer any remaining input
	For K = 0 To InputLen - I - 1
		ByteBuffer(lngBufferedBytes + K) = InputBuffer(I + K)
	Next
End Sub


' --- MD5 Transform ---

Public Sub MD5Transform(Buffer)
	Dim x(16), a, b, c, d

	a = State(1)
	b = State(2)
	c = State(3)
	d = State(4)

	Decode 64, x, Buffer

	' Round 1
	FF a, b, c, d, x(0), S11, -680876936
	FF d, a, b, c, x(1), S12, -389564586
	FF c, d, a, b, x(2), S13, 606105819
	FF b, c, d, a, x(3), S14, -1044525330
	FF a, b, c, d, x(4), S11, -176418897
	FF d, a, b, c, x(5), S12, 1200080426
	FF c, d, a, b, x(6), S13, -1473231341
	FF b, c, d, a, x(7), S14, -45705983
	FF a, b, c, d, x(8), S11, 1770035416
	FF d, a, b, c, x(9), S12, -1958414417
	FF c, d, a, b, x(10), S13, -42063
	FF b, c, d, a, x(11), S14, -1990404162
	FF a, b, c, d, x(12), S11, 1804603682
	FF d, a, b, c, x(13), S12, -40341101
	FF c, d, a, b, x(14), S13, -1502002290
	FF b, c, d, a, x(15), S14, 1236535329

	' Round 2
	GG a, b, c, d, x(1), S21, -165796510
	GG d, a, b, c, x(6), S22, -1069501632
	GG c, d, a, b, x(11), S23, 643717713
	GG b, c, d, a, x(0), S24, -373897302
	GG a, b, c, d, x(5), S21, -701558691
	GG d, a, b, c, x(10), S22, 38016083
	GG c, d, a, b, x(15), S23, -660478335
	GG b, c, d, a, x(4), S24, -405537848
	GG a, b, c, d, x(9), S21, 568446438
	GG d, a, b, c, x(14), S22, -1019803690
	GG c, d, a, b, x(3), S23, -187363961
	GG b, c, d, a, x(8), S24, 1163531501
	GG a, b, c, d, x(13), S21, -1444681467
	GG d, a, b, c, x(2), S22, -51403784
	GG c, d, a, b, x(7), S23, 1735328473
	GG b, c, d, a, x(12), S24, -1926607734

	' Round 3
	HH a, b, c, d, x(5), S31, -378558
	HH d, a, b, c, x(8), S32, -2022574463
	HH c, d, a, b, x(11), S33, 1839030562
	HH b, c, d, a, x(14), S34, -35309556
	HH a, b, c, d, x(1), S31, -1530992060
	HH d, a, b, c, x(4), S32, 1272893353
	HH c, d, a, b, x(7), S33, -155497632
	HH b, c, d, a, x(10), S34, -1094730640
	HH a, b, c, d, x(13), S31, 681279174
	HH d, a, b, c, x(0), S32, -358537222
	HH c, d, a, b, x(3), S33, -722521979
	HH b, c, d, a, x(6), S34, 76029189
	HH a, b, c, d, x(9), S31, -640364487
	HH d, a, b, c, x(12), S32, -421815835
	HH c, d, a, b, x(15), S33, 530742520
	HH b, c, d, a, x(2), S34, -995338651

	' Round 4
	II a, b, c, d, x(0), S41, -198630844
	II d, a, b, c, x(7), S42, 1126891415
	II c, d, a, b, x(14), S43, -1416354905
	II b, c, d, a, x(5), S44, -57434055
	II a, b, c, d, x(12), S41, 1700485571
	II d, a, b, c, x(3), S42, -1894986606
	II c, d, a, b, x(10), S43, -1051523
	II b, c, d, a, x(1), S44, -2054922799
	II a, b, c, d, x(8), S41, 1873313359
	II d, a, b, c, x(15), S42, -30611744
	II c, d, a, b, x(6), S43, -1560198380
	II b, c, d, a, x(13), S44, 1309151649
	II a, b, c, d, x(4), S41, -145523070
	II d, a, b, c, x(11), S42, -1120210379
	II c, d, a, b, x(2), S43, 718787259
	II b, c, d, a, x(9), S44, -343485551

	State(1) = LongOverflowAdd(State(1), a)
	State(2) = LongOverflowAdd(State(2), b)
	State(3) = LongOverflowAdd(State(3), c)
	State(4) = LongOverflowAdd(State(4), d)
End Sub

Public Sub Decode(Length, OutputBuffer, InputBuffer)
	Dim intDblIndex, intByteIndex, dblSum

	intDblIndex = 0
	For intByteIndex = 0 To Length - 1 Step 4
		dblSum =	InputBuffer(intByteIndex) + _
					InputBuffer(intByteIndex + 1) * 256 + _
					InputBuffer(intByteIndex + 2) * 65536 + _
					InputBuffer(intByteIndex + 3) * 16777216
		OutputBuffer(intDblIndex) = UnsignedToLong(dblSum)
		intDblIndex = intDblIndex + 1
	Next
End Sub


' FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
' Rotation is separate from addition to prevent recomputation.

Public Function FF(a, b, c, d, x, s, ac)
	a = LongOverflowAdd4(a, (b And c) Or (Not (b) And d), x, ac)
	a = LongLeftRotate(a, s)
	a = LongOverflowAdd(a, b)
End Function

Public Function GG(a, b, c, d, x, s, ac)
	a = LongOverflowAdd4(a, (b And d) Or (c And Not (d)), x, ac)
	a = LongLeftRotate(a, s)
	a = LongOverflowAdd(a, b)
End Function

Public Function HH(a, b, c, d, x, s, ac)
	a = LongOverflowAdd4(a, b Xor c Xor d, x, ac)
	a = LongLeftRotate(a, s)
	a = LongOverflowAdd(a, b)
End Function

Public Function II(a, b, c, d, x, s, ac)
	a = LongOverflowAdd4(a, c Xor (b Or Not (d)), x, ac)
	a = LongLeftRotate(a, s)
	a = LongOverflowAdd(a, b)
End Function


' --- Rotate a long to the right ---

Function LongLeftRotate(value, bits)
	Dim lngSign, lngI

	bits = bits Mod 32
	If bits = 0 Then LongLeftRotate = value: Exit Function
	For lngI = 1 To bits
		lngSign = value And &HC0000000
		value = (value And &H3FFFFFFF) * 2
		value = value Or ((lngSign < 0) And 1) Or (CBool(lngSign And &H40000000) And &H80000000)
	Next
	LongLeftRotate = value
End Function


' Function to add two unsigned numbers together as in C.
' Overflows are ignored!

Public Function LongOverflowAdd(Val1, Val2)
	Dim lngHighWord, lngLowWord, lngOverflow

	lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&)
	lngOverflow = lngLowWord \ 65536
	lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
	LongOverflowAdd = UnsignedToLong((lngHighWord * 65536) + (lngLowWord And &HFFFF&))
End Function


' Function to add two unsigned numbers together as in C.
' Overflows are ignored!

Public Function LongOverflowAdd4(Val1, Val2, val3, val4)
	Dim lngHighWord, lngLowWord, lngOverflow

	lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&) + (val3 And &HFFFF&) + (val4 And &HFFFF&)
	lngOverflow = lngLowWord \ 65536
	lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + _
					((Val2 And &HFFFF0000) \ 65536) + _
					((val3 And &HFFFF0000) \ 65536) + _
					((val4 And &HFFFF0000) \ 65536) + _
					lngOverflow) And &HFFFF&
	LongOverflowAdd4 = UnsignedToLong((lngHighWord * 65536) + (lngLowWord And &HFFFF&))
End Function


' Convert an unsigned double into a long

Public Function UnsignedToLong(value)
	If value < 0 Or value >= OFFSET_4 Then 
		Exit Function 
	End If ' Overflow

	If value <= MAXINT_4 Then
		UnsignedToLong = value
	Else
		UnsignedToLong = value - OFFSET_4
	End If
End Function


' Convert a long to an unsigned Double

Public Function LongToUnsigned(value)
	If value < 0 Then
		LongToUnsigned = value + OFFSET_4
	Else
		LongToUnsigned = value
	End If
End Function

End Class
%>
