PageRenderTime 73ms CodeModel.GetById 8ms app.highlight 61ms RepoModel.GetById 1ms app.codeStats 0ms

/inc/md5.inc

http://fsdkp.googlecode.com/
PHP | 444 lines | 396 code | 48 blank | 0 comment | 4 complexity | 83e7183405f26f2893bf6474b9b035d3 MD5 | raw file
  1<%
  2'??MD5????(?????COPY??).??VBSCRIPT/ASP??? 
  3'????? ????Legume  ????? ?????2004.08.17  ????? tg*ddvip.com   
  4' Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm,
  5' as set out in the memo RFC1321.
  6'
  7' See the VB6 project that accompanies this sample for full code comments on how
  8' it works.
  9'
 10' ASP VBScript code for generating an MD5 'digest' or 'signature' of a string. The
 11' MD5 algorithm is one of the industry standard methods for generating digital
 12' signatures. It is generically known as a digest, digital signature, one-way
 13' encryption, hash or checksum algorithm. A common use for MD5 is for password
 14' encryption as it is one-way in nature, that does not mean that your passwords
 15' are not free from a dictionary attack.
 16'
 17' This is 'free' software with the following restrictions:
 18'
 19' You may not redistribute this code as a 'sample' or 'demo'. However, you are free
 20' to use the source code in your own code, but you may not claim that you created
 21' the sample code. It is expressly forbidden to sell or profit from this source code
 22' other than by the knowledge gained or the enhanced value added by your own code.
 23'
 24' Use of this software is also done so at your own risk. The code is supplied as
 25' is without warranty or guarantee of any kind.
 26'
 27' Should you wish to commission some derivative work based on this code provided
 28' here, or any consultancy work, please do not hesitate to contact us.
 29'
 30' Web Site: http://www.frez.co.uk
 31' E-mail: sales@frez.co.uk
 32
 33Private Const BITS_TO_A_BYTE = 8
 34Private Const BYTES_TO_A_WORD = 4
 35Private Const BITS_TO_A_WORD = 32
 36
 37Private m_lOnBits(30)
 38Private m_l2Power(30)
 39
 40m_lOnBits(0) = CLng(1)
 41m_lOnBits(1) = CLng(3)
 42m_lOnBits(2) = CLng(7)
 43m_lOnBits(3) = CLng(15)
 44m_lOnBits(4) = CLng(31)
 45m_lOnBits(5) = CLng(63)
 46m_lOnBits(6) = CLng(127)
 47m_lOnBits(7) = CLng(255)
 48m_lOnBits(8) = CLng(511)
 49m_lOnBits(9) = CLng(1023)
 50m_lOnBits(10) = CLng(2047)
 51m_lOnBits(11) = CLng(4095)
 52m_lOnBits(12) = CLng(8191)
 53m_lOnBits(13) = CLng(16383)
 54m_lOnBits(14) = CLng(32767)
 55m_lOnBits(15) = CLng(65535)
 56m_lOnBits(16) = CLng(131071)
 57m_lOnBits(17) = CLng(262143)
 58m_lOnBits(18) = CLng(524287)
 59m_lOnBits(19) = CLng(1048575)
 60m_lOnBits(20) = CLng(2097151)
 61m_lOnBits(21) = CLng(4194303)
 62m_lOnBits(22) = CLng(8388607)
 63m_lOnBits(23) = CLng(16777215)
 64m_lOnBits(24) = CLng(33554431)
 65m_lOnBits(25) = CLng(67108863)
 66m_lOnBits(26) = CLng(134217727)
 67m_lOnBits(27) = CLng(268435455)
 68m_lOnBits(28) = CLng(536870911)
 69m_lOnBits(29) = CLng(1073741823)
 70m_lOnBits(30) = CLng(2147483647)
 71
 72m_l2Power(0) = CLng(1)
 73m_l2Power(1) = CLng(2)
 74m_l2Power(2) = CLng(4)
 75m_l2Power(3) = CLng(8)
 76m_l2Power(4) = CLng(16)
 77m_l2Power(5) = CLng(32)
 78m_l2Power(6) = CLng(64)
 79m_l2Power(7) = CLng(128)
 80m_l2Power(8) = CLng(256)
 81m_l2Power(9) = CLng(512)
 82m_l2Power(10) = CLng(1024)
 83m_l2Power(11) = CLng(2048)
 84m_l2Power(12) = CLng(4096)
 85m_l2Power(13) = CLng(8192)
 86m_l2Power(14) = CLng(16384)
 87m_l2Power(15) = CLng(32768)
 88m_l2Power(16) = CLng(65536)
 89m_l2Power(17) = CLng(131072)
 90m_l2Power(18) = CLng(262144)
 91m_l2Power(19) = CLng(524288)
 92m_l2Power(20) = CLng(1048576)
 93m_l2Power(21) = CLng(2097152)
 94m_l2Power(22) = CLng(4194304)
 95m_l2Power(23) = CLng(8388608)
 96m_l2Power(24) = CLng(16777216)
 97m_l2Power(25) = CLng(33554432)
 98m_l2Power(26) = CLng(67108864)
 99m_l2Power(27) = CLng(134217728)
100m_l2Power(28) = CLng(268435456)
101m_l2Power(29) = CLng(536870912)
102m_l2Power(30) = CLng(1073741824)
103
104Private Function LShift(lValue, iShiftBits)
105If iShiftBits = 0 Then
106LShift = lValue
107Exit Function
108ElseIf iShiftBits = 31 Then
109If lValue And 1 Then
110LShift = &H80000000
111Else
112LShift = 0
113End If
114Exit Function
115ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
116Err.Raise 6
117End If
118
119If (lValue And m_l2Power(31 - iShiftBits)) Then
120LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
121Else
122LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
123End If
124End Function
125
126Private Function RShift(lValue, iShiftBits)
127If iShiftBits = 0 Then
128RShift = lValue
129Exit Function
130ElseIf iShiftBits = 31 Then
131If lValue And &H80000000 Then
132RShift = 1
133Else
134RShift = 0
135End If
136Exit Function
137ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
138Err.Raise 6
139End If
140
141RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
142
143If (lValue And &H80000000) Then
144RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
145End If
146End Function
147
148Private Function RotateLeft(lValue, iShiftBits)
149RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
150End Function
151
152Private Function AddUnsigned(lX, lY)
153Dim lX4
154Dim lY4
155Dim lX8
156Dim lY8
157Dim lResult
158
159lX8 = lX And &H80000000
160lY8 = lY And &H80000000
161lX4 = lX And &H40000000
162lY4 = lY And &H40000000
163
164lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
165
166If lX4 And lY4 Then
167lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
168ElseIf lX4 Or lY4 Then
169If lResult And &H40000000 Then
170lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
171Else
172lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
173End If
174Else
175lResult = lResult Xor lX8 Xor lY8
176End If
177
178AddUnsigned = lResult
179End Function
180
181Private Function F(x, y, z)
182F = (x And y) Or ((Not x) And z)
183End Function
184
185Private Function G(x, y, z)
186G = (x And z) Or (y And (Not z))
187End Function
188
189Private Function H(x, y, z)
190H = (x Xor y Xor z)
191End Function
192
193Private Function I2(x, y, z)
194I2 = (y Xor (x Or (Not z)))
195End Function
196
197Private Sub FF(a, b, c, d, x, s, ac)
198a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac))
199a = RotateLeft(a, s)
200a = AddUnsigned(a, b)
201End Sub
202
203Private Sub GG(a, b, c, d, x, s, ac)
204a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))
205a = RotateLeft(a, s)
206a = AddUnsigned(a, b)
207End Sub
208
209Private Sub HH(a, b, c, d, x, s, ac)
210a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))
211a = RotateLeft(a, s)
212a = AddUnsigned(a, b)
213End Sub
214
215Private Sub II(a, b, c, d, x, s, ac)
216a = AddUnsigned(a, AddUnsigned(AddUnsigned(I2(b, c, d), x), ac))
217a = RotateLeft(a, s)
218a = AddUnsigned(a, b)
219End Sub
220
221Private Function ConvertToWordArray(sMessage)
222Dim lMessageLength
223Dim lNumberOfWords
224Dim lWordArray()
225Dim lBytePosition
226Dim lByteCount
227Dim lWordCount
228
229Const MODULUS_BITS = 512
230Const CONGRUENT_BITS = 448
231
232lMessageLength = Len(sMessage)
233
234lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
235ReDim lWordArray(lNumberOfWords - 1)
236
237lBytePosition = 0
238lByteCount = 0
239Do Until lByteCount >= lMessageLength
240lWordCount = lByteCount \ BYTES_TO_A_WORD
241lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
242lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
243lByteCount = lByteCount + 1
244Loop
245
246lWordCount = lByteCount \ BYTES_TO_A_WORD
247lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
248
249lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
250
251lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
252lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
253
254ConvertToWordArray = lWordArray
255End Function
256
257Private Function WordToHex(lValue)
258Dim lByte
259Dim lCount
260
261For lCount = 0 To 3
262lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
263WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
264Next
265End Function
266
267Public Function MD5(sMessage)
268Dim x
269Dim k
270Dim AA
271Dim BB
272Dim CC
273Dim DD
274Dim a
275Dim b
276Dim c
277Dim d
278
279Const S11 = 7
280Const S12 = 12
281Const S13 = 17
282Const S14 = 22
283Const S21 = 5
284Const S22 = 9
285Const S23 = 14
286Const S24 = 20
287Const S31 = 4
288Const S32 = 11
289Const S33 = 16
290Const S34 = 23
291Const S41 = 6
292Const S42 = 10
293Const S43 = 15
294Const S44 = 21
295
296x = ConvertToWordArray(sMessage)
297
298a = &H67452301
299b = &HEFCDAB89
300c = &H98BADCFE
301d = &H10325476
302
303For k = 0 To UBound(x) Step 16
304AA = a
305BB = b
306CC = c
307DD = d
308
309FF a, b, c, d, x(k + 0), S11, &HD76AA478
310FF d, a, b, c, x(k + 1), S12, &HE8C7B756
311FF c, d, a, b, x(k + 2), S13, &H242070DB
312FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
313FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
314FF d, a, b, c, x(k + 5), S12, &H4787C62A
315FF c, d, a, b, x(k + 6), S13, &HA8304613
316FF b, c, d, a, x(k + 7), S14, &HFD469501
317FF a, b, c, d, x(k + 8), S11, &H698098D8
318FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
319FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
320FF b, c, d, a, x(k + 11), S14, &H895CD7BE
321FF a, b, c, d, x(k + 12), S11, &H6B901122
322FF d, a, b, c, x(k + 13), S12, &HFD987193
323FF c, d, a, b, x(k + 14), S13, &HA679438E
324FF b, c, d, a, x(k + 15), S14, &H49B40821
325
326GG a, b, c, d, x(k + 1), S21, &HF61E2562
327GG d, a, b, c, x(k + 6), S22, &HC040B340
328GG c, d, a, b, x(k + 11), S23, &H265E5A51
329GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
330GG a, b, c, d, x(k + 5), S21, &HD62F105D
331GG d, a, b, c, x(k + 10), S22, &H2441453
332GG c, d, a, b, x(k + 15), S23, &HD8A1E681
333GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
334GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
335GG d, a, b, c, x(k + 14), S22, &HC33707D6
336GG c, d, a, b, x(k + 3), S23, &HF4D50D87
337GG b, c, d, a, x(k + 8), S24, &H455A14ED
338GG a, b, c, d, x(k + 13), S21, &HA9E3E905
339GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
340GG c, d, a, b, x(k + 7), S23, &H676F02D9
341GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
342
343HH a, b, c, d, x(k + 5), S31, &HFFFA3942
344HH d, a, b, c, x(k + 8), S32, &H8771F681
345HH c, d, a, b, x(k + 11), S33, &H6D9D6122
346HH b, c, d, a, x(k + 14), S34, &HFDE5380C
347HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
348HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
349HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
350HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
351HH a, b, c, d, x(k + 13), S31, &H289B7EC6
352HH d, a, b, c, x(k + 0), S32, &HEAA127FA
353HH c, d, a, b, x(k + 3), S33, &HD4EF3085
354HH b, c, d, a, x(k + 6), S34, &H4881D05
355HH a, b, c, d, x(k + 9), S31, &HD9D4D039
356HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
357HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
358HH b, c, d, a, x(k + 2), S34, &HC4AC5665
359
360II a, b, c, d, x(k + 0), S41, &HF4292244
361II d, a, b, c, x(k + 7), S42, &H432AFF97
362II c, d, a, b, x(k + 14), S43, &HAB9423A7
363II b, c, d, a, x(k + 5), S44, &HFC93A039
364II a, b, c, d, x(k + 12), S41, &H655B59C3
365II d, a, b, c, x(k + 3), S42, &H8F0CCC92
366II c, d, a, b, x(k + 10), S43, &HFFEFF47D
367II b, c, d, a, x(k + 1), S44, &H85845DD1
368II a, b, c, d, x(k + 8), S41, &H6FA87E4F
369II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
370II c, d, a, b, x(k + 6), S43, &HA3014314
371II b, c, d, a, x(k + 13), S44, &H4E0811A1
372II a, b, c, d, x(k + 4), S41, &HF7537E82
373II d, a, b, c, x(k + 11), S42, &HBD3AF235
374II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
375II b, c, d, a, x(k + 9), S44, &HEB86D391
376
377a = AddUnsigned(a, AA)
378b = AddUnsigned(b, BB)
379c = AddUnsigned(c, CC)
380d = AddUnsigned(d, DD)
381Next
382
383MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
384End Function
385
386
387Function GetSysInfo(InfoType)'??????
388  Dim WshShell,WshSysEnv
389  Set WshShell = Server.CreateObject("WScript.Shell")
390  Set WshSysEnv = WshShell.Environment("SYSTEM")
391  If InfoType="CPUNums" Then
392		GetSysInfo=Cstr(WshSysEnv("NUMBER_OF_PROCESSORS"))
393		If IsNull(GetSysInfo) Then
394			GetSysInfo = Request.ServerVariables("NUMBER_OF_PROCESSORS")
395		ElseIf GetSysInfo="" Then
396			GetSysInfo = Request.ServerVariables("NUMBER_OF_PROCESSORS")
397		End If
398	ElseIf InfoType="CPUInfo" Then
399		GetSysInfo = Cstr(WshSysEnv("PROCESSOR_IDENTIFIER"))
400	ElseIf InfoType="OSInfo" Then
401		GetSysInfo = Cstr(WshSysEnv("OS"))
402		If Request.ServerVariables("OS")="" Then GetSysInfo=GetSysInfo & "(?Windows Server 2003)"
403	End If 
404End Function
405
406Function CheckObjInstalled(strClassString)'????????
407	On Error Resume Next
408	Dim TmpObj
409	Set TmpObj = Server.CreateObject(strClassString)
410	IF Err = 0 OR Err = -2147221477 Then
411		CheckObjInstalled= "??"
412	ElseIF Err = 1 OR Err = -2147221005 Then
413		CheckObjInstalled="???"
414	End IF
415	Err.Clear
416	Set TmpObj = Nothing
417End Function
418
419Function GetTotalSize(GetLocal,GetType)'??????????
420	Dim FSO
421	Set FSO=Server.CreateObject("Scripting.FileSystemObject")
422	IF Err<>0 Then
423		Err.Clear
424		GetTotalSize="?????FSO??"
425	Else
426		Dim SiteFolder
427		IF GetType="Folder" Then
428			Set SiteFolder=FSO.GetFolder(GetLocal) 
429		Else
430			Set SiteFolder=FSO.GetFile(GetLocal) 
431		End IF
432		GetTotalSize=SiteFolder.Size
433		IF GetTotalSize>1024*1024 Then
434		GetTotalSize=GetTotalSize/1024/1024
435		IF inStr(GetTotalSize,".") Then GetTotalSize = Left(GetTotalSize,inStr(GetTotalSize,".")+2)
436			GetTotalSize=GetTotalSize&" MB"
437		Else
438			GetTotalSize=Fix(GetTotalSize/1024)&" KB"
439		End IF
440		Set SiteFolder=Nothing
441	End IF
442	Set FSO=Nothing
443End Function
444%>