%
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32
Class Cls_Encrypt
Private MD5_m_lOnBits(30)
Private MD5_m_l2Power(30)
Private SHA256_m_lOnBits(30)
Private SHA256_m_l2Power(30)
Private SHA256_K(63)
Private Sub Class_Initialize
MD5_m_lOnBits(0) = CLng(1)
MD5_m_lOnBits(1) = CLng(3)
MD5_m_lOnBits(2) = CLng(7)
MD5_m_lOnBits(3) = CLng(15)
MD5_m_lOnBits(4) = CLng(31)
MD5_m_lOnBits(5) = CLng(63)
MD5_m_lOnBits(6) = CLng(127)
MD5_m_lOnBits(7) = CLng(255)
MD5_m_lOnBits(8) = CLng(511)
MD5_m_lOnBits(9) = CLng(1023)
MD5_m_lOnBits(10) = CLng(2047)
MD5_m_lOnBits(11) = CLng(4095)
MD5_m_lOnBits(12) = CLng(8191)
MD5_m_lOnBits(13) = CLng(16383)
MD5_m_lOnBits(14) = CLng(32767)
MD5_m_lOnBits(15) = CLng(65535)
MD5_m_lOnBits(16) = CLng(131071)
MD5_m_lOnBits(17) = CLng(262143)
MD5_m_lOnBits(18) = CLng(524287)
MD5_m_lOnBits(19) = CLng(1048575)
MD5_m_lOnBits(20) = CLng(2097151)
MD5_m_lOnBits(21) = CLng(4194303)
MD5_m_lOnBits(22) = CLng(8388607)
MD5_m_lOnBits(23) = CLng(16777215)
MD5_m_lOnBits(24) = CLng(33554431)
MD5_m_lOnBits(25) = CLng(67108863)
MD5_m_lOnBits(26) = CLng(134217727)
MD5_m_lOnBits(27) = CLng(268435455)
MD5_m_lOnBits(28) = CLng(536870911)
MD5_m_lOnBits(29) = CLng(1073741823)
MD5_m_lOnBits(30) = CLng(2147483647)
MD5_m_l2Power(0) = CLng(1)
MD5_m_l2Power(1) = CLng(2)
MD5_m_l2Power(2) = CLng(4)
MD5_m_l2Power(3) = CLng(8)
MD5_m_l2Power(4) = CLng(16)
MD5_m_l2Power(5) = CLng(32)
MD5_m_l2Power(6) = CLng(64)
MD5_m_l2Power(7) = CLng(128)
MD5_m_l2Power(8) = CLng(256)
MD5_m_l2Power(9) = CLng(512)
MD5_m_l2Power(10) = CLng(1024)
MD5_m_l2Power(11) = CLng(2048)
MD5_m_l2Power(12) = CLng(4096)
MD5_m_l2Power(13) = CLng(8192)
MD5_m_l2Power(14) = CLng(16384)
MD5_m_l2Power(15) = CLng(32768)
MD5_m_l2Power(16) = CLng(65536)
MD5_m_l2Power(17) = CLng(131072)
MD5_m_l2Power(18) = CLng(262144)
MD5_m_l2Power(19) = CLng(524288)
MD5_m_l2Power(20) = CLng(1048576)
MD5_m_l2Power(21) = CLng(2097152)
MD5_m_l2Power(22) = CLng(4194304)
MD5_m_l2Power(23) = CLng(8388608)
MD5_m_l2Power(24) = CLng(16777216)
MD5_m_l2Power(25) = CLng(33554432)
MD5_m_l2Power(26) = CLng(67108864)
MD5_m_l2Power(27) = CLng(134217728)
MD5_m_l2Power(28) = CLng(268435456)
MD5_m_l2Power(29) = CLng(536870912)
MD5_m_l2Power(30) = CLng(1073741824)
SHA256_m_lOnBits(0) = CLng(1)
SHA256_m_lOnBits(1) = CLng(3)
SHA256_m_lOnBits(2) = CLng(7)
SHA256_m_lOnBits(3) = CLng(15)
SHA256_m_lOnBits(4) = CLng(31)
SHA256_m_lOnBits(5) = CLng(63)
SHA256_m_lOnBits(6) = CLng(127)
SHA256_m_lOnBits(7) = CLng(255)
SHA256_m_lOnBits(8) = CLng(511)
SHA256_m_lOnBits(9) = CLng(1023)
SHA256_m_lOnBits(10) = CLng(2047)
SHA256_m_lOnBits(11) = CLng(4095)
SHA256_m_lOnBits(12) = CLng(8191)
SHA256_m_lOnBits(13) = CLng(16383)
SHA256_m_lOnBits(14) = CLng(32767)
SHA256_m_lOnBits(15) = CLng(65535)
SHA256_m_lOnBits(16) = CLng(131071)
SHA256_m_lOnBits(17) = CLng(262143)
SHA256_m_lOnBits(18) = CLng(524287)
SHA256_m_lOnBits(19) = CLng(1048575)
SHA256_m_lOnBits(20) = CLng(2097151)
SHA256_m_lOnBits(21) = CLng(4194303)
SHA256_m_lOnBits(22) = CLng(8388607)
SHA256_m_lOnBits(23) = CLng(16777215)
SHA256_m_lOnBits(24) = CLng(33554431)
SHA256_m_lOnBits(25) = CLng(67108863)
SHA256_m_lOnBits(26) = CLng(134217727)
SHA256_m_lOnBits(27) = CLng(268435455)
SHA256_m_lOnBits(28) = CLng(536870911)
SHA256_m_lOnBits(29) = CLng(1073741823)
SHA256_m_lOnBits(30) = CLng(2147483647)
SHA256_m_l2Power(0) = CLng(1)
SHA256_m_l2Power(1) = CLng(2)
SHA256_m_l2Power(2) = CLng(4)
SHA256_m_l2Power(3) = CLng(8)
SHA256_m_l2Power(4) = CLng(16)
SHA256_m_l2Power(5) = CLng(32)
SHA256_m_l2Power(6) = CLng(64)
SHA256_m_l2Power(7) = CLng(128)
SHA256_m_l2Power(8) = CLng(256)
SHA256_m_l2Power(9) = CLng(512)
SHA256_m_l2Power(10) = CLng(1024)
SHA256_m_l2Power(11) = CLng(2048)
SHA256_m_l2Power(12) = CLng(4096)
SHA256_m_l2Power(13) = CLng(8192)
SHA256_m_l2Power(14) = CLng(16384)
SHA256_m_l2Power(15) = CLng(32768)
SHA256_m_l2Power(16) = CLng(65536)
SHA256_m_l2Power(17) = CLng(131072)
SHA256_m_l2Power(18) = CLng(262144)
SHA256_m_l2Power(19) = CLng(524288)
SHA256_m_l2Power(20) = CLng(1048576)
SHA256_m_l2Power(21) = CLng(2097152)
SHA256_m_l2Power(22) = CLng(4194304)
SHA256_m_l2Power(23) = CLng(8388608)
SHA256_m_l2Power(24) = CLng(16777216)
SHA256_m_l2Power(25) = CLng(33554432)
SHA256_m_l2Power(26) = CLng(67108864)
SHA256_m_l2Power(27) = CLng(134217728)
SHA256_m_l2Power(28) = CLng(268435456)
SHA256_m_l2Power(29) = CLng(536870912)
SHA256_m_l2Power(30) = CLng(1073741824)
SHA256_K(0) = H428A2F98
SHA256_K(1) = H71374491
SHA256_K(2) = HB5C0FBCF
SHA256_K(3) = HE9B5DBA5
SHA256_K(4) = H3956C25B
SHA256_K(5) = H59F111F1
SHA256_K(6) = H923F82A4
SHA256_K(7) = HAB1C5ED5
SHA256_K(8) = HD807AA98
SHA256_K(9) = H12835B01
SHA256_K(10) = H243185BE
SHA256_K(11) = H550C7DC3
SHA256_K(12) = H72BE5D74
SHA256_K(13) = H80DEB1FE
SHA256_K(14) = H9BDC06A7
SHA256_K(15) = HC19BF174
SHA256_K(16) = HE49B69C1
SHA256_K(17) = HEFBE4786
SHA256_K(18) = HFC19DC6
SHA256_K(19) = H240CA1CC
SHA256_K(20) = H2DE92C6F
SHA256_K(21) = H4A7484AA
SHA256_K(22) = H5CB0A9DC
SHA256_K(23) = H76F988DA
SHA256_K(24) = H983E5152
SHA256_K(25) = HA831C66D
SHA256_K(26) = HB00327C8
SHA256_K(27) = HBF597FC7
SHA256_K(28) = HC6E00BF3
SHA256_K(29) = HD5A79147
SHA256_K(30) = H6CA6351
SHA256_K(31) = H14292967
SHA256_K(32) = H27B70A85
SHA256_K(33) = H2E1B2138
SHA256_K(34) = H4D2C6DFC
SHA256_K(35) = H53380D13
SHA256_K(36) = H650A7354
SHA256_K(37) = H766A0ABB
SHA256_K(38) = H81C2C92E
SHA256_K(39) = H92722C85
SHA256_K(40) = HA2BFE8A1
SHA256_K(41) = HA81A664B
SHA256_K(42) = HC24B8B70
SHA256_K(43) = HC76C51A3
SHA256_K(44) = HD192E819
SHA256_K(45) = HD6990624
SHA256_K(46) = HF40E3585
SHA256_K(47) = H106AA070
SHA256_K(48) = H19A4C116
SHA256_K(49) = H1E376C08
SHA256_K(50) = H2748774C
SHA256_K(51) = H34B0BCB5
SHA256_K(52) = H391C0CB3
SHA256_K(53) = H4ED8AA4A
SHA256_K(54) = H5B9CCA4F
SHA256_K(55) = H682E6FF3
SHA256_K(56) = H748F82EE
SHA256_K(57) = H78A5636F
SHA256_K(58) = H84C87814
SHA256_K(59) = H8CC70208
SHA256_K(60) = H90BEFFFA
SHA256_K(61) = HA4506CEB
SHA256_K(62) = HBEF9A3F7
SHA256_K(63) = HC67178F2
End Sub
Private Sub Class_Terminate
End Sub
'字符传转换数组函数
Private Function ConvertToWordArray(byVal 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 LShift(byVal lValue, byVal 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 MD5_m_l2Power(31 - iShiftBits)) Then
LShift = ((lValue And MD5_m_lOnBits(31 - (iShiftBits + 1))) * MD5_m_l2Power(iShiftBits)) or H80000000
Else
LShift = ((lValue And MD5_m_lOnBits(31 - iShiftBits)) * MD5_m_l2Power(iShiftBits))
End If
End Function
'字符串右移位主函数
Private Function RShift(byVal lValue, byVal 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) \ MD5_m_l2Power(iShiftBits)
If (lValue And H80000000) Then
RShift = (RShift or (H40000000 \ MD5_m_l2Power(iShiftBits - 1)))
End If
End Function
'字符串偏移转换，通过左右移位函数实现
Private Function RotateLeft(byVal lValue, byVal iShiftBits)
RotateLeft = LShift(lValue, iShiftBits) or RShift(lValue, (32 - iShiftBits))
End Function
'追加无符号16进制编码
Private Function AddUnsigned(byVal lX, byVal 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

'MD5_FF,MD5_GG,MD5_HH,MD5_II MD5主编码函数
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

'MD5_F,MD5_G,MD5_H,MD5_I MD5辅编码函数
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

'16进制编码转换
Private Function WordToHex(byVal lValue)
Dim lByte
Dim lCount
For lCount = 0 To 3
lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And MD5_m_lOnBits(BITS_TO_A_BYTE - 1)
WordToHex = WordToHex Right("0" Hex(lByte), 2)
Next
End Function

'MD5主函数 MD5(字符串,编码位)
Public Function MD5(byVal sMessage, byVal sType)
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) '加密步骤1：数组转换
a = H67452301
b = HEFCDAB89
c = H98BADCFE
d = H10325476
For k = 0 To UBound(x) Step 16
AA = a
BB = b
CC = c
DD = d
'加密步骤2：编码转换
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
'加密步骤3：追加无符号转换
a = AddUnsigned(a, AA)
b = AddUnsigned(b, BB)
c = AddUnsigned(c, CC)
d = AddUnsigned(d, DD)
Next
If sType = 32 Then
'加密步骤4：分割合并各8位16进制转换
MD5 = LCase(WordToHex(a) WordToHex(b) WordToHex(c) WordToHex(d))
Else
MD5 = LCase(WordToHex(b) WordToHex(c))
End If
End Function
Private Function SHA256_LShift(byVal lValue, byVal iShiftBits)
If iShiftBits = 0 Then
SHA256_LShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And 1 Then
SHA256_LShift = H80000000
Else
SHA256_LShift = 0
End If
Exit Function
ElseIf iShiftBits 0 or iShiftBits > 31 Then
Err.Raise 6
End If
If (lValue And SHA256_m_l2Power(31 - iShiftBits)) Then
SHA256_LShift = ((lValue And SHA256_m_lOnBits(31 - (iShiftBits + 1))) * SHA256_m_l2Power(iShiftBits)) or H80000000
Else
SHA256_LShift = ((lValue And SHA256_m_lOnBits(31 - iShiftBits)) * SHA256_m_l2Power(iShiftBits))
End If
End Function
Private Function SHA256_RShift(byVal lValue, byVal iShiftBits)
If iShiftBits = 0 Then
SHA256_RShift = lValue
Exit Function
ElseIf iShiftBits = 31 Then
If lValue And H80000000 Then
SHA256_RShift = 1
Else
SHA256_RShift = 0
End If
Exit Function
ElseIf iShiftBits 0 or iShiftBits > 31 Then
Err.Raise 6
End If
SHA256_RShift = (lValue And H7FFFFFFE) \ SHA256_m_l2Power(iShiftBits)
If (lValue And H80000000) Then
SHA256_RShift = (SHA256_RShift or (H40000000 \ SHA256_m_l2Power(iShiftBits - 1)))
End If
End Function
Private Function SHA256_AddUnsigned(byVal lX, byVal 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
SHA256_AddUnsigned = lResult
End Function
Private Function SHA256_CH(x, y, z)
SHA256_Ch = ((x And y) Xor ((Not x) And z))
End Function
Private Function SHA256_Maj(x, y, z)
SHA256_Maj = ((x And y) Xor (x And z) Xor (y And z))
End Function
Private Function SHA256_S(x, n)
SHA256_S = (SHA256_RShift(x, (n And SHA256_m_lOnBits(4))) or SHA256_LShift(x, (32 - (n And SHA256_m_lOnBits(4)))))
End Function
Private Function SHA256_R(x, n)
SHA256_R = SHA256_RShift(x, cLng(n And SHA256_m_lOnBits(4)))
End Function
Private Function SHA256_Sigma0(x)
SHA256_Sigma0 = (SHA256_S(x, 2) Xor SHA256_S(x, 13) Xor SHA256_S(x, 22))
End Function
Private Function SHA256_Sigma1(x)
SHA256_Sigma1 = (SHA256_S(x, 6) Xor SHA256_S(x, 11) Xor SHA256_S(x, 25))
End Function
Private Function SHA256_Gamma0(x)
SHA256_Gamma0 = (SHA256_S(x, 7) Xor SHA256_S(x, 18) Xor SHA256_R(x, 3))
End Function
Private Function SHA256_Gamma1(x)
SHA256_Gamma1 = (SHA256_S(x, 17) Xor SHA256_S(x, 19) Xor SHA256_R(x, 10))
End Function
Private Function SHA256_ConvertToWordArray(byVal sMessage)
Dim lMessageLength
Dim lNumberOfWords
Dim lWordArray()
Dim lBytePosition
Dim lByteCount
Dim lWordCount
Dim lByte
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 = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
lByte = AscB(Mid(sMessage, lByteCount + 1, 1))
lWordArray(lWordCount) = lWordArray(lWordCount) or SHA256_LShift(lByte, lBytePosition)
lByteCount = lByteCount + 1
Loop
lWordCount = lByteCount \ BYTES_TO_A_WORD
lBytePosition = (3 - (lByteCount Mod BYTES_TO_A_WORD)) * BITS_TO_A_BYTE
lWordArray(lWordCount) = lWordArray(lWordCount) or SHA256_LShift(H80, lBytePosition)
lWordArray(lNumberOfWords - 1) = SHA256_LShift(lMessageLength, 3)
lWordArray(lNumberOfWords - 2) = SHA256_RShift(lMessageLength, 29)
SHA256_ConvertToWordArray = lWordArray
End Function

' ==========================================================================================
' SHA256 加密算法
' ========================================================================================
' 调用方法：
' SHA256(sMessage, p_Len)
' p_Len控制生成字符串长度，1为8位，2为16位，最大取值为8，即加密后长度为64位
' 控制 8 位\16 位\24 位\32 位\40 位\48 位\56 位\64 位加密
Public Function SHA256(byVal sMessage, byVal p_Len)
Dim HASH(7)
Dim M
Dim W(63)
Dim a
Dim b
Dim c
Dim d
Dim e
Dim f
Dim g
Dim h
Dim i
Dim j
Dim T1
Dim T2
HASH(0) = H6A09E667
HASH(1) = HBB67AE85
HASH(2) = H3C6EF372
HASH(3) = HA54FF53A
HASH(4) = H510E527F
HASH(5) = H9B05688C
HASH(6) = H1F83D9AB
HASH(7) = H5BE0CD19
M = SHA256_ConvertToWordArray(sMessage)
For i = 0 To UBound(M) Step 16
a = HASH(0)
b = HASH(1)
c = HASH(2)
d = HASH(3)
e = HASH(4)
f = HASH(5)
g = HASH(6)
h = HASH(7)
For j = 0 To 63
If j 16 Then
W(j) = M(j + i)
Else
W(j) = SHA256_AddUnsigned(SHA256_AddUnsigned(SHA256_AddUnsigned(SHA256_Gamma1(W(j - 2)), W(j - 7)), SHA256_Gamma0(W(j - 15))), W(j - 16))
End If
T1 = SHA256_AddUnsigned(SHA256_AddUnsigned(SHA256_AddUnsigned(SHA256_AddUnsigned(h, SHA256_Sigma1(e)), SHA256_CH(e, f, g)), SHA256_K(j)), W(j))
T2 = SHA256_AddUnsigned(SHA256_Sigma0(a), SHA256_Maj(a, b, c))
h = g
g = f
f = e
e = SHA256_AddUnsigned(d, T1)
d = c
c = b
b = a
a = SHA256_AddUnsigned(T1, T2)
Next
HASH(0) = SHA256_AddUnsigned(a, HASH(0))
HASH(1) = SHA256_AddUnsigned(b, HASH(1))
HASH(2) = SHA256_AddUnsigned(c, HASH(2))
HASH(3) = SHA256_AddUnsigned(d, HASH(3))
HASH(4) = SHA256_AddUnsigned(e, HASH(4))
HASH(5) = SHA256_AddUnsigned(f, HASH(5))
HASH(6) = SHA256_AddUnsigned(g, HASH(6))
HASH(7) = SHA256_AddUnsigned(h, HASH(7))
Next
SHA256 = ""
If p_Len >= 8 Then p_Len = 8
If p_Len = 0 Then p_Len = 2
For i = 0 To p_Len - 1
SHA256 = SHA256 Right("00000000" Hex(HASH(i)), 8)
Next
SHA256 = LCase(SHA256)
End Function

Public Function EncryptMode(ByVal p_String, ByVal p_Type)
Dim E1s, E2s
E1s = 16 ' 第一次或者MD5算法加密的长度 16位MD5 加密长度
E2s = 2 ' 第二次或者SHA256算法加密的长度 2*8=16位SHA256 加密长度，最大加密长度为8*8=64位
If Not IsNumeric(p_Type) Then
p_Type = 1
ElseIf p_Type > 7 or p_Type 0 Then '判断方案数，根据p_Type最大值判断
p_Type = 1
End If
If Not IsNumeric(E1s) Then
E1s = 16
ElseIf E1s > 16 And E1s > 32 Then
E1s = 16
End If
If Not IsNumeric(E2s) Then
E2s = 2
ElseIf E2s > 8 or E2s 0 Then
E2s = 2
End If
' ==========================================
' 初次布置使用的时候最好调整加密方案，现在最多8种方案
' 加密后字符串长度为16位，使用中可自行调整
' ==========================================
Select Case p_Type
Case 0 ' MD5 算法
EncryptMode = MD5(p_String, E1s)
Case 1 ' SHA256 算法
EncryptMode = SHA256(p_String, E2s)
Case 2 ' 先 MD5 后 SHA256
EncryptMode = SHA256(MD5(p_String, E1s), E2s)
Case 3 ' 先 SHA256 后 MD5
EncryptMode = MD5(SHA256(p_String, E2s), E1s)
Case 4 ' 两次MD5
EncryptMode = MD5(MD5(p_String, E1s), E2s)
Case 5 ' 两次SHA256
EncryptMode = SHA256(SHA256(p_String, E1s), E2s)
Case 6 ' 前8位 MD5 算法 后8位 SHA256 算法
EncryptMode = Left(MD5(p_String, E1s), 8) Right(SHA256(p_String, E2s), 8)
Case 7 ' 前8位 SHA256 算法 后8位 MD5 算法
EncryptMode = Left(SHA256(p_String, E2s), 8) Right(MD5(p_String, E1s), 8)
End Select
End Function
' ============================================
' 全站密码类通用加密函数
' ============================================
Public Function PassWordEnt(ByVal p_String)
If p_String = "" or IsNull(p_String) Then p_String = 1
' 取密码最后一个字符的AscW值与8的余数作为加密方案系数
PassWordEnt = EncryptMode(p_String, AscW(LCase(Right(p_String, 1))) Mod 8)
End Function
End Class
%>

!--#include file="cls_Encrypt.asp"-->
%
Dim o
Set o = new Cls_Encrypt
Response.write "MD5算法：" o.EncryptMode("admin",0) "br />"
Response.write "SHA256算法：" o.EncryptMode("admin",1) "br />"
Response.write "先MD5后SHA256：" o.EncryptMode("admin",2) "br />"
Response.write "先SHA256后MD5：" o.EncryptMode("admin",3) "br />"
Response.write "两次MD5：" o.EncryptMode("admin",4) "br />"
Response.write "两次SHA256：" o.EncryptMode("admin",5) "br />"
Response.write "前8位MD5算法后8位SHA256算法：" o.EncryptMode("admin",6) "br />"
Response.write "前8位SHA256算法后8位MD5算法：" o.EncryptMode("admin",7) "br />hr />"
Response.write "取密码最后一个字符的AscW值与8的余数作为加密方案系数：" o.PassWordEnt("admin") "br />hr />"
Response.write "16位MD5加密：" o.md5("admin",16) "br />"
Response.write "32位MD5加密：" o.md5("admin",32) "br />hr />"
Response.write "8位SHA256加密：" o.sha256("admin",1) "br />"
Response.write "16位SHA256加密：" o.sha256("admin",2) "br />"
Response.write "24位SHA256加密：" o.sha256("admin",3) "br />"
Response.write "32位SHA256加密：" o.sha256("admin",4) "br />"
Response.write "40位SHA256加密：" o.sha256("admin",5) "br />"
Response.write "48位SHA256加密：" o.sha256("admin",6) "br />"
Response.write "56位SHA256加密：" o.sha256("admin",7) "br />"
Response.write "64位SHA256加密：" o.sha256("admin",8) "br />"
Set o = nothing
%>