ASP Implementation of the classic MD5 Algorithm

<%
'--------------------------------------
'Cocoon Disk Manager V3 -- MD5 Function
'
'Asp Implementation of the classic MD5 Algorithm
'-- From a foreign website
'--------------------------------------
Private const bits_to_a_byte = 8
Private const bytes_to_a_word = 4
Private const bits_to_a_word = 32
 
Private m_lonbits (30)
Private m_l2power (30)
 
Private function lshift (lvalue, ishiftbits)
If ishiftbits = 0 then
Lshift = lvalue
Exit Function
Elseif ishiftbits = 31 then
If lvalue and 1 then
Lshift = & h80000000
Else
Lshift = 0
End if
Exit Function
Elseif ishiftbits <0 or ishiftbits> 31 then
Err. Raise 6
End if
 
If (lvalue and m_l2power (31-ishiftbits) then
Lshift = (lvalue and m_lonbits (31-(ishiftbits + 1) * m_l2power (ishiftbits) or & h80000000
Else
Lshift = (lvalue and m_lonbits (31-ishiftbits) * m_l2power (ishiftbits ))
End if
End Function
 
Private function rshift (lvalue, ishiftbits)
If ishiftbits = 0 then
Rshift = lvalue
Exit Function
Elseif ishiftbits = 31 then
If lvalue and & h80000000 then
Rshift = 1
Else
Rshift = 0
End if
Exit Function
Elseif ishiftbits <0 or ishiftbits> 31 then
Err. Raise 6
End if
 
Rshift = (lvalue and & effecffffffe)/m_l2power (ishiftbits)
 
If (lvalue and & h80000000) then
Rshift = (rshift or (& h40000000/m_l2power (ishiftbits-1 )))
End if
End Function
 
Private function rotateleft (lvalue, ishiftbits)
Rotateleft = lshift (lvalue, ishiftbits) or rshift (lvalue, (32-ishiftbits ))
End Function
 
Private function addunsigned (LX, ly)
Dim lx4
Dim ly4
Dim lx8
Dim ly8
Dim lresult
 
Lx8 = Lx and & h80000000
Ly8 = ly and & h80000000
Lx4 = Lx and & h40000000
Ly4 = ly and & h40000000

Lresult = (lx and & h3fffffff) + (ly and & h3fffffff)
 
If lx4 and ly4 then
Lresult = lresult XOR & h80000000 XOR lx8 XOR ly8
Elseif lx4 or ly4 then
If lresult and & h40000000 then
Lresult = lresult XOR & hc0000000 XOR lx8 XOR ly8
Else
Lresult = lresult XOR & h40000000 XOR lx8 XOR ly8
End if
Else
Lresult = lresult XOR lx8 XOR ly8
End if
 
Addunsigned = lresult
End Function
 
Private function md5_f (x, y, z)
Md5_f = (X and Y) or (not X) and Z)
End Function
 
Private function md5_g (x, y, z)
Md5_g = (X and Z) or (Y and (not z ))
End Function
 
Private function md5_h (x, y, z)
Md5_h = (x XOR y xor z)
End Function
 
Private function md5_ I (x, y, z)
Md5_ I = (Y XOR (X or (not z )))
End Function
 
Private sub md5_ff (a, B, c, d, X, S, AC)
A = addunsigned (A, addunsigned (md5_f (B, c, d), x), AC ))
A = rotateleft (A, S)
A = addunsigned (A, B)
End sub
 
Private sub md5_gg (a, B, c, d, X, S, AC)
A = addunsigned (A, addunsigned (md5_g (B, c, d), x), AC ))
A = rotateleft (A, S)
A = addunsigned (A, B)
End sub
 
Private sub md5_hh (a, B, c, d, X, S, AC)
A = addunsigned (A, addunsigned (md5_h (B, c, d), x), AC ))
A = rotateleft (A, S)
A = addunsigned (A, B)
End sub
 
Private sub md5_ii (a, B, c, d, X, S, AC)
A = addunsigned (A, addunsigned (md5_ I (B, c, d), x), AC ))
A = rotateleft (A, S)
A = addunsigned (A, B)
End sub
 
Private function converttowordarray (smessage)
Dim lmessagelength
Dim lnumberofwords
Dim lwordarray ()
Dim lbyteposition
Dim lbytecount
Dim lwordcount

Const modulus_bits = 512
Const congruent_bits = 448

Lmessagelength = Len (smessage)

Lnumberofwords = (lmessagelength + (modulus_bits-congruent_bits)/(modulus_bits/second) + 1) * (modulus_bits/bits_to_a_word)
Redim lwordarray (lnumberofwords-1)

Lbyteposition = 0
Lbytecount = 0
Do until lbytecount> = lmessagelength
Lwordcount = lbytecount/bytes_to_a_word
Lbyteposition = (lbytecount mod bytes_to_a_word) * bits_to_a_byte
Lwordarray (lwordcount) = lwordarray (lwordcount) or lshift (ASC (mid (smessage, lbytecount + 1, 1), lbyteposition)
Lbytecount = lbytecount + 1
Loop
 
Lwordcount = lbytecount/bytes_to_a_word
Lbyteposition = (lbytecount mod bytes_to_a_word) * bits_to_a_byte

Lwordarray (lwordcount) = lwordarray (lwordcount) or lshift (& h80, lbyteposition)

Lwordarray (lnumberofwords-2) = lshift (lmessagelength, 3)
Lwordarray (lnumberofwords-1) = rshift (lmessagelength, 29)
 
Converttowordarray = lwordarray
End Function
 
Private function wordtohex (lvalue)
Dim lbyte
Dim lcount

For lcount = 0 to 3
Lbyte = rshift (lvalue, lcount * bits_to_a_byte) and m_lonbits (bits_to_a_byte-1)
Wordtohex = wordtohex & right ("0" & hex (lbyte), 2)
Next
End Function
 
Public Function MD5 (smessage)
M_lonbits (0) = clng (1)
M_lonbits (1) = clng (3)
M_lonbits (2) = clng (7)
M_lonbits (3) = clng (15)
M_lonbits (4) = clng (31)
M_lonbits (5) = clng (63)
M_lonbits (6) = clng (1, 127)
M_lonbits (7) = clng (255)
M_lonbits (8) = clng (511)
M_lonbits (9) = clng (1, 1023)
M_lonbits (10) = clng (2047)
M_lonbits (11) = clng (4095)
M_lonbits (12) = clng (8191)
M_lonbits (13) = clng (1, 16383)
M_lonbits (14) = clng (32767)
M_lonbits (15) = clng (65535)
M_lonbits (16) = clng (131071)
M_lonbits (17) = clng (262143)
M_lonbits (18) = clng (1, 524287)
M_lonbits (19) = clng (1048575)
M_lonbits (20) = clng (2097151)
M_lonbits (21) = clng (4194303)
M_lonbits (22) = clng (1, 8388607)
M_lonbits (23) = clng (1, 16777215)
M_lonbits (24) = clng (33554431)
M_lonbits (25) = clng (67108863)
M_lonbits (26) = clng (134217727)
M_lonbits (27) = clng (268435455)
M_lonbits (28) = clng (536870911)
M_lonbits (29) = clng (1073741823)
M_lonbits (30) = clng (2147483647)

M_l2power (0) = clng (1)
M_l2power (1) = clng (2)
M_l2power (2) = clng (4)
M_l2power (3) = clng (8)
M_l2power (4) = clng (16)
M_l2power (5) = clng (32)
M_l2power (6) = clng (64)
M_l2power (7) = clng (128)
M_l2power (8) = clng (256)
M_l2power (9) = clng (512)
M_l2power (10) = clng (1024)
M_l2power (11) = clng (2048)
M_l2power (12) = clng (4096)
M_l2power (13) = clng (8192)
M_l2power (14) = clng (16384)
M_l2power (15) = clng (32768)
M_l2power (16) = clng (65536)
M_l2power (17) = clng (131072)
M_l2power (18) = clng (262144)
M_l2power (19) = clng (524288)
M_l2power (20) = clng (1048576)
M_l2power (21) = clng (1, 2097152)
M_l2power (22) = clng (4194304)
M_l2power (23) = clng (8388608)
M_l2power (24) = clng (16777216)
M_l2power (25) = clng (33554432)
M_l2power (26) = clng (67108864)
M_l2power (27) = clng (134217728)
M_l2power (28) = clng (268435456)
M_l2power (29) = clng (536870912)
M_l2power (30) = clng (1073741824)


Dim X
Dim K
Dim AA
Dim bb
Dim CC
Dim dd
Dim
Dim B
Dim C
Dim d

Const S11 = 7
Const S12 = 12
Const S13 = 17
Const S14 = 22
Const S21 = 5
Const s22 = 9
Const S23 = 14
Const S24 = 20
Const s31 = 4
Const s32 = 11
Const s33 = 16
Const s34 = 23
Const s41 = 6
Const S42 = 10
Const s43 = 15
Const s44 = 21

X = converttowordarray (smessage)

A = & h67452301
B = & hefcdab89
C = & h98badcfe
D = & h10325476

For k = 0 to ubound (x) Step 16
AA =
BB = B
Cc = C
Dd = d

Md5_ff A, B, C, D, x (K + 0), S11, & hd76aa478
Md5_ff D, a, B, c, x (k + 1), S12, & he8c7b756
Md5_ff C, D, a, B, x (K + 2), S13, & h242070db
Md5_ff B, c, d, A, x (K + 3), S14, & hc1bdceee
Md5_ff A, B, C, D, x (K + 4), S11, & hf57c0faf
Md5_ff D, a, B, c, x (K + 5), S12, & h4787c62a
Md5_ff C, D, a, B, x (K + 6), S13, & ha8304613
Md5_ff B, c, d, A, x (K + 7), S14, & hfd469501
Md5_ff A, B, C, D, x (K + 8), S11, & h698098d8
Md5_ff D, a, B, c, x (K + 9), S12, & h8b44f7af
Md5_ff C, D, a, B, x (K + 10), S13, & hffff5bb1
Md5_ff B, c, d, A, x (K + 11), S14, & h895cd7be
Md5_ff A, B, C, D, x (K + 12), S11, & h6b901122
Md5_ff D, a, B, c, x (K + 13), S12, & hfd987193
Md5_ff C, D, a, B, x (K + 14), S13, & ha679438e
Md5_ff B, c, d, A, x (K + 15), S14, & h49b40821

Md5_gg A, B, C, D, x (k + 1), S21, & hf61e2562
Md5_gg D, a, B, c, x (K + 6), s22, & hc040b340
Md5_gg C, D, a, B, x (K + 11), S23, & h265e5a51
Md5_gg B, c, d, A, x (K + 0), S24, & he9b6c7aa
Md5_gg A, B, C, D, x (K + 5), S21, & hd62f105d
Md5_gg D, a, B, c, x (K + 10), s22, & h2441453
Md5_gg C, D, a, B, x (K + 15), S23, & hd8a1e681
Md5_gg B, c, d, A, x (K + 4), S24, & he7d3fbc8
Md5_gg A, B, C, D, x (K + 9), S21, & h21e1cde6
Md5_gg D, a, B, c, x (K + 14), s22, & hc33707d6
Md5_gg C, D, a, B, x (K + 3), S23, & hf4d50d87
Md5_gg B, c, d, A, x (K + 8), S24, & h455a14ed
Md5_gg A, B, C, D, x (K + 13), S21, & ha9e3e905
Md5_gg D, a, B, c, x (K + 2), s22, & hfcefa3f8
Md5_gg C, D, a, B, x (K + 7), S23, & h676f02d9
Md5_gg B, c, d, A, x (K + 12), S24, & h8d2a4c8a

Md5_hh A, B, C, D, x (K + 5), s31, & hfffa3942
Md5_hh D, a, B, c, x (K + 8), s32, & h8771f681
Md5_hh C, D, a, B, x (K + 11), s33, & h6d9d6122
Md5_hh B, c, d, A, x (K + 14), s34, & hfde5380c
Md5_hh A, B, C, D, x (k + 1), s31, & ha4beea44
Md5_hh D, a, B, c, x (K + 4), s32, & h4bdecfa9
Md5_hh C, D, a, B, x (K + 7), s33, & hf6bb4b60
Md5_hh B, c, d, A, x (K + 10), s34, & hbebfbc70
Md5_hh A, B, C, D, x (K + 13), s31, & h289b7ec6
Md5_hh D, a, B, c, x (K + 0), s32, & heaa1_fa
Md5_hh C, D, a, B, x (K + 3), s33, & hd4ef3085
Md5_hh B, c, d, A, x (K + 6), s34, & h4881d05
Md5_hh A, B, C, D, x (K + 9), s31, & hd9d4d039
Md5_hh D, a, B, c, x (K + 12), s32, & he6db99e5
Md5_hh C, D, a, B, x (K + 15), s33, & h1fa27cf8
Md5_hh B, c, d, A, x (K + 2), s34, & hc4ac5665

Md5_ii A, B, C, D, x (K + 0), s41, & hf4292244
Md5_ii D, a, B, c, x (K + 7), S42, & h432aff97
Md5_ii C, D, a, B, x (K + 14), s43, & hab9423a7
Md5_ii B, c, d, A, x (K + 5), s44, & hfc93a039
Md5_ii A, B, C, D, x (K + 12), s41, & h655b59c3
Md5_ii D, a, B, c, x (K + 3), S42, & h8f0ccc92
Md5_ii C, D, a, B, x (K + 10), s43, & hffeff47d
Md5_ii B, c, d, A, x (k + 1), s44, & h85845dd1
Md5_ii A, B, C, D, x (K + 8), s41, & h6fa87e4f
Md5_ii D, a, B, c, x (K + 15), S42, & hfe2ce6e0
Md5_ii C, D, a, B, x (K + 6), s43, & ha3014314
Md5_ii B, c, d, A, x (K + 13), s44, & h4e0811a1
Md5_ii A, B, C, D, x (K + 4), s41, & hf7537e82
Md5_ii D, a, B, c, x (K + 11), S42, & hbd3af235
Md5_ii C, D, a, B, x (K + 2), s43, & h2ad7d2bb
Md5_ii B, c, d, A, x (K + 9), s44, & heb86d391

A = addunsigned (A, AA)
B = addunsigned (B, BB)
C = addunsigned (C, CC)
D = addunsigned (D, DD)
Next

MD5 = lcase (wordtohex (a) & wordtohex (B) & wordtohex (c) & wordtohex (d ))
End Function
%>