对于用asp开发网站的朋友可以借鉴下他的asp函数，方便学习与提高开发效率复制代码代码如下:
<%
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'天枫ASP class v1.0，集常用asp函数于一体
'天枫版权所有
'QQ:76994859 EMAIL:[email protected]
'所有功能函数名如下：
' 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=images/Constellation/g.gif />elseif MyConstellation < 0219 then
constellation=<img src=images/Constellation/h.gif />elseif MyConstellation < 0321 then
constellation=<img src=images/Constellation/i.gif />elseif MyConstellation < 0420 then
constellation=<img src=images/Constellation/^.gif />elseif MyConstellation < 0521 then
constellation=<img src=images/Constellation/_.gif />elseif MyConstellation < 0622 then
constellation=<img src=images/Constellation/`.gif />elseif MyConstellation < 0723 then
constellation=<img src=images/Constellation/a.gif />elseif MyConstellation < 0823 then
constellation=<img src=images/Constellation/b.gif />elseif MyConstellation < 0923 then
constellation=<img src=images/Constellation/c.gif />elseif MyConstellation < 1024 then
constellation=<img src=images/Constellation/d.gif />elseif MyConstellation < 1122 then
constellation=<img src=images/Constellation/e.gif />elseif MyConstellation < 1222 then
constellation=<img src=images/Constellation/f.gif />elseif MyConstellation > 1221 then
constellation=<img src=images/Constellation/g.gif />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
%>