ASP常用函数收藏乱七八糟未整理版
2018-09-06 10:33
<%
*******************************************************************
取得IP地址
*******************************************************************
FunctionUserip()
DimGetClientIP
如果客户端用了代理服务器，则应该用ServerVariables(HTTP_X_FORWARDED_FOR)方法
GetClientIP=Request.ServerVariables(HTTP_X_FORWARDED_FOR)
IfGetClientIP=orIsNull(GetClientIP)orIsEmpty(GetClientIP)Then
如果客户端没用代理，应该用Request.ServerVariables(REMOTE_ADDR)方法
GetClientIP=Request.ServerVariables(REMOTE_ADDR)
EndIf
Userip=GetClientIP
EndFunction
*******************************************************************
转换IP地址
*******************************************************************
Functioncip(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)
EndFunction
*******************************************************************
弹出对话框
*******************************************************************
Subalert(message)
message=Replace(message,,\)
Response.Write(<script>alert(&message&)</script>)
EndSub
*******************************************************************
返回上一页，一般用在判断信息提交是否完全之后
*******************************************************************
SubGoBack()
Response.Write(<script>history.go(-1)</script>)
EndSub
*******************************************************************
重定向另外的连接
*******************************************************************
SubGo(url)
Response.Write(<script>location.href(&url&)</script>)
EndSub
*******************************************************************
我比较喜欢将以上三个结合起来使用
*******************************************************************
FunctionAlert(message,gourl)
message=Replace(message,,\)
Ifgourl=-1Then
Response.Write(<scriptlanguage=javascript>alert(&message&);history.go(-1)</script>)
Else
Response.Write(<scriptlanguage=javascript>alert(&message&);location=&gourl&</script>)
EndIf
Response.End()
EndFunction
*******************************************************************
指定秒数重定向另外的连接
*******************************************************************
SubGoPage(url,s)
s=s*1000
Response.Write<SCRIPTLANGUAGE=JavaScript>
Response.Writewindow.setTimeout(&Chr(34)&window.navigate(&url&)&Chr(34)&,&s&)
Response.Write</script>
EndSub
*******************************************************************
判断数字是否整形
*******************************************************************
FunctionisInteger(para)
OnErrorResumeNext
DimStr
Diml,i
IfIsNull(para)Then
isInteger=False
ExitFunction
EndIf
Str=CStr(para)
IfTrim(Str)=Then
isInteger=False
ExitFunction
EndIf
l=Len(Str)
Fori=1Tol
IfMid(Str,i,1)>9orMid(Str,i,1)<0Then
isInteger=False
ExitFunction
EndIf
Next
isInteger=True
IfErr.Number<>0ThenErr.Clear
EndFunction
*******************************************************************
获得文件扩展名
*******************************************************************
FunctionGetExtend(filename)
Dimtmp
Iffilename<>Then
tmp=Mid(filename,instrrev(filename,.)+1,Len(filename)-instrrev(filename,.))
tmp=LCase(tmp)
IfInStr(1,tmp,asp)>0orInStr(1,tmp,php)>0orInStr(1,tmp,php3)>0orInStr(1,tmp,aspx)>0Then
getextend=txt
Else
getextend=tmp
EndIf
Else
getextend=
EndIf
EndFunction
*----------------------------------------------------------------------------
*函数：CheckIn
*描述：检测参数是否有SQL危险字符
*参数：str要检测的数据
*返回：FALSE：安全TRUE：不安全
*作者：
*日期：
*----------------------------------------------------------------------------
FunctionCheckIn(Str)
IfInStr(1,Str,Chr(39))>0orInStr(1,Str,Chr(34))>0orInStr(1,Str,Chr(59))>0Then
CheckIn=True
Else
CheckIn=False
EndIf
EndFunction
*----------------------------------------------------------------------------
*函数：HTMLEncode
*描述：过滤HTML代码
*参数：--
*返回：--
*作者：
*日期：
*----------------------------------------------------------------------------
FunctionHTMLEncode(fString)
IfNotIsNull(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
EndIf
EndFunction
*----------------------------------------------------------------------------
*函数：HTMLcode
*描述：过滤表单字符
*参数：--
*返回：--
*作者：
*日期：
*----------------------------------------------------------------------------
FunctionHTMLcode(fString)
IfNotIsNull(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
EndIf
EndFunction
%>
<%
1.检查是否有效邮件地址
FunctionCheckEmail(strEmail)
Dimre
Setre=NewRegExp
re.Pattern=^[w-.]{1,}@([da-zA-Z-]{1,}.){1,}[da-zA-Z-]{2,3}$
re.IgnoreCase=True
CheckEmail=re.Test(strEmail)
EndFunction
2.测试变量是否为空值，空值的含义包括：变量不存在/为空，对象为Nothing，0，空数组，字符串为空
FunctionIsBlank(ByRefVar)
IsBlank=False
SelectCaseTrue
CaseIsObject(Var)
IfVarIsNothingThenIsBlank=True
CaseIsEmpty(Var),IsNull(Var)
IsBlank=True
CaseIsArray(Var)
IfUBound(Var)=0ThenIsBlank=True
CaseIsNumeric(Var)
If(Var=0)ThenIsBlank=True
CaseElse
IfTrim(Var)=ThenIsBlank=True
EndSelect
EndFunction
3.得到浏览器目前的URL
FunctionGetCurURL()
IfRequest.ServerVariables(HTTPS)=onThen
GetCurrentURL=
Else
GetCurrentURL=
EndIf
GetCurURL=GetCurURL&Request.ServerVariables(SERVER_NAME)
If(Request.ServerVariables(SERVER_PORT)<>80)ThenGetCurURL=GetCurURL&:&Request.ServerVariables(SERVER_PORT)
GetCurURL=GetCurURL&Request.ServerVariables(URL)
If(Request.QueryString<>)ThenGetCurURL=GetCurURL&?&Request.QueryString
EndFunction
4.MD5加密函数
PrivateConstBITS_TO_A_BYTE=8
PrivateConstBYTES_TO_A_WORD=4
PrivateConstBITS_TO_A_WORD=32
Privatem_lOnBits(30)
Privatem_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)
PrivateFunctionLShift(lValue,iShiftBits)
IfiShiftBits=0Then
LShift=lValue
ExitFunction
ElseIfiShiftBits=31Then
IflValueAnd1Then
LShift=&H80000000
Else
LShift=0
EndIf
ExitFunction
ElseIfiShiftBits<0oriShiftBits>31Then
Err.Raise6
EndIf
If(lValueAndm_l2Power(31-iShiftBits))Then
LShift=((lValueAndm_lOnBits(31-(iShiftBits+1)))*m_l2Power(iShiftBits))or&H80000000
Else
LShift=((lValueAndm_lOnBits(31-iShiftBits))*m_l2Power(iShiftBits))
EndIf
EndFunction
PrivateFunctionRShift(lValue,iShiftBits)
IfiShiftBits=0Then
RShift=lValue
ExitFunction
ElseIfiShiftBits=31Then
IflValueAnd&H80000000Then
RShift=1
Else
RShift=0
EndIf
ExitFunction
ElseIfiShiftBits<0oriShiftBits>31Then
Err.Raise6
EndIf
RShift=(lValueAnd&H7FFFFFFE)m_l2Power(iShiftBits)
If(lValueAnd&H80000000)Then
RShift=(RShiftor(&H40000000m_l2Power(iShiftBits-1)))
EndIf
EndFunction
PrivateFunctionRotateLeft(lValue,iShiftBits)
RotateLeft=LShift(lValue,iShiftBits)orRShift(lValue,(32-iShiftBits))
EndFunction
PrivateFunctionAddUnsigned(lX,lY)
DimlX4
DimlY4
DimlX8
DimlY8
DimlResult
lX8=lXAnd&H80000000
lY8=lYAnd&H80000000
lX4=lXAnd&H40000000
lY4=lYAnd&H40000000
lResult=(lXAnd&H3FFFFFFF)+(lYAnd&H3FFFFFFF)
IflX4AndlY4Then
lResult=lResultXor&H80000000XorlX8XorlY8
ElseIflX4orlY4Then
IflResultAnd&H40000000Then
lResult=lResultXor&HC0000000XorlX8XorlY8
Else
lResult=lResultXor&H40000000XorlX8XorlY8
EndIf
Else
lResult=lResultXorlX8XorlY8
EndIf
AddUnsigned=lResult
EndFunction
PrivateFunctionF(x,y,z)
F=(xAndy)or((Notx)Andz)
EndFunction
PrivateFunctionG(x,y,z)
G=(xAndz)or(yAnd(Notz))
EndFunction
PrivateFunctionH(x,y,z)
H=(xXoryXorz)
EndFunction
PrivateFunctionI(x,y,z)
I=(yXor(xor(Notz)))
EndFunction
PrivateSubFF(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)
EndSub
PrivateSubGG(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)
EndSub
PrivateSubHH(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)
EndSub
PrivateSubII(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)
EndSub
PrivateFunctionConvertToWordArray(sMessage)
DimlMessageLength
DimlNumberOfWords
DimlWordArray()
DimlBytePosition
DimlByteCount
DimlWordCount
ConstMODULUS_BITS=512
ConstCONGRUENT_BITS=448
lMessageLength=Len(sMessage)
lNumberOfWords=(((lMessageLength+((MODULUS_BITS-CONGRUENT_BITS)BITS_TO_A_BYTE))(MODULUS_BITSBITS_TO_A_BYTE))+1)*(MODULUS_BITSBITS_TO_A_WORD)
ReDimlWordArray(lNumberOfWords-1)
lBytePosition=0
lByteCount=0
DoUntillByteCount>=lMessageLength
lWordCount=lByteCountBYTES_TO_A_WORD
lBytePosition=(lByteCountModBYTES_TO_A_WORD)*BITS_TO_A_BYTE
lWordArray(lWordCount)=lWordArray(lWordCount)orLShift(Asc(Mid(sMessage,lByteCount+1,1)),lBytePosition)
lByteCount=lByteCount+1
Loop
lWordCount=lByteCountBYTES_TO_A_WORD
lBytePosition=(lByteCountModBYTES_TO_A_WORD)*BITS_TO_A_BYTE
lWordArray(lWordCount)=lWordArray(lWordCount)orLShift(&H80,lBytePosition)
lWordArray(lNumberOfWords-2)=LShift(lMessageLength,3)
lWordArray(lNumberOfWords-1)=RShift(lMessageLength,29)
ConvertToWordArray=lWordArray
EndFunction
PrivateFunctionWordToHex(lValue)
DimlByte
DimlCount
ForlCount=0To3
lByte=RShift(lValue,lCount*BITS_TO_A_BYTE)Andm_lOnBits(BITS_TO_A_BYTE-1)
WordToHex=WordToHex&Right(0&Hex(lByte),2)
Next
EndFunction
PublicFunctionMD5(sMessage)
Dimx
Dimk
DimAA
DimBB
DimCC
DimDD
Dima
Dimb
Dimc
Dimd
ConstS11=7
ConstS12=12
ConstS13=17
ConstS14=22
ConstS21=5
ConstS22=9
ConstS23=14
ConstS24=20
ConstS31=4
ConstS32=11
ConstS33=16
ConstS34=23
ConstS41=6
ConstS42=10
ConstS43=15
ConstS44=21
x=ConvertToWordArray(sMessage)
a=&H67452301
b=&HEFCDAB89
c=&H98BADCFE
d=&H10325476
Fork=0ToUBound(x)Step16
AA=a
BB=b
CC=c
DD=d
FFa,b,c,d,x(k+0),S11,&HD76AA478
FFd,a,b,c,x(k+1),S12,&HE8C7B756
FFc,d,a,b,x(k+2),S13,&H242070DB
FFb,c,d,a,x(k+3),S14,&HC1BDCEEE
FFa,b,c,d,x(k+4),S11,&HF57C0FAF
FFd,a,b,c,x(k+5),S12,&H4787C62A
FFc,d,a,b,x(k+6),S13,&HA8304613
FFb,c,d,a,x(k+7),S14,&HFD469501
FFa,b,c,d,x(k+8),S11,&H698098D8
FFd,a,b,c,x(k+9),S12,&H8B44F7AF
FFc,d,a,b,x(k+10),S13,&HFFFF5BB1
FFb,c,d,a,x(k+11),S14,&H895CD7BE
FFa,b,c,d,x(k+12),S11,&H6B901122
FFd,a,b,c,x(k+13),S12,&HFD987193
FFc,d,a,b,x(k+14),S13,&HA679438E
FFb,c,d,a,x(k+15),S14,&H49B40821
GGa,b,c,d,x(k+1),S21,&HF61E2562
GGd,a,b,c,x(k+6),S22,&HC040B340
GGc,d,a,b,x(k+11),S23,&H265E5A51
GGb,c,d,a,x(k+0),S24,&HE9B6C7AA
GGa,b,c,d,x(k+5),S21,&HD62F105D
GGd,a,b,c,x(k+10),S22,&H2441453
GGc,d,a,b,x(k+15),S23,&HD8A1E681
GGb,c,d,a,x(k+4),S24,&HE7D3FBC8
GGa,b,c,d,x(k+9),S21,&H21E1CDE6
GGd,a,b,c,x(k+14),S22,&HC33707D6
GGc,d,a,b,x(k+3),S23,&HF4D50D87
GGb,c,d,a,x(k+8),S24,&H455A14ED
GGa,b,c,d,x(k+13),S21,&HA9E3E905
GGd,a,b,c,x(k+2),S22,&HFCEFA3F8
GGc,d,a,b,x(k+7),S23,&H676F02D9
GGb,c,d,a,x(k+12),S24,&H8D2A4C8A
HHa,b,c,d,x(k+5),S31,&HFFFA3942
HHd,a,b,c,x(k+8),S32,&H8771F681
HHc,d,a,b,x(k+11),S33,&H6D9D6122
HHb,c,d,a,x(k+14),S34,&HFDE5380C
HHa,b,c,d,x(k+1),S31,&HA4BEEA44
HHd,a,b,c,x(k+4),S32,&H4BDECFA9
HHc,d,a,b,x(k+7),S33,&HF6BB4B60
HHb,c,d,a,x(k+10),S34,&HBEBFBC70
HHa,b,c,d,x(k+13),S31,&H289B7EC6
HHd,a,b,c,x(k+0),S32,&HEAA127FA
HHc,d,a,b,x(k+3),S33,&HD4EF3085
HHb,c,d,a,x(k+6),S34,&H4881D05
HHa,b,c,d,x(k+9),S31,&HD9D4D039
HHd,a,b,c,x(k+12),S32,&HE6DB99E5
HHc,d,a,b,x(k+15),S33,&H1FA27CF8
HHb,c,d,a,x(k+2),S34,&HC4AC5665
IIa,b,c,d,x(k+0),S41,&HF4292244
IId,a,b,c,x(k+7),S42,&H432AFF97
IIc,d,a,b,x(k+14),S43,&HAB9423A7
IIb,c,d,a,x(k+5),S44,&HFC93A039
IIa,b,c,d,x(k+12),S41,&H655B59C3
IId,a,b,c,x(k+3),S42,&H8F0CCC92
IIc,d,a,b,x(k+10),S43,&HFFEFF47D
IIb,c,d,a,x(k+1),S44,&H85845DD1
IIa,b,c,d,x(k+8),S41,&H6FA87E4F
IId,a,b,c,x(k+15),S42,&HFE2CE6E0
IIc,d,a,b,x(k+6),S43,&HA3014314
IIb,c,d,a,x(k+13),S44,&H4E0811A1
IIa,b,c,d,x(k+4),S41,&HF7537E82
IId,a,b,c,x(k+11),S42,&HBD3AF235
IIc,d,a,b,x(k+2),S43,&H2AD7D2BB
IIb,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))
EndFunction
5.SHA256加密，256位的加密哦！安全性更高！
Privatem_lOnBits(30)
Privatem_l2Power(30)
PrivateK(63)
PrivateConstBITS_TO_A_BYTE=8
PrivateConstBYTES_TO_A_WORD=4
PrivateConstBITS_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
PrivateFunctionLShift(lValue,iShiftBits)
IfiShiftBits=0Then
LShift=lValue
ExitFunction
ElseIfiShiftBits=31Then
IflValueAnd1Then
LShift=&H80000000
Else
LShift=0
EndIf
ExitFunction
ElseIfiShiftBits<0oriShiftBits>31Then
Err.Raise6
EndIf
If(lValueAndm_l2Power(31-iShiftBits))Then
LShift=((lValueAndm_lOnBits(31-(iShiftBits+1)))*m_l2Power(iShiftBits))or&H80000000
Else
LShift=((lValueAndm_lOnBits(31-iShiftBits))*m_l2Power(iShiftBits))
EndIf
EndFunction
PrivateFunctionRShift(lValue,iShiftBits)
IfiShiftBits=0Then
RShift=lValue
ExitFunction
ElseIfiShiftBits=31Then
IflValueAnd&H80000000Then
RShift=1
Else
RShift=0
EndIf
ExitFunction
ElseIfiShiftBits<0oriShiftBits>31Then
Err.Raise6
EndIf
RShift=(lValueAnd&H7FFFFFFE)m_l2Power(iShiftBits)
If(lValueAnd&H80000000)Then
RShift=(RShiftor(&H40000000m_l2Power(iShiftBits-1)))
EndIf
EndFunction
PrivateFunctionAddUnsigned(lX,lY)
DimlX4
DimlY4
DimlX8
DimlY8
DimlResult
lX8=lXAnd&H80000000
lY8=lYAnd&H80000000
lX4=lXAnd&H40000000
lY4=lYAnd&H40000000
lResult=(lXAnd&H3FFFFFFF)+(lYAnd&H3FFFFFFF)
IflX4AndlY4Then
lResult=lResultXor&H80000000XorlX8XorlY8
ElseIflX4orlY4Then
IflResultAnd&H40000000Then
lResult=lResultXor&HC0000000XorlX8XorlY8
Else
lResult=lResultXor&H40000000XorlX8XorlY8
EndIf
Else
lResult=lResultXorlX8XorlY8
EndIf
AddUnsigned=lResult
EndFunction
PrivateFunctionCh(x,y,z)
Ch=((xAndy)Xor((Notx)Andz))
EndFunction
PrivateFunctionMaj(x,y,z)
Maj=((xAndy)Xor(xAndz)Xor(yAndz))
EndFunction
PrivateFunctionS(x,n)
S=(RShift(x,(nAndm_lOnBits(4)))orLShift(x,(32-(nAndm_lOnBits(4)))))
EndFunction
PrivateFunctionR(x,n)
R=RShift(x,CInt(nAndm_lOnBits(4)))
EndFunction
PrivateFunctionSigma0(x)
Sigma0=(S(x,2)XorS(x,13)XorS(x,22))
EndFunction
PrivateFunctionSigma1(x)
Sigma1=(S(x,6)XorS(x,11)XorS(x,25))
EndFunction
PrivateFunctionGamma0(x)
Gamma0=(S(x,7)XorS(x,18)XorR(x,3))
EndFunction
PrivateFunctionGamma1(x)
Gamma1=(S(x,17)XorS(x,19)XorR(x,10))
EndFunction
PrivateFunctionConvertToWordArray(sMessage)
DimlMessageLength
DimlNumberOfWords
DimlWordArray()
DimlBytePosition
DimlByteCount
DimlWordCount
DimlByte
ConstMODULUS_BITS=512
ConstCONGRUENT_BITS=448
lMessageLength=Len(sMessage)
lNumberOfWords=(((lMessageLength+((MODULUS_BITS-CONGRUENT_BITS)BITS_TO_A_BYTE))(MODULUS_BITSBITS_TO_A_BYTE))+1)*(MODULUS_BITSBITS_TO_A_WORD)
ReDimlWordArray(lNumberOfWords-1)
lBytePosition=0
lByteCount=0
DoUntillByteCount>=lMessageLength
lWordCount=lByteCountBYTES_TO_A_WORD
lBytePosition=(3-(lByteCountModBYTES_TO_A_WORD))*BITS_TO_A_BYTE
lByte=AscB(Mid(sMessage,lByteCount+1,1))
lWordArray(lWordCount)=lWordArray(lWordCount)orLShift(lByte,lBytePosition)
lByteCount=lByteCount+1
Loop
lWordCount=lByteCountBYTES_TO_A_WORD
lBytePosition=(3-(lByteCountModBYTES_TO_A_WORD))*BITS_TO_A_BYTE
lWordArray(lWordCount)=lWordArray(lWordCount)orLShift(&H80,lBytePosition)
lWordArray(lNumberOfWords-1)=LShift(lMessageLength,3)
lWordArray(lNumberOfWords-2)=RShift(lMessageLength,29)
ConvertToWordArray=lWordArray
EndFunction
PublicFunctionSHA256(sMessage)
DimHASH(7)
DimM
DimW(63)
Dima
Dimb
Dimc
Dimd
Dime
Dimf
Dimg
Dimh
Dimi
Dimj
DimT1
DimT2
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)
Fori=0ToUBound(M)Step16
a=HASH(0)
b=HASH(1)
c=HASH(2)
d=HASH(3)
e=HASH(4)
f=HASH(5)
g=HASH(6)
h=HASH(7)
Forj=0To63
Ifj<16Then
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))
EndIf
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))
EndFunction
6.一个If语句的加。