ASP常用函数集

功能:创建一个数组变量
格式:array(list)
参数:list为数组变量中的每个数值列,中间用逗号间隔
例子:
<%i=array(“1”,”2”,”3”)%>
结果:i被赋予为数组
2.函数Cint()
功能:将一表达式/其它类型的变量转换成整数类型(int)
格式:Cint(expression)
参数:expression是任何有效的表达式/其它类型的变量
例子:
<%
f=”234”
response.write cINT(f)+2
%>
结果:236
函数Cint()将字符”234”转换成整数234.如果表达式为空,或者无效时,返回值为0;
3.函数:Creatobject()
功能:创建及返回一个ActiveX对象.
格式:Creatobject(obname)
参数bname是对象的名称
例子:
<%
Set con=Server.CreateObject(“ADODB.Connection”)
%>
结果:
功能:将一表达式/其它类型的变量转换成字符类型(string)
格式:Cstr(expression)
参数:expression是任何有效的表达式/其它类型的变量
例子:
<%
s=3+2
response.write”The result is:”&cStr(s)
%>
结果:函数Cstr()将整数5转换成字符”5”.
5.函数Date()
功能:返回当前系统(server端)的日期
格式:Date()
参数:无
例子<%date()%>
结果:05/10/00
6.函数Dateadd()
功能:计算某个指定的时间和
格式:dateadd(timeinterval,number,date)
参数:timeinterval是时间单位(月,日..);number是时间间隔值,date是时间始点.例子:
<%
currentDate=#8/4/99#
newDate=DateAdd(“m”,3,currentDate)
response.write newDate
%><%
currentDate=#12:34:45PM#
newDate=DateAdd(“h”,3,currentDate)
response.write newDate
%>
结果:
11/4/99
3:34:45PM
其中
“m”=”month”;
“d”=”day”;
如果是currentDate格式,则,
“h”=”hour”;
“s”=”second”;
7.函数Datediff()
功能:计算某量个指定的时间差
格式:datediff(timeinterval,date1,date2[,firstdayofweek[,firstdayofyear]])参数:timeinterval是时间单位;date1,date2是有效的日期表达
式,firstdayofweek,firstdayofyear是任意选项.
例子:
<%
fromDate=#8/4/99#
toDate=#1/1/2000#
response.write”There are”&_
DateDiff(“d”,fromDate,toDate)&_
“days to millenium from8/4/99.”
%>
结果:There are150days to millenium from8/4/99.
8.函数day()
功能:返回一个整数值,对应于某月的某日
格式:day(date)
参数:date是一个有效的日期表达式;
例子<%=date(#8/4/99#)%>
结果:4
9.函数formatcurrency()
功能:转换成货币格式
格式:formatcurrency(expression[,digit[,leadingdigit[,paren[,groupdigit]]]])
参数:expression是有效的数字表达式;digit表示小数点后的位
数;leadingdigit,paren,groupdigit是任意选项.
例子<%=FormatCurrency(34.3456)%>
结果34.35
10.函数Formatdatetime()
功能:格式化日期表达式/变量
格式:formatdatetime(date[,nameformat])
参数:date为有效的日期表达式/变量;nameformat是指定的日期格式常量名称.例子<%=formatdatetime(“08/04/99”,vblongdate)%>
结果:Wednesday,August04,1999
说明:
描述
返回表达式，此表达式已被格式化为日期或时间。

语法
FormatDateTime(Date[,NamedFormat])
FormatDateTime函数的语法有以下参数：
参数描述
Date必选项。

要被格式化的日期表达式。

NamedFormat可选项。

指示所使用的日期/时间格式的数值，如果省略，则使用vbGeneralDate。

设置
NamedFormat参数可以有以下值：
常数值描述
vbGeneralDate0显示日期和/或时间。

如果有日期部分，则将该部分显示为短日期格式。

如果有时间部分，则将该部分显示为长时间格式。

如果都存在，则显示所有部分。

vbLongDate1使用计算机区域设置中指定的长日期格式显示日期。

vbShortDate2使用计算机区域设置中指定的短日期格式显示日期。

vbLongTime3使用计算机区域设置中指定的时间格式显示时间。

vbShortTime4使用24小时格式(hh:mm)显示时间。

说明
下面例子利用FormatDateTime函数把表达式格式化为长日期型并且把它赋给MyDateTime:
Function GetCurrentDate
“FormatDateTime把日期型格式化为长日期型。

GetCurrentDate=FormatDateTime(Date,1)
End Function
11.函数Isnumeric()
功能:返回一个布尔值,判断变量是否为数字变量,或者是可以转换成数字的其它变量.
格式:isnumeric(expression)
参数:expression是任意的变量.
例子:
<%
i=“234”
response.write isnumeric(i)
%>
结果:true.
12.函数Isobject()
功能:返回一个布尔值,判断变量是否为对象的变量,格式:isobject(expression)
参数:expression是任意的变量.
例子:
<%
set con=server.creatobject(“adodb.connection”) response.write isobject(con)
%>
结果:true
13.函数:Lbound()
功能:返回一个数组的下界.
格式:Lbound(arrayname[,dimension])
参数:arrayname是数组变量,dimension是任意项例子:
<%
i=array(“1”,”2”,”3”)
response.write lbound(i)
%>
结果:0
14.函数Lcase()
功能:将一字符类型变量的字符全部变换小写字符.
格式:Lcase(string)
参数:string是字符串变量
例子:
<%
str=“THIS is Lcase!”
response.write Lcase(str)
%>
结果:this is lcase!
15.函数left()
功能:截取一个字符串的前部分;
格式:left(string,length)
参数:string字符串,length截取的长度.
例子:<%=left(“this is a test!”,6)%>结果:this i
16.函数len()
功能:返回字符串长度或者变量的字节长度
格式:len(string*varname)
参数:string字符串;varname任意的变量名称例子:
<%
strt est=“this is a test!”
response.write left(strtest)
%>
结果:15
17.函数ltrim()
功能:去掉字符串前的空格.
格式:ltrim(string)
参数:string字符串.
例子:<%=ltrim(“this is a test!”)结果:this is a test!
18.函数Mid()
功能:从字符串中截取字符串.
格式:mid(string,start[,length])
参数:string字符串,start截取的起点,length要截取的长度. 例子:
<%
strtest=“this is a test,Today is Monday!”response.write mid(strtest,17,5)
%>
结果:Today
19.函数minute()
功能:返回一数值,表示分钟
格式:minute(time)
参数:time是时间变量
例子lt;%=minute(#12:23:34#)%>
结果:23
20.函数month()
功能:返回一数值,表示月份
格式:month(time)
参数:time是日期变量
例子<%=month(#08/09/99)%>
结果:9
[color=#1E90FF]21.函数monthname()[/color]
功能:返回月份的字符串(名称).
格式:Monthname(date[,abb])
参数:date是日期变量,abb=true时则月份的缩写,
例子:
<%=monthname(#4/5/99#)%>
结果:April
22.函数Now()
功能:返回系统的当前时间和日期.
格式:now()
参数:无
例子:
<%=now()%>
结果:05/10/008:45:32pm
23.函数:replace()
功能:在字符串中查找,替代指定的字符串.
格式:replace(strtobesearched,strsearchfor,strreplacewith[,start[,count[,compare]]])
参数:strtobesearched是字符串;strsearchfor是被查找的子字符串;strreplacewith是用来替代的子字符串.start,count,compare是任意选项.
例子:
<%
strtest=“this is an apple.”
response.write replace(strtest,”apple”,”orange”)
%>
结果:this is an orange.
24.函数right()
功能:截取一个字符串的后部分
格式:right(string,length)
参数:string字符串,length截取的长度.
例子:
<%
strtest=“this is a test!”
response.write right(strtest,3)
%>
结果:st!
25.函数rnd()
功能:返回一个随机数值
格式:rnd[(number)]
参数:number是任意数值.
例子:
<%
randomize()
response.write rnd()
%>
结果:0/1数值之一,无randomize(),则不能产生随机数.
26.函数round()
功能:完整数值
格式:round(expression[,numright])
参数:expression数字表达式;numright任意选项.
例子:
<%
i=12.33654
response.write round(i)
%>
结果:12
27.函数rtrim()
功能:去掉字符串后的空格.
格式:rtrim(string)
参数:string是字符串
例子:
<%
response.write rtrim(“this is a test!”)
结果:this is a test!
28.函数second()
功能:返回一个整数值.
格式:second(time)
参数:time是一个有效的时间表达式;
例子lt;%=second(#12:28:30#)%>结果:30
29.函数strReverse()
功能:返回与原字符串排列逆向的字符串.格式:strreverse(string)
参数:string是字符串
例子<%=strreverse(“this is a test!”)结果:!tset a si siht
30.函数time()
功能:返回当前系统的时间值.
格式:time()
参数:无
结果:9:58:28Am
31.函数trim()
功能:删去字符串前,后的空格.
格式:trim(string)
参数:string字符串.
例子:
<%
strtest=“this is a test!”response.write trim(strtest)
结果:this is a test!
32.函数UBound()
功能:返回一个数组的上界.
格式:Ubound(expression[,dimension])
参数:expression是数组表达式/数组变量,dimension是任意项例子:
<%
i=array(“1”,”2”,”3”)
response.write ubound(i)
%>
结果:2
33.函数:UCase()
功能:将一字符类型变量的字符全部变换成大写字符.
格式:Ucase(string)
参数:string是字符串变量
例子:
<%
str=“THIS is Lcase!”
response.write Lcase(str)
%>
结果:THIS IS LCASE!
34.函数Vartype()
功能:返回变量的常量代码(整数)
格式:Vartype(varname)
参数:varname是任何类型的变量名称.
例子:
<%
response.write vartype(i)
%>
结果:2(2表示整数,须要参考ASP常量代码.)
35.函数Weekday()
功能:返回一个整数,对应一周中的第几天.
格式:Weekday(date[,firstofweek])
参数:date为日期变量,firstofweek为任选项.
例子:
<%
d=#5/9/00#
response.write weekday(d)%>
结果:3(3表示是星期二)
36.函数weekdayname()
功能:返回字符串,对应星期几.
格式:weekdayname(weekday[,abb[,firstdayofweek]])
参数:weekday为日期变量,abb,firstdayofweek为任选项.例子:
<%
d=#8/4/99#
response.write weekdayname(d)
%>
结果:Wednesday
37.函数year()
功能:返回日期表达式所在的年份.
格式:year(date)
参数:date是有效的日期表达式
例子:
<%=year(#8/9/99#)%>
结果:1999
38.函数Mod()功能:取余数.
例子:3Mod2
结果:1
ASP常用函数集
检查是否有效邮件地址
程序代码：
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
测试变量是否为空值，空值的含义包括：变量不存在/为空，对象为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
得到浏览器目前的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
MD5加密函数呵呵，以后不用这个了，用下面的SHA256吧！
程序代码：
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
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
类似Gmail的中文日期格式
程序代码：
Function DateToStr(DateTime)
Dim DateD,DateM,DateY
DateD=Int(Day(Now()))-Int(Day(DateTime))
DateM=Month(Now())-Month(DateTime)
DateY=Year(Now())-Year(DateTime)
If DateD=0 And DateM=0 And DateY=0 Then
DateTime=Hour(DateTime)&":"&Minute(DateTime)
ElseIf DateY=0 Then
DateTime=Month(DateTime)&"月"&Day(DateTime)&"日"
Else
DateTime=Year(DateTime)&"-"&Month(DateTime)&"-"&Day(DateTime)
End If
DateToStr=DateTime
End Function。