推荐下天枫常用ASP函数封装，推荐大家使用

导读：
　　'QQ:76994859 EMAIL:Chenshaobo@gmail.com
　　'所有功能函数名如下：
　　' 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() 获〉鼻耙趁鎁RL包含参数
　　' 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=" "
　　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&" 返回重填"
　　else
　　Str2=Str2
　　end if
　　Response.Write"

"&Str1&"

×

"&str2&"

"
　　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&" 返回继续管理"
　　Response.Write"

"&Str1&"

√

"&str2&"

"
　　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=" ]*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=" 　　elseif MyConstellation <0219 then
　　constellation=" 　　elseif MyConstellation <0321 then
　　constellation=" 　　elseif MyConstellation <0420 then
　　constellation=" 　　elseif MyConstellation <0521 then
　　constellation=" 　　elseif MyConstellation <0622 then
　　constellation=" 　　elseif MyConstellation <0723 then
　　constellation=" 　　elseif MyConstellation <0823 then
　　constellation=" 　　elseif MyConstellation <0923 then
　　constellation=" 　　elseif MyConstellation <1024 then
　　constellation=" 　　elseif MyConstellation <1122 then
　　constellation=" 　　elseif MyConstellation <1222 then
　　constellation=" 　　elseif MyConstellation >1221 then
　　constellation=" "
　　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&"

　　For i=0 to pagesize
　　if i=pageNum-1 then
　　AutoPage=AutoPage&"["&i+1&"] "
　　else
　　if instr(paramater,"?")>0 then
　　AutoPage=AutoPage&"["&(i+1)&"]"
　　else
　　AutoPage=AutoPage&"["&(i+1)&"]"
　　end if
　　end if
　　Next
　　AutoPage=AutoPage&"

"
　　else
　　AutoPage=AutoPage&"非法操作！页号超出！ 返回"
　　end if
　　Else
　　AutoPage=content
　　end if
　　End Function
　　End Class
　　%>

本文转自
http://www.windsfly.cn/blog/article.asp?id=398