常用ASP函数封装类：字符/检验/系统信息/检测组件等

原文地址：
PS:生肖和星座有意思。
原文地址：http://log.zhoz.com/read.php?283
'所有功能函数名如下：  
' StrLength(str) 取得字符串长度  
' CutStr(str,strlen) 字符串长度切割  
' CheckIsEmpty(tstr) 检测是否为空  
' isInteger(para) 整数检验  
' CheckName(str) 名字字符校验  
' CheckPassword(str) 密码检验  
' CheckEmail(email) 邮箱格式检验  
' Alert(msg,goUrl) 弹出对话框提示  
' GoBack(Str1,Str2,isback) 出错信息提示  
' Suc(str1,str2,url) 操作成功信息提示  
' ChkPost() 检测是否站外提交表单  
' PSql() 防止sql注入  
' FiltrateHtmlCode(Str) 防止生成HTML  
' HtmlCode(str) 过滤HTML  
' Replacehtml(tstr) 清滤HTML  
' GetIP() 获取客户端IP  
' GetBrowser 获取客户端浏览器信  
' GetSystem 获取客户端操作系统  
' GetUrl() 获取当前页面URL包含参数  
' CUrl()   获取当前页面URL  
' GetExtend 取得文件扩展名  
' CheckExist(table,fieldname,fieldcontent,isblur) 检测某个表中某个字段的内容是否存在  
' GetNum(table,fieldname,resulttype,args) 检测某个表某个字段有多少条，最大值 ，最小值等  
' GetFolderSize(Folderpath) 计算某个文件夹的大小  
' GetFileSize(Filename) 计算某个文件的大小  
' IsObjInstalled(strClassString) 检测组件是否安装  
' SendMail JMAIL发送邮件
' ResponseCookies 写入cookies  
' CleanCookies 清除cookies  
' GetTimeover 取得程序页面执行时间  
' FormatSize 大小格式化  
' FormatTime 时间格式化  
' Zodiac 取得生肖  
' Constellation   取得星座

<%
Class Cls_fun  
'－－－－－－－－字符处理－－－－－－－－－－－－－－－－－－－－－－－－－－  
'****************************************************  
'函数名：StrLength  
'作  用：取得字符串长度（汉字为2)  
'参  数：str ----字符串内容  
'返回值：字符串长度  
'****************************************************  
Public function StrLength(str)  
Dim Rep,lens,i  
Set rep=new regexp  
rep.Global=true  
rep.IgnoreCase=true  
rep.Pattern="[\u4E00-\u9FA5\uF900-\uFA2D]"  
For each i in rep.Execute(str)  
lens=lens+1  
Next  
Set Rep=Nothing  
lens=lens + len(str)  
strLength=lens  
End Function  
'****************************************************  
'函数名：CutStr  
'作  用：字符串长度切割，超过显示省略号  
'参  数：str    ----字符串内容  
'       strlen ------要显示的长度  
'返回值：切割后字符串内容  
'****************************************************  
Public Function CutStr(str,strlen)  
Dim l,t,i,c  
If str="" Then  
cutstr=""  
Exit Function  
End If  
str=Replace(Replace(Replace(Replace(Replace(str," "," "),""",Chr(34)),">",">"),"<","<"),"|","|")  
l=Len(str)  
t=0  
For i=1 To l  
c=Abs(Asc(Mid(str,i,1)))  
If c>255 Then  
t=t+2  
Else  
t=t+1  
End If  
If t>=strlen Then  
cutstr=Left(str,i) & "..."  
Exit For  
Else  
cutstr=str  
End If  
Next  
cutstr=Replace(Replace(Replace(Replace(replace(cutstr," "," "),Chr(34),"""),">",">"),"<","<"),"|","|")  
End Function  
'－－－－－－－－－－－－－－系列验证－－－－－－－－－－－－－－－－－－－－－－－－－－－－  
'****************************************************  
'函数名：CheckIsEmpty  
'作  用：检查是否为空  
'参  数：tstr ----字符串  
'返回值：true不为空，false为空  
'****************************************************  
Public Function CheckIsEmpty(tstr)  
CheckIsEmpty=false  
If IsNull(tstr) or Tstr="" Then Exit Function  
Dim Str,re  
Str=Tstr  
Set re=new RegExp  
re.IgnoreCase =True  
re.Global=True  
str= Replace(str, vbNewLine, "")  
str = Replace(str, Chr(9), "")  
str = Replace(str, " ", "")  
str = Replace(str, " ", "")  
re.Pattern="<img(.[^>]*)>"  
str =re.Replace(Str,"94kk")  
re.Pattern="<(.[^>]*)>"  
Str=re.Replace(Str,"")  
Set Re=Nothing  
If Str<>"" Then CheckIsEmpty=true  
End Function  
'****************************************************  
'函数名：isInteger  
'作  用：整数检验  
'参  数：tstr ----字符  
'返回值：true是整数，false不是整数  
'****************************************************  
Public 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  
'****************************************************  
'函数名：CheckName  
'作  用：名字字符检验  
'参  数：str ----字符串  
'返回值：true无误，false有误  
'****************************************************  
Public Function CheckName(Str)  
Checkname=true  
Dim Rep,pass  
Set Rep=New RegExp  
Rep.Global=True  
Rep.IgnoreCase=True  
'匹配字母、数字、下划线、汉字且必须以字母或下划线或汉字开始  
Rep.Pattern="^[a-zA-Z_u4e00-\u9fa5][\w\u4e00-\u9fa5]+$"  
Set pass=Rep.Execute(Str)  
If pass.count=0 Then CheckName=false  
Set Rep=Nothing  
End Function  
'****************************************************  
'函数名：CheckPassword  
'作  用：密码检验  
'参  数：str ----字符串  
'返回值：true无误，false有误  
'****************************************************  
Public Function CheckPassword(Str)  
Dim pass  
CheckPassword=true  
If Str <> "" Then  
Dim Rep  
Set Rep = New RegExp  
Rep.Global = True  
Rep.IgnoreCase = True  
'匹配字母、数字、下划线、点号  
Rep.Pattern="[a-zA-Z0-9_\.]+$"  
Pass=rep.Test(Str)  
Set Rep=nothing  
If not Pass Then CheckPassword=false  
End If  
End Function  
'****************************************************  
'函数名：CheckEmail  
'作  用：邮箱格式检测  
'参  数：str ----Email地址  
'返回值：true无误，false有误  
'****************************************************  
Public function CheckEmail(email)  
CheckEmail=true  
Dim Rep  
Set Rep = new RegExp  
rep.pattern="([\.a-zA-Z0-9_-]){2,10}@([a-zA-Z0-9_-]){2,10}(\.([a-zA-Z0-9]){2,}){1,4}$"  
pass=rep.Test(email)  
Set Rep=Nothing  
If not pass Then CheckEmail=false  
End function  
'－－－－－－－－－－－－－－信息提示－－－－－－－－－－－－－－－－－－－－－－－－－－－－  
'****************************************************  
'函数名：Alert  
'作  用：弹出对话框提示  
'参  数：msg   ----对话框信息  
'       gourl ----提示后转向哪里  
'返回值：无  
'****************************************************  
Public Function Alert(msg,goUrl)  
msg = replace(msg,"'","\'")  
If goUrl="" Then  
goUrl="history.go(-1);"  
Else  
goUrl="window.location.href='"&goUrl"'"  
End IF  
Response.Write ("<script language=""JavaScript"" type=""text/javascript"">"&vbNewLine"alert('" & msg & "');"&goUrl&vbNewLine"</script>")  
Response.End  
End Function  
'****************************************************  
'函数名：GoBack  
'作  用：错误信息提示  
'参  数：str1   ----信息提示标题  
'       str2   ----信息提示内容  
'       isback ----是否显示返回  
'返回值：无  
'****************************************************  
Public Function GoBack(Str1,Str2,isback)  
If Str1="" Then Str1="错误信息"  
If Str2="" Then Str2="请填写完整必填项目"  
If isback="" Then  
Str2=Str2" <a href=""javascript:history.go(-1)"">返回重填</a></li>"  
else  
Str2=Str2  
end if  
Response.Write"<divmargin-left:5px;border:1px solid #0066cc;width:98%""><divheight:22px;font-weight:bold;color : white;font-size:14px;background:#799AE1;background:url(images/th.gif);;text-align:left;line-height:20px;padding:3px;"">"&Str1" </div><divline-height:50px;background:#F7F7F7;vertical-align:middle;font-size:14px;width:100%""><div  style=""color:red;font:50px/50px 宋体;float:left;width:5%"">×</div><div  style=""margin- top:8px;float:right;width:90%;text-align:left;padding-left:3px;"">"&str2"</div></div></div>"  
response.end  
End Function  
'****************************************************  
'函数名：Suc  
'作  用：成功提示信息  
'参  数：str1   ----信息提示标题  
'       str2   ----信息提示内容  
'       url    ----返回地址  
'返回值：无  
'****************************************************  
Public Function Suc(str1,str2,url)  
If str1="" Then Str1="操作成功"  
If str2="" Then Str2="成功的完成这次操作！"  
If url="" Then url="javascript:history.go(-1)"  
str2=str2"  <a href="""&url""" >返回继续管理</a>"  
Response.Write"<divmargin-left:5px;border:1px solid #0066cc;width:98%""><divheight:22px;font-weight:bold;color : white;font-size:14px;background:#799AE1;background:url(images/th.gif);;text-align:left;line-height:20px;padding:3px;"">"&Str1" </div><divline-height:50px;background:#F7F7F7;vertical-align:middle;font-size:14px;width:100%""><div  style=""color:red;font:50px/50px 宋体;float:left;width:5%"">√</div><div  style=""margin- top:8px;float:right;width:90%;text-align:left;padding-left:3px;"">"&str2"</div></div></div>"  
End Function  
'－－－－－－－－－－－－－－安全处理－－－－－－－－－－－－－－－－－－－－－－－－－－－－  
'****************************************************  
'函数名：ChkPost  
'作  用：禁止站外提交表单  
'返回值：true站内提交，flase站外提交  
'****************************************************  
Public Function ChkPost()  
Dim url1,url2  
chkpost=true  
url1=Cstr(Request.ServerVariables("HTTP_REFERER"))  
url2=Cstr(Request.ServerVariables("SERVER_NAME"))  
If Mid(url1,8,Len(url2))<>url2 Then  
chkpost=false  
exit function  
End If  
End function  
'****************************************************  
'函数名：PSql  
'作  用：防止SQL注入  
'返回值：为空则无注入，不为空则注入并返回注入的字符  
'****************************************************  
public Function PSql()  
Psql=""  
badwords= "'防''防;防and防exec防insert防select防update防delete防count防*防%防chr防mid防master防truncate防char防declare防|"  
badword=split(badwords,"防")  
If Request.Form<>"" Then  
For Each TF_Post In Request.Form  
For i=0 To Ubound(badword)  
If Instr(LCase(Request.Form(TF_Post)),badword(i))>0 Then  
Psql=badword(i)  
exit function  
End If  
Next  
Next  
End If  
If Request.QueryString<>"" Then  
For Each TF_Get In Request.QueryString  
For i=0 To Ubound(badword)  
If Instr(LCase(Request.QueryString(TF_Get)),badword(i))>0 Then  
Psql=badword(i)  
exit function  
End If  
Next  
Next  
End If  
End Function  
'****************************************************  
'函数名：FiltrateHtmlCode  
'作  用：防止生成html代码  
'参  数：str ----字符串  
'****************************************************  
Public Function FiltrateHtmlCode(Str)  
If Not isnull(str) And str<>"" then  
Str=Replace(Str,Chr(9),"")  
Str=replace(Str,"|","|")  
Str=replace(Str,chr(39),"'")  
Str=replace(Str,"<","<")  
Str=replace(Str,">",">")  
Str = Replace(str, CHR(13),"")  
Str = Replace(str, CHR(10),"")  
FiltrateHtmlCode=Str  
End If  
End Function  
'****************************************************  
'函数名：HtmlCode  
'作  用：过滤Html标签  
'参  数：str ----字符串  
'****************************************************  
Public function HtmlCode(str)  
If Not isnull(str) And str<>"" then  
str = replace(str, ">", ">")  
str = replace(str, "<", "<")  
str = Replace(str, CHR(32), " ")  
str = Replace(str, CHR(9), " ")  
str = Replace(str, CHR(34), """)  
str = Replace(str, CHR(39), "'")  
str = Replace(str, CHR(13), "")  
str = Replace(str, CHR(10), "")  
str = Replace(str, "script", "script")  
HtmlCode = str  
End If  
End Function  
'****************************************************  
'函数名：Replacehtml  
'作  用：清理html  
'参  数：tstr ----字符串  
'****************************************************  
Public Function Replacehtml(tstr)  
Dim Str,re  
Str=Tstr  
Set re=new RegExp  
re.IgnoreCase =True  
re.Global=True  
re.Pattern="<(p|\/p|br)>"  
Str=re.Replace(Str,vbNewLine)  
re.Pattern="<img.[^>]*src(=| )(.[^>]*)>"  
str=re.replace(str," ")  
re.Pattern="<(.[^>]*)>"  
Str=re.Replace(Str,"")  
Set Re=Nothing  
Replacehtml=Str  
End Function  
'－－－－－－－－－－－－－－－获取客户端和服务端的一些信息－－－－－－－－－－－－－－－－－－－  
'****************************************************  
'函数名：GetIP  
'作  用：获取客户端IP地址  
'返回值：客户端IP地址  
'****************************************************  
Public Function GetIP()  
Dim Temp  
Temp = Request.ServerVariables("HTTP_X_FORWARDED_FOR")  
If Temp = "" or isnull(Temp) or isEmpty(Temp) Then Temp = Request.ServerVariables("REMOTE_ADDR")  
If Instr(Temp,"'")>0 Then Temp="0.0.0.0"  
GetIP = Temp  
End Function  
'****************************************************  
'函数名：GetBrowser  
'作  用：获取客户端浏览器信息  
'返回值：客户端浏览器信息  
'****************************************************  
Public Function GetBrowser()  
info=Request.ServerVariables(HTTP_USER_AGENT)  
if Instr(info,"NetCaptor 6.5.0")>0 then  
browser="NetCaptor 6.5.0"  
elseif Instr(info,"MyIe 3.1")>0 then  
browser="MyIe 3.1"  
elseif Instr(info,"NetCaptor 6.5.0RC1")>0 then  
browser="NetCaptor 6.5.0RC1"  
elseif Instr(info,"NetCaptor 6.5.PB1")>0 then  
browser="NetCaptor 6.5.PB1"  
elseif Instr(info,"MSIE 5.5")>0 then  
browser="Internet Explorer 5.5"  
elseif Instr(info,"MSIE 6.0")>0 then  
browser="Internet Explorer 6.0"  
elseif Instr(info,"MSIE 6.0b")>0 then  
browser="Internet Explorer 6.0b"  
elseif Instr(info,"MSIE 5.01")>0 then  
browser="Internet Explorer 5.01"  
elseif Instr(info,"MSIE 5.0")>0 then  
browser="Internet Explorer 5.00"  
elseif Instr(info,"MSIE 4.0")>0 then  
browser="Internet Explorer 4.01"  
else  
browser="其它"  
end if  
End Function  
'****************************************************  
'函数名：GetSystem  
'作  用：获取客户端操作系统  
'返回值：客户端操作系统  
'****************************************************  
Function GetSystem()  
info=Request.ServerVariables(HTTP_USER_AGENT)  
if Instr(info,"NT 5.1")>0 then  
system="Windows XP"  
elseif Instr(info,"Tel")>0 then  
system="Telport"  
elseif Instr(info,"webzip")>0 then  
system="webzip"  
elseif Instr(info,"flashget")>0 then  
system="flashget"  
elseif Instr(info,"offline")>0 then  
system="offline"  
elseif Instr(info,"NT 5")>0 then  
system="Windows 2000"  
elseif Instr(info,"NT 4")>0 then  
system="Windows NT4"  
elseif Instr(info,"98")>0 then  
system="Windows 98"  
elseif Instr(info,"95")>0 then  
system="Windows 95"  
elseif instr(info,"unix") or instr(info,"linux") or instr(info,"SunOS") or instr(info,"BSD") then  
system="类Unix"  
elseif instr(thesoft,"Mac") then  
system="Mac"  
else  
system="其它"  
end if  
End Function  
'****************************************************  
'函数名：GetUrl  
'作  用：获取url包括参数  
'返回值：获取url包括参数  
'****************************************************  
Public Function GetUrl()  
Dim strTemp  
strTemp=Request.ServerVariables("Script_Name")  
If  Trim(Request.QueryString)<> "" Then  
strTemp=strTemp"?"  
For Each M_item In Request.QueryString  
strTemp=strTemp&M_item"="&Server.UrlEncode(Trim(Request.QueryString(""&M_item"")))  
next  
end if  
GetUrl=strTemp  
End Function  
'****************************************************  
'函数名：CUrl  
'作  用：获取当前页面URL的函数  
'返回值：当前页面URL的函数  
'****************************************************  
Function CUrl()  
Domain_Name = LCase(Request.ServerVariables("Server_Name"))  
Page_Name = LCase(Request.ServerVariables("Script_Name"))  
Quary_Name = LCase(Request.ServerVariables("Quary_String"))  
If Quary_Name ="" Then  
CUrl = "http://"&Domain_Name&Page_Name  
Else  
CUrl = "http://"&Domain_Name&Page_Name"?"&Quary_Name  
End If  
End Function  
'****************************************************  
'函数名：GetExtend  
'作  用：取得文件扩展名  
'参  数：filename ----文件名  
'****************************************************  
Public 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  
'－－－－－－－－－－－－－－－－－－数据库的操作－－－－－－－－－－－－－－－－－－－－－－－  
'****************************************************  
'函数名：CheckExist  
'作  用：检测某个表中某个字段是否存在某个内容  
'参  数：table        ----表名  
'       fieldname    ----字段名  
'       fieldcontent ----字段内容  
'       isblur       ----是否模糊匹配  
'返回值：false不存在，true存在  
'****************************************************  
Function CheckExist(table,fieldname,fieldcontent,isblur)  
CheckExist=false  
If isblur=1 Then  
set rsCheckExist=conn.execute("select * from "&table" where "&fieldname" like '%"&fieldcontent"%'")  
else  
set rsCheckExist=conn.execute("select * from "&table" where "&fieldname"= '"&fieldcontent"'")  
End if  
if not (rsCheckExist.eof and rsCheckExist.bof) then CheckExist=true  
rsCheckExist.close  
set rsCheckExist=nothing  
End Function  
'****************************************************  
'函数名：GetNum  
'作  用：检测某个表某个字段的数量或最大值或最小值  
'参  数：table      ----表名  
'       fieldname  ----字段名  
'       resulttype ----还回结果(count/max/min)  
'       args       ----附加参加(order by ...)  
'返回值：数值  
'****************************************************  
Function GetNum(table,fieldname,resulttype,args)  
GetFieldContentNum=0  
if fieldname="" then fieldname="*"  
sqlGetFieldContentNum="select "&resulttype"("&fieldname") from "&table& args  
set rsGetFieldContentNum=conn.execute(sqlGetFieldContentNum)  
if not (rsGetFieldContentNum.eof and rsGetFieldContentNum.bof) then GetFieldContentNum=rsGetFieldContentNum(0)  
rsGetFieldContentNum.close  
set rsGetFieldContentNum=nothing  
End Function  
'****************************************************  
'函数名：UpdateValue  
'作  用：更新表中某字段某内容的值  
'参  数：table      ----表名  
'        fieldname  ----字段名  
'        fieldvalue ----更新后的值  
'        id         ----id  
'        url        -------更新后转向地址  
'返回值：无  
'****************************************************  
Public Function UpdateValue(table,fieldname,fieldvalue,id,url)  
conn.Execute("update "&table" set "&fieldname"="&fieldvalue" where id="CLng(trim(id)))  
if url<>"" then response.redirect url  
End Function  
'－－－－－－－－－－－－－－－服务端信息和操作－－－－－－－－－－－－－－－－－－－－－－－  
'****************************************************  
'函数名：GetFolderSize  
'作  用：计算某个文件夹的大小  
'参  数：FileName ----文件夹路径及文件夹名称  
'返回值：数值  
'****************************************************  
Public Function GetFolderSize(Folderpath)  
dim fso,d,size,showsize  
set fso=server.createobject("scripting.filesystemobject")  
drvpath=server.mappath(Folderpath)  
if fso.FolderExists(drvpath) Then  
set d=fso.getfolder(drvpath)  
size=d.size  
GetFolderSize=FormatSize(size)  
Else  
GetFolderSize=Folderpath"文件夹不存在"  
End If  
End Function  
'****************************************************  
'函数名：GetFileSize  
'作  用：计算某个文件的大小  
'参  数：FileName ----文件路径及文件名  
'返回值：数值  
'****************************************************  
Public Function GetFileSize(FileName)  
Dim fso,drvpath,d,size,showsize  
set fso=server.createobject("scripting.filesystemobject")  
filepath=server.mappath(FileName)  
if fso.FileExists(filepath) then  
set d=fso.getfile(filepath)  
size=d.size  
GetFileSize=FormatSize(size)  
Else  
GetFileSize=FileName"文件不存在"  
End If  
set fso=nothing  
End Function  
'****************************************************  
'函数名：IsObjInstalled  
'作  用：检查组件是否安装  
'参  数：strClassString ----组件名称  
'返回值：false不存在，true存在  
'****************************************************  
Public Function IsObjInstalled(strClassString)  
On Error Resume Next  
IsObjInstalled=False  
Err=0  
Dim xTestObj  
Set xTestObj=Server.CreateObject(strClassString)  
If 0=Err Then IsObjInstalled=True  
Set xTestObj=Nothing  
Err=0  
End Function  
'****************************************************  
'函数名：SendMail  
'作  用：用Jmail组件发送邮件  
'参  数：ServerAddress ----服务器地址  
'       AddRecipient  ----收信人地址  
'       Subject       ----主题  
'       Body          ----信件内容  
'       Sender        ----发信人地址  
'****************************************************  
Public function SendMail(MailServerAddress,AddRecipient,Subject,Body,Sender,MailFrom)  
on error resume next  
Dim JMail  
Set JMail=Server.CreateObject("JMail.SMTPMail")  
if err then  
SendMail= "没有安装JMail组件"  
err.clear  
exit function  
end if  
JMail.Logging=True  
JMail.Charset="gb2312"  
JMail.ContentType = "text/html"  
JMail.ServerAddress=MailServerAddress  
JMail.AddRecipient=AddRecipient  
JMail.Subject=Subject  
JMail.Body=MailBody  
JMail.Sender=Sender  
JMail.From = MailFrom  
JMail.Priority=1  
JMail.Execute  
Set JMail=nothing  
if err then  
SendMail=err.description  
err.clear  
else  
SendMail="OK"  
end if  
end function  
'****************************************************  
'函数名：ResponseCookies  
'作  用：写入COOKIES  
'参  数：Key ----cookie名  
'        value ----cookie值  
'        expires ---- cookie过期时间  
'****************************************************  
Public Function ResponseCookies(Key,Value,Expires)  
DomainPath=Left(Request.ServerVariables("script_name"),inStrRev(Request.ServerVariables("script_name"),"/"))  
Response.Cookies(Key)=""&Value""  
if Expires<>0 then Response.Cookies(Key).Expires=date+Expires  
Response.Cookies(Key).Path=DomainPath  
End Function  
'****************************************************  
'函数名：CleanCookies  
'作  用：清除COOKIES  
'****************************************************  
Public Function CleanCookies()  
DomainPath=Left(Request.ServerVariables("script_name"),inStrRev(Request.ServerVariables("script_name"),"/"))  
For Each objCookie In Request.Cookies  
Response.Cookies(objCookie)= ""  
Response.Cookies(objCookie).Path=DomainPath  
Next  
End Function  
'****************************************************  
'函数名：GetTimeOver  
'作  用：清除COOKIES  
'参  数：flag ---显示时间单位1=秒，否则毫秒  
'****************************************************  
Public Function GetTimeOver(flag)  
Dim EndTime  
If flag = 1 Then  
EndTime=FormatNumber(Timer() - StartTime, 6, true)  
getTimeOver = " 本页执行时间: " & EndTime & " 秒"  
Else  
EndTime=FormatNumber((Timer() - StartTime) * 1000, 3, true)  
getTimeOver =" 本页执行时间: " & EndTime & " 毫秒"  
End If  
End function  
'－－－－－－－－－－－－－－－－－系列格式化－－－－－－－－－－－－－－－－－－－－－－－－  
'****************************************************  
'函数名：FormatSize  
'作  用：大小格式化  
'参  数：size ----要格式化的大小  
'****************************************************  
Public Function FormatSize(dsize)  
if dsize>=1073741824 then  
FormatSize=Formatnumber(dsize/1073741824,2) & " GB"  
elseif dsize>=1048576 then  
FormatSize=Formatnumber(dsize/1048576,2) & " MB"  
elseif dsize>=1024 then  
FormatSize=Formatnumber(dsize/1024,2) & " KB"  
else  
FormatSize=dsize & " Byte"  
end if  
End Function  
'****************************************************  
'函数名：FormatTime  
'作  用：时间格式化  
'参  数：DateTime ----要格式化的时间  
'       Format   ----格式的形式  
'****************************************************  
Public Function FormatTime(DateTime,Format)  
select case Format  
case "1"  
FormatTime=""&year(DateTime)"年"&month(DateTime)"月"&day(DateTime)"日"  
case "2"  
FormatTime=""&month(DateTime)"月"&day(DateTime)"日"  
case "3"  
FormatTime=""&year(DateTime)"/"&month(DateTime)"/"&day(DateTime)""  
case "4"  
FormatTime=""&month(DateTime)"/"&day(DateTime)""  
case "5"  
FormatTime=""&month(DateTime)"月"&day(DateTime)"日"&FormatDateTime(DateTime,4)""  
case "6"  
temp="周日,周一,周二,周三,周四,周五,周六"  
temp=split(temp,",")  
FormatTime=temp(Weekday(DateTime)-1)  
case Else  
FormatTime=DateTime  
end select  
End Function  
'－－－－－－－－－－－－－－－－－－－－－－杂项－－－－－－－－－－－－－－－－－－－－－  
'****************************************************  
'函数名：Zodiac  
'作  用：取得生消  
'参  数：birthday ----生日  
'****************************************************  
public Function Zodiac(birthday)  
if IsDate(birthday) then  
birthyear=year(birthday)  
ZodiacList=array("猴","鸡","狗","猪","鼠","牛","虎","兔","龙","蛇","马","羊")  
Zodiac=ZodiacList(birthyear mod 12)  
end if  
End Function  
'****************************************************  
'函数名：Constellation  
'作  用：取得星座  
'参  数：birthday ----生日  
'****************************************************  
public Function Constellation(birthday)  
if IsDate(birthday) then  
ConstellationMon=month(birthday)  
ConstellationDay=day(birthday)  
if Len(ConstellationMon)<2 then ConstellationMon="0"&ConstellationMon  
if Len(ConstellationDay)<2 then ConstellationDay="0"&ConstellationDay  
MyConstellation=ConstellationMon&ConstellationDay  
if MyConstellation < 0120 then  
constellation="<img src=images/Constellation/g.gif title='魔羯座 Capricorn'>"  
elseif MyConstellation < 0219 then  
constellation="<img src=images/Constellation/h.gif title='水瓶座 Aquarius'>"  
elseif MyConstellation < 0321 then  
constellation="<img src=images/Constellation/i.gif title='双鱼座 Pisces'>"  
elseif MyConstellation < 0420 then  
constellation="<img src=images/Constellation/^.gif title='白羊座 Aries'>"  
elseif MyConstellation < 0521 then  
constellation="<img src=images/Constellation/_.gif title='金牛座 Taurus'>"  
elseif MyConstellation < 0622 then  
constellation="<img src=images/Constellation/`.gif title='双子座 Gemini'>"  
elseif MyConstellation < 0723 then  
constellation="<img src=images/Constellation/a.gif title='巨蟹座 Cancer'>"  
elseif MyConstellation < 0823 then  
constellation="<img src=images/Constellation/b.gif title='狮子座 Leo'>"  
elseif MyConstellation < 0923 then  
constellation="<img src=images/Constellation/c.gif title='处女座 Virgo'>"  
elseif MyConstellation < 1024 then  
constellation="<img src=images/Constellation/d.gif title='天秤座 Libra'>"  
elseif MyConstellation < 1122 then  
constellation="<img src=images/Constellation/e.gif title='天蝎座 Scorpio'>"  
elseif MyConstellation < 1222 then  
constellation="<img src=images/Constellation/f.gif title='射手座 Sagittarius'>"  
elseif MyConstellation > 1221 then  
constellation="<img src=images/Constellation/g.gif title='魔羯座 Capricorn'>"  
end if  
end if  
End Function  
'=================================================  
'函数名：autopage  
'作  用：长文章自动分页  
'参  数：id,content,urlact  
'=================================================  
Function AutoPage(content,paramater,pagevar)  
contentStr=split(content,pagevar)  
pagesize=ubound(contentStr)  
if pagesize>0 then  
If Int(Request("page"))="" or Int(Request("page"))=0 Then  
pageNum=1  
Else  
pageNum=Request("page")  
End if  
if pageNum-1<=pagesize then  
AutoPage=AutoPage&contentStr(pageNum-1)  
AutoPage=AutoPage"<div margin-top:10px;text-align:right;padding-right:15px;""><font color=blue>页码:</font><font color=red>"  
For i=0 to pagesize  
if i=pageNum-1 then  
AutoPage=AutoPage"[<font color=red>"&i+1"</font>] "  
else  
if instr(paramater,"?")>0 then  
AutoPage=AutoPage"<a href="""mater"&page="&i+1""">["&(i+1)"]</a>"  
else  
AutoPage=AutoPage"<a href="""mater"?page="&i+1""">["&(i+1)"]</a>"  
end if  
end if  
Next  
AutoPage=AutoPage"</font></div>"  
else  
AutoPage=AutoPage"非法操作！页号超出！<a href=javascript:history.back(-1)><u>返回</u></a>"  
end if  
Else  
AutoPage=content  
end if  
End Function  
End Class  
%>

转载于:https://www.cnblogs.com/wja513/archive/2009/10/09/1579887.html