常用ASP函数的封装

做ASP开发常常需要用到一些小功能，这些功能通常我们都会封装成函数来使用，本教程提供了许多我们经常用到的ASP函数。

'所有功能函数名如下：

' 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,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-u9FA5uF900-uFA2D]"

For each i in rep.Execute(str)

lens=lens+1

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,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

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),"")

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,1)>"9" or mid(str,1)<"0" then

isInteger=false

exit function

End if

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][wu4e00-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,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 margin-left:5px;border:1px solid #0066cc;width:98%""><div 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 line-height:50px;background:#F7F7F7;vertical-align:middle;font-size:14px;width:100%""><div color:red;font:50px/50px 宋体;float:left;width:5%"">×</div><div 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,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 margin-left:5px;border:1px solid #0066cc;width:98%""><div 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 line-height:50px;background:#F7F7F7;vertical-align:middle;font-size:14px;width:100%""><div color:red;font:50px/50px 宋体;float:left;width:5%"">√</div><div 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

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

End Function

'****************************************************

'函数名：FiltrateHtmlCode

'作用：防止生成html代码

'参数：str ----字符串

'****************************************************

Public Function FiltrateHtmlCode(Str)

If Not isnull(str) And str<>"" then

Str=Replace(Str,"")

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),CHR(34),""")

str = Replace(str,CHR(39),"'")

str = Replace(str,"script","&#115cript")

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&"")))

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,"php")>0 or instr(1,"php3")>0 or instr(1,"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,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,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,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,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"),"/"))

For Each objCookie In Request.Cookies

Response.Cookies(objCookie)= ""

Response.Cookies(objCookie).Path=DomainPath

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

Constellatith(birthday)

Constellati(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 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="""&paramater&"&page="&i+1&""">["&(i+1)&"]</a>"

else

AutoPage=AutoPage&"<a href="""&paramater&"?page="&i+1&""">["&(i+1)&"]</a>"

end if

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

常用ASP函数的封装

相关推荐