<% '******************************************************************* '取得IP地址 '******************************************************************* Function Userip()     Dim GetClientIP     '如果客户端用了代理服务器，则应该用ServerVariables("HTTP_X_FORWARDED_FOR")方法     GetClientIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")     If GetClientIP = "" or IsNull(GetClientIP) or IsEmpty(GetClientIP) Then         '如果客户端没用代理，应该用Request.ServerVariables("REMOTE_ADDR")方法         GetClientIP = Request.ServerVariables("REMOTE_ADDR")     End If     Userip = GetClientIP End Function '******************************************************************* '转换IP地址 '******************************************************************* Function cip(sip)     tip = CStr(sip)     sip1 = Left(tip, CInt(InStr(tip, ".") -1))     tip = Mid(tip, CInt(InStr(tip, ".") + 1))     sip2 = Left(tip, CInt(InStr(tip, ".") -1))     tip = Mid(tip, CInt(InStr(tip, ".") + 1))     sip3 = Left(tip, CInt(InStr(tip, ".") -1))     sip4 = Mid(tip, CInt(InStr(tip, ".") + 1))     cip = CInt(sip1) * 256 * 256 * 256 + CInt(sip2) * 256 * 256 + CInt(sip3) * 256 + CInt(sip4) End Function '******************************************************************* ' 弹出对话框 '******************************************************************* Sub alert(message)     message = Replace(message, "'", "\'")     Response.Write ("<script>alert('" & message & "')</script>") End Sub '******************************************************************* ' 返回上一页，一般用在判断信息提交是否完全之后 '******************************************************************* Sub GoBack()     Response.Write ("<script>history.go(-1)</script>") End Sub '******************************************************************* ' 重定向另外的连接 '******************************************************************* Sub Go(url)     Response.Write ("<script>location.href('" & url & "')</script>") End Sub '******************************************************************* ' 我比较喜欢将以上三个结合起来使用 '******************************************************************* Function Alert(message, gourl)     message = Replace(message, "'", "\'")     If gourl = "-1" Then         Response.Write ("<script language=javascript>alert('" & message & "');history.go(-1)</script>")     Else         Response.Write ("<script language=javascript>alert('" & message & "');location='" & gourl &"'</script>")     End If     Response.End() End Function '******************************************************************* ' 指定秒数重定向另外的连接 '******************************************************************* Sub GoPage(url, s)     s = s * 1000     Response.Write "<SCRIPT LANGUAGE=JavaScript>"     Response.Write "window.setTimeout("&Chr(34)&"window.navigate('"&url&"')"&Chr(34)&","&s&")"     Response.Write "</script>" End Sub '******************************************************************* ' 判断数字是否整形 '******************************************************************* Function isInteger(para)     On Error Resume Next     Dim Str     Dim l, i     If IsNull(para) Then         isInteger = False         Exit Function     End If     Str = CStr(para)     If Trim(Str) = "" Then         isInteger = False         Exit Function     End If     l = Len(Str)     For i = 1 To l         If Mid(Str, i, 1)>"9" or Mid(Str, i, 1)<"0" Then             isInteger = False             Exit Function         End If     Next     isInteger = True     If Err.Number<>0 Then Err.Clear End Function '******************************************************************* ' 获得文件扩展名 '******************************************************************* Function GetExtend(filename)     Dim tmp     If filename<>"" Then         tmp = Mid(filename, instrrev(filename, ".") + 1, Len(filename) - instrrev(filename, "."))         tmp = LCase(tmp)         If InStr(1, tmp, "asp")>0 or InStr(1, tmp, "php")>0 or InStr(1, tmp, "php3")>0 or InStr(1, tmp, "aspx")>0 Then             getextend = "txt"         Else             getextend = tmp         End If     Else         getextend = ""     End If End Function ' *---------------------------------------------------------------------------- ' * 函数：CheckIn ' * 描述：检测参数是否有SQL危险字符 ' * 参数：str要检测的数据 ' * 返回：FALSE：安全 TRUE：不安全 ' * 作者： ' * 日期： ' *---------------------------------------------------------------------------- Function CheckIn(Str)     If InStr(1, Str, Chr(39))>0 or InStr(1, Str, Chr(34))>0 or InStr(1, Str, Chr(59))>0 Then         CheckIn = True     Else         CheckIn = False     End If End Function ' *---------------------------------------------------------------------------- ' * 函数：HTMLEncode ' * 描述：过滤HTML代码 ' * 参数：-- ' * 返回：-- ' * 作者： ' * 日期： ' *---------------------------------------------------------------------------- Function HTMLEncode(fString)     If Not IsNull(fString) Then         fString = Replace(fString, ">", ">")         fString = Replace(fString, "<", "<")         fString = Replace(fString, Chr(32), " ")         fString = Replace(fString, Chr(9), " ")         fString = Replace(fString, Chr(34), """)         fString = Replace(fString, Chr(39), "'")         fString = Replace(fString, Chr(13), "")         fString = Replace(fString, Chr(10) & Chr(10), "</P><P> ")         fString = Replace(fString, Chr(10), "<BR> ")         HTMLEncode = fString     End If End Function ' *---------------------------------------------------------------------------- ' * 函数：HTMLcode ' * 描述：过滤表单字符 ' * 参数：-- ' * 返回：-- ' * 作者： ' * 日期： ' *---------------------------------------------------------------------------- Function HTMLcode(fString)     If Not IsNull(fString) Then         fString = Replace(fString, Chr(13), "")         fString = Replace(fString, Chr(10) & Chr(10), "</P><P>")         fString = Replace(fString, Chr(34), "")         fString = Replace(fString, Chr(10), "<BR>")         HTMLcode = fString     End If End Function %> <% 1.检查是否有效邮件地址 Function CheckEmail(strEmail)     Dim re     Set re = New RegExp     re.Pattern = "^[w-.]{1,}@([da-zA-Z-]{1,}.){1,}[da-zA-Z-]{2,3}$"     re.IgnoreCase = True     CheckEmail = re.Test(strEmail) End Function 2.测试变量是否为空值，空值的含义包括：变量不存在 / 为空，对象为Nothing，0，空数组，字符串为空 Function IsBlank(ByRef Var)     IsBlank = False     Select Case True         Case IsObject(Var)             If Var Is Nothing Then IsBlank = True         Case IsEmpty(Var), IsNull(Var)             IsBlank = True         Case IsArray(Var)             If UBound(Var) = 0 Then IsBlank = True         Case IsNumeric(Var)             If (Var = 0) Then IsBlank = True         Case Else             If Trim(Var) = "" Then IsBlank = True     End Select End Function 3.得到浏览器目前的URL Function GetCurURL()     If Request.ServerVariables("HTTPS") = "on" Then         GetCurrentURL = "https://"     Else         GetCurrentURL = "http://"     End If     GetCurURL = GetCurURL & Request.ServerVariables("SERVER_NAME")     If (Request.ServerVariables("SERVER_PORT") <> 80) Then GetCurURL = GetCurURL & ":" & Request.ServerVariables("SERVER_PORT")     GetCurURL = GetCurURL & Request.ServerVariables("URL")     If (Request.QueryString <> "") Then GetCurURL = GetCurURL & "?" & Request.QueryString End Function 4.MD5加密函数 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) 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) 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 F(x, y, z)     F = (x And y) or ((Not x) And z) End Function Private Function G(x, y, z)     G = (x And z) or (y And (Not z)) End Function Private Function H(x, y, z)     H = (x Xor y Xor z) End Function Private Function I(x, y, z)     I = (y Xor (x or (Not z))) End Function Private Sub FF(a, b, c, d, x, s, ac)     a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac))     a = RotateLeft(a, s)     a = AddUnsigned(a, b) End Sub Private Sub GG(a, b, c, d, x, s, ac)     a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))     a = RotateLeft(a, s)     a = AddUnsigned(a, b) End Sub Private Sub HH(a, b, c, d, x, s, ac)     a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))     a = RotateLeft(a, s)     a = AddUnsigned(a, b) End Sub Private Sub II(a, b, c, d, x, s, ac)     a = AddUnsigned(a, AddUnsigned(AddUnsigned(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)     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         FF a, b, c, d, x(k + 0), S11, &HD76AA478         FF d, a, b, c, x(k + 1), S12, &HE8C7B756         FF c, d, a, b, x(k + 2), S13, &H242070DB         FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE         FF a, b, c, d, x(k + 4), S11, &HF57C0FAF         FF d, a, b, c, x(k + 5), S12, &H4787C62A         FF c, d, a, b, x(k + 6), S13, &HA8304613         FF b, c, d, a, x(k + 7), S14, &HFD469501         FF a, b, c, d, x(k + 8), S11, &H698098D8         FF d, a, b, c, x(k + 9), S12, &H8B44F7AF         FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1         FF b, c, d, a, x(k + 11), S14, &H895CD7BE         FF a, b, c, d, x(k + 12), S11, &H6B901122         FF d, a, b, c, x(k + 13), S12, &HFD987193         FF c, d, a, b, x(k + 14), S13, &HA679438E         FF b, c, d, a, x(k + 15), S14, &H49B40821         GG a, b, c, d, x(k + 1), S21, &HF61E2562         GG d, a, b, c, x(k + 6), S22, &HC040B340         GG c, d, a, b, x(k + 11), S23, &H265E5A51         GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA         GG a, b, c, d, x(k + 5), S21, &HD62F105D         GG d, a, b, c, x(k + 10), S22, &H2441453         GG c, d, a, b, x(k + 15), S23, &HD8A1E681         GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8         GG a, b, c, d, x(k + 9), S21, &H21E1CDE6         GG d, a, b, c, x(k + 14), S22, &HC33707D6         GG c, d, a, b, x(k + 3), S23, &HF4D50D87         GG b, c, d, a, x(k + 8), S24, &H455A14ED         GG a, b, c, d, x(k + 13), S21, &HA9E3E905         GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8         GG c, d, a, b, x(k + 7), S23, &H676F02D9         GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A         HH a, b, c, d, x(k + 5), S31, &HFFFA3942         HH d, a, b, c, x(k + 8), S32, &H8771F681         HH c, d, a, b, x(k + 11), S33, &H6D9D6122         HH b, c, d, a, x(k + 14), S34, &HFDE5380C         HH a, b, c, d, x(k + 1), S31, &HA4BEEA44         HH d, a, b, c, x(k + 4), S32, &H4BDECFA9         HH c, d, a, b, x(k + 7), S33, &HF6BB4B60         HH b, c, d, a, x(k + 10), S34, &HBEBFBC70         HH a, b, c, d, x(k + 13), S31, &H289B7EC6         HH d, a, b, c, x(k + 0), S32, &HEAA127FA         HH c, d, a, b, x(k + 3), S33, &HD4EF3085         HH b, c, d, a, x(k + 6), S34, &H4881D05         HH a, b, c, d, x(k + 9), S31, &HD9D4D039         HH d, a, b, c, x(k + 12), S32, &HE6DB99E5         HH c, d, a, b, x(k + 15), S33, &H1FA27CF8         HH b, c, d, a, x(k + 2), S34, &HC4AC5665         II a, b, c, d, x(k + 0), S41, &HF4292244         II d, a, b, c, x(k + 7), S42, &H432AFF97         II c, d, a, b, x(k + 14), S43, &HAB9423A7         II b, c, d, a, x(k + 5), S44, &HFC93A039         II a, b, c, d, x(k + 12), S41, &H655B59C3         II d, a, b, c, x(k + 3), S42, &H8F0CCC92         II c, d, a, b, x(k + 10), S43, &HFFEFF47D         II b, c, d, a, x(k + 1), S44, &H85845DD1         II a, b, c, d, x(k + 8), S41, &H6FA87E4F         II d, a, b, c, x(k + 15), S42, &HFE2CE6E0         II c, d, a, b, x(k + 6), S43, &HA3014314         II b, c, d, a, x(k + 13), S44, &H4E0811A1         II a, b, c, d, x(k + 4), S41, &HF7537E82         II d, a, b, c, x(k + 11), S42, &HBD3AF235         II c, d, a, b, x(k + 2), S43, &H2AD7D2BB         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 5.SHA256 加密，256位的加密哦！安全性更高！ Private m_lOnBits(30) Private m_l2Power(30) Private K(63) Private Const BITS_TO_A_BYTE = 8 Private Const BYTES_TO_A_WORD = 4 Private Const BITS_TO_A_WORD = 32 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) K(0) = &H428A2F98 K(1) = &H71374491 K(2) = &HB5C0FBCF K(3) = &HE9B5DBA5 K(4) = &H3956C25B K(5) = &H59F111F1 K(6) = &H923F82A4 K(7) = &HAB1C5ED5 K(8) = &HD807AA98 K(9) = &H12835B01 K(10) = &H243185BE K(11) = &H550C7DC3 K(12) = &H72BE5D74 K(13) = &H80DEB1FE K(14) = &H9BDC06A7 K(15) = &HC19BF174 K(16) = &HE49B69C1 K(17) = &HEFBE4786 K(18) = &HFC19DC6 K(19) = &H240CA1CC K(20) = &H2DE92C6F K(21) = &H4A7484AA K(22) = &H5CB0A9DC K(23) = &H76F988DA K(24) = &H983E5152 K(25) = &HA831C66D K(26) = &HB00327C8 K(27) = &HBF597FC7 K(28) = &HC6E00BF3 K(29) = &HD5A79147 K(30) = &H6CA6351 K(31) = &H14292967 K(32) = &H27B70A85 K(33) = &H2E1B2138 K(34) = &H4D2C6DFC K(35) = &H53380D13 K(36) = &H650A7354 K(37) = &H766A0ABB K(38) = &H81C2C92E K(39) = &H92722C85 K(40) = &HA2BFE8A1 K(41) = &HA81A664B K(42) = &HC24B8B70 K(43) = &HC76C51A3 K(44) = &HD192E819 K(45) = &HD6990624 K(46) = &HF40E3585 K(47) = &H106AA070 K(48) = &H19A4C116 K(49) = &H1E376C08 K(50) = &H2748774C K(51) = &H34B0BCB5 K(52) = &H391C0CB3 K(53) = &H4ED8AA4A K(54) = &H5B9CCA4F K(55) = &H682E6FF3 K(56) = &H748F82EE K(57) = &H78A5636F K(58) = &H84C87814 K(59) = &H8CC70208 K(60) = &H90BEFFFA K(61) = &HA4506CEB K(62) = &HBEF9A3F7 K(63) = &HC67178F2 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 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 Ch(x, y, z)     Ch = ((x And y) Xor ((Not x) And z)) End Function Private Function Maj(x, y, z)     Maj = ((x And y) Xor (x And z) Xor (y And z)) End Function Private Function S(x, n)     S = (RShift(x, (n And m_lOnBits(4))) or LShift(x, (32 - (n And m_lOnBits(4))))) End Function Private Function R(x, n)     R = RShift(x, CInt(n And m_lOnBits(4))) End Function Private Function Sigma0(x)     Sigma0 = (S(x, 2) Xor S(x, 13) Xor S(x, 22)) End Function Private Function Sigma1(x)     Sigma1 = (S(x, 6) Xor S(x, 11) Xor S(x, 25)) End Function Private Function Gamma0(x)     Gamma0 = (S(x, 7) Xor S(x, 18) Xor R(x, 3)) End Function Private Function Gamma1(x)     Gamma1 = (S(x, 17) Xor S(x, 19) Xor R(x, 10)) End Function Private Function ConvertToWordArray(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 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 LShift(&H80, lBytePosition)     lWordArray(lNumberOfWords - 1) = LShift(lMessageLength, 3)     lWordArray(lNumberOfWords - 2) = RShift(lMessageLength, 29)     ConvertToWordArray = lWordArray End Function Public Function SHA256(sMessage)     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 = 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) = AddUnsigned(AddUnsigned(AddUnsigned(Gamma1(W(j - 2)), W(j - 7)), Gamma0(W(j - 15))), W(j - 16))             End If             T1 = AddUnsigned(AddUnsigned(AddUnsigned(AddUnsigned(h, Sigma1(e)), Ch(e, f, g)), K(j)), W(j))             T2 = AddUnsigned(Sigma0(a), Maj(a, b, c))             h = g             g = f             f = e             e = AddUnsigned(d, T1)             d = c             c = b             b = a             a = AddUnsigned(T1, T2)         Next         HASH(0) = AddUnsigned(a, HASH(0))         HASH(1) = AddUnsigned(b, HASH(1))         HASH(2) = AddUnsigned(c, HASH(2))         HASH(3) = AddUnsigned(d, HASH(3))         HASH(4) = AddUnsigned(e, HASH(4))         HASH(5) = AddUnsigned(f, HASH(5))         HASH(6) = AddUnsigned(g, HASH(6))         HASH(7) = AddUnsigned(h, HASH(7))     Next     SHA256 = LCase(Right("00000000" & Hex(HASH(0)), 8) & Right("00000000" & Hex(HASH(1)), 8) & Right("00000000" & Hex(HASH(2)), 8) & Right("00000000" & Hex(HASH(3)), 8) & Right("00000000" & Hex(HASH(4)), 8) & Right("00000000" & Hex(HASH(5)), 8) & Right("00000000" & Hex(HASH(6)), 8) & Right("00000000" & Hex(HASH(7)), 8)) End Function 6.一个If语句的加工，以后可以用类似于PHP或JS的 If () ? .. ...代码了 Function IIf(Condition, ValueIfTrue, ValueIfFalse)     If Condition Then         IIf = ValueIfTrue     Else         IIf = ValueIfFalse     End If End Function 7.ASE加密函数 Private m_lOnBits(30) Private m_l2Power(30) Private m_bytOnBits(7) Private m_byt2Power(7) Private m_InCo(3) Private m_fbsub(255) Private m_rbsub(255) Private m_ptab(255) Private m_ltab(255) Private m_ftable(255) Private m_rtable(255) Private m_rco(29) Private m_Nk Private m_Nb Private m_Nr Private m_fi(23) Private m_ri(23) Private m_fkey(119) Private m_rkey(119) m_InCo(0) = &HB m_InCo(1) = &HD m_InCo(2) = &H9 m_InCo(3) = &HE m_bytOnBits(0) = 1 m_bytOnBits(1) = 3 m_bytOnBits(2) = 7 m_bytOnBits(3) = 15 m_bytOnBits(4) = 31 m_bytOnBits(5) = 63 m_bytOnBits(6) = 127 m_bytOnBits(7) = 255 m_byt2Power(0) = 1 m_byt2Power(1) = 2 m_byt2Power(2) = 4 m_byt2Power(3) = 8 m_byt2Power(4) = 16 m_byt2Power(5) = 32 m_byt2Power(6) = 64 m_byt2Power(7) = 128 m_lOnBits(0) = 1 m_lOnBits(1) = 3 m_lOnBits(2) = 7 m_lOnBits(3) = 15 m_lOnBits(4) = 31 m_lOnBits(5) = 63 m_lOnBits(6) = 127 m_lOnBits(7) = 255 m_lOnBits(8) = 511 m_lOnBits(9) = 1023 m_lOnBits(10) = 2047 m_lOnBits(11) = 4095 m_lOnBits(12) = 8191 m_lOnBits(13) = 16383 m_lOnBits(14) = 32767 m_lOnBits(15) = 65535 m_lOnBits(16) = 131071 m_lOnBits(17) = 262143 m_lOnBits(18) = 524287 m_lOnBits(19) = 1048575 m_lOnBits(20) = 2097151 m_lOnBits(21) = 4194303 m_lOnBits(22) = 8388607 m_lOnBits(23) = 16777215 m_lOnBits(24) = 33554431 m_lOnBits(25) = 67108863 m_lOnBits(26) = 134217727 m_lOnBits(27) = 268435455 m_lOnBits(28) = 536870911 m_lOnBits(29) = 1073741823 m_lOnBits(30) = 2147483647 m_l2Power(0) = 1 m_l2Power(1) = 2 m_l2Power(2) = 4 m_l2Power(3) = 8 m_l2Power(4) = 16 m_l2Power(5) = 32 m_l2Power(6) = 64 m_l2Power(7) = 128 m_l2Power(8) = 256 m_l2Power(9) = 512 m_l2Power(10) = 1024 m_l2Power(11) = 2048 m_l2Power(12) = 4096 m_l2Power(13) = 8192 m_l2Power(14) = 16384 m_l2Power(15) = 32768 m_l2Power(16) = 65536 m_l2Power(17) = 131072 m_l2Power(18) = 262144 m_l2Power(19) = 524288 m_l2Power(20) = 1048576 m_l2Power(21) = 2097152 m_l2Power(22) = 4194304 m_l2Power(23) = 8388608 m_l2Power(24) = 16777216 m_l2Power(25) = 33554432 m_l2Power(26) = 67108864 m_l2Power(27) = 134217728 m_l2Power(28) = 268435456 m_l2Power(29) = 536870912 m_l2Power(30) = 1073741824 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 LShiftByte(bytValue, bytShiftBits)     If bytShiftBits = 0 Then         LShiftByte = bytValue         Exit Function     ElseIf bytShiftBits = 7 Then         If bytValue And 1 Then             LShiftByte = &H80         Else             LShiftByte = 0         End If         Exit Function     ElseIf bytShiftBits < 0 or bytShiftBits > 7 Then         Err.Raise 6     End If     LShiftByte = ((bytValue And m_bytOnBits(7 - bytShiftBits)) * m_byt2Power(bytShiftBits)) End Function Private Function RShiftByte(bytValue, bytShiftBits)     If bytShiftBits = 0 Then         RShiftByte = bytValue         Exit Function     ElseIf bytShiftBits = 7 Then         If bytValue And &H80 Then             RShiftByte = 1         Else             RShiftByte = 0         End If         Exit Function     ElseIf bytShiftBits < 0 or bytShiftBits > 7 Then         Err.Raise 6     End If     RShiftByte = bytValue m_byt2Power(bytShiftBits) End Function Private Function RotateLeft(lValue, iShiftBits)     RotateLeft = LShift(lValue, iShiftBits) or RShift(lValue, (32 - iShiftBits)) End Function Private Function RotateLeftByte(bytValue, bytShiftBits)     RotateLeftByte = LShiftByte(bytValue, bytShiftBits) or RShiftByte(bytValue, (8 - bytShiftBits)) End Function Private Function Pack(b())     Dim lCount     Dim lTemp     For lCount = 0 To 3         lTemp = b(lCount)         Pack = Pack or LShift(lTemp, (lCount * 8))     Next End Function Private Function PackFrom(b(), k)     Dim lCount     Dim lTemp     For lCount = 0 To 3         lTemp = b(lCount + k)         PackFrom = PackFrom or LShift(lTemp, (lCount * 8))     Next End Function Private Sub Unpack(a, b())     b(0) = a And m_lOnBits(7)     b(1) = RShift(a, 8) And m_lOnBits(7)     b(2) = RShift(a, 16) And m_lOnBits(7)     b(3) = RShift(a, 24) And m_lOnBits(7) End Sub Private Sub