台灣最大程式設計社群網站
線上人數
759
 
會員總數:245619
討論主題:189317
歡迎您免費加入會員
討論區列表 >> 專欄文章 >> MD5及Base64加密功能的程式
[]  
[我要回覆]
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
MD5及Base64加密功能的程式
價值 : 0 QP  點閱數:886 回應數:0
樓主

站務人員 站長
門外漢
0 1580
542 9
發送站內信

捐贈 VP 給 站務人員
======= Base64 ==========

Const sBASE_64_CHARACTERS
= "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

Function Base64encode(ByVal asContents)

Dim lnPosition

Dim lsResult

Dim Char1

Dim Char2

Dim Char3

Dim Char4

Dim Byte1

Dim Byte2

Dim Byte3

Dim SaveBits1

Dim SaveBits2

Dim lsGroupBinary

Dim lsGroup64


If Len(asContents) Mod 3 > 0 Then asContents = asContents & String(3 - (Len(asContents) Mod 3), " ")

lsResult = ""



For lnPosition = 1 To Len(asContents) Step 3

lsGroup64 = ""

lsGroupBinary = Mid(asContents, lnPosition, 3)



Byte1 = Asc(Mid(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3

Byte2 = Asc(Mid(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15

Byte3 = Asc(Mid(lsGroupBinary, 3, 1))



Char1 = Mid(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)

Char2 = Mid(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)

Char3 = Mid(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)

Char4 = Mid(sBASE_64_CHARACTERS, (Byte3 And 63) + 1, 1)

lsGroup64 = Char1 & Char2 & Char3 & Char4



lsResult = lsResult + lsGroup64

Next



Base64encode = lsResult

End Function

========= MD5 ASP Code ==============



<%

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 &H7FFFFFFE) \ 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(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(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(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(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) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 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(127)

m_lOnBits(7) = CLng(255)

m_lOnBits(8) = CLng(511)

m_lOnBits(9) = CLng(1023)

m_lOnBits(10) = CLng(2047)

m_lOnBits(11) = CLng(4095)

m_lOnBits(12) = CLng(8191)

m_lOnBits(13) = CLng(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(524287)

m_lOnBits(19) = CLng(1048575)

m_lOnBits(20) = CLng(2097151)

m_lOnBits(21) = CLng(4194303)

m_lOnBits(22) = CLng(8388607)

m_lOnBits(23) = CLng(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(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 a

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 = a

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, &HEAA127FA

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))

' MD5=LCase(WordToHex(b) & WordToHex(c)) 'I crop this to fit 16byte database password :D

End Function



Response.Write "123456的加密結果為[" & md5 ("123456") & "]"

%>







================================ Base64解密 ==============================



Private Function Base64_Encode(strSource) As String

Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

Dim strTempLine As String

Dim J As Integer

For J = 1 To (Len(strSource) - Len(strSource) Mod 3) Step 3

strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, J, 1)) \ 4) + 1, 1)

strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, J, 1)) Mod 4) * 16 + Asc(Mid(strSource, J + 1, 1)) \ 16) + 1, 1)

strTempLine = strTempLine + Mid(BASE64_TABLE, ((Asc(Mid(strSource, J + 1, 1)) Mod 16) * 4 + Asc(Mid(strSource, J + 2, 1)) \ 64) + 1, 1)

strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, J + 2, 1)) Mod 64) + 1, 1)

Next J

If Not (Len(strSource) Mod 3) = 0 Then

If (Len(strSource) Mod 3) = 2 Then

strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, J, 1)) \ 4) + 1, 1)

strTempLine = strTempLine +
Mid(BASE64_TABLE, (Asc(Mid(strSource, J, 1)) Mod 4) * 16 + Asc(Mid(strSource, J + 1, 1)) \ 16 + 1, 1)

strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, J + 1, 1)) Mod 16) * 4 + 1, 1)

strTempLine = strTempLine & "="

ElseIf (Len(strSource) Mod 3) = 1 Then

strTempLine = strTempLine + Mid(BASE64_TABLE, Asc(Mid(strSource, J, 1)) \ 4 + 1, 1)

strTempLine = strTempLine + Mid(BASE64_TABLE, (Asc(Mid(strSource, J, 1)) Mod 4) * 16 + 1, 1)

strTempLine = strTempLine & "=="

End If

End If

Base64_Encode = strTempLine

End Function

本篇文章發表於2002-04-11 00:00
目前尚無任何回覆
   

回覆
如要回應,請先登入.