代码如下:
<%
''－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
''天枫ASP class v1.0，集常用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() 获取当前页面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"<div style=""margin-left:5px;border:1px solid #0066cc;width:98%""><div style=""height: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><div style=""line-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"<div style=""margin-left:5px;border:1px solid #0066cc;width:98%""><div style=""height: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><div style=""line-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,"[img]$2[/img]")
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=http://www.popasp.com/images/Constellation/g.gif title=''魔羯座 Capricorn''>"
elseif MyConstellation < 0219 then
constellation="<img src=http://www.popasp.com/images/Constellation/h.gif title=''水瓶座 Aquarius''>"
elseif MyConstellation < 0321 then
constellation="<img src=http://www.popasp.com/images/Constellation/i.gif title=''双鱼座 Pisces''>"
elseif MyConstellation < 0420 then
constellation="<img src=http://www.popasp.com/images/Constellation/^.gif title=''白羊座 Aries''>"
elseif MyConstellation < 0521 then
constellation="<img src=http://www.popasp.com/images/Constellation/_.gif title=''金牛座 Taurus''>"
elseif MyConstellation < 0622 then
constellation="<img src=http://www.popasp.com/images/Constellation/`.gif title=''双子座 Gemini''>"
elseif MyConstellation < 0723 then
constellation="<img src=http://www.popasp.com/images/Constellation/a.gif title=''巨蟹座 Cancer''>"
elseif MyConstellation < 0823 then
constellation="<img src=http://www.popasp.com/images/Constellation/b.gif title=''狮子座 Leo''>"
elseif MyConstellation < 0923 then
constellation="<img src=http://www.popasp.com/images/Constellation/c.gif title=''处女座 Virgo''>"
elseif MyConstellation < 1024 then
constellation="<img src=http://www.popasp.com/images/Constellation/d.gif title=''天秤座 Libra''>"
elseif MyConstellation < 1122 then
constellation="<img src=http://www.popasp.com/images/Constellation/e.gif title=''天蝎座 Scorpio''>"
elseif MyConstellation < 1222 then
constellation="<img src=http://www.popasp.com/images/Constellation/f.gif title=''射手座 Sagittarius''>"
elseif MyConstellation > 1221 then
constellation="<img src=http://www.popasp.com/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 style=""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
%>
