<%
"*******************************************************************
"取得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_l2Powe
易网时代-编程资源站