推荐下天枫常用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
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值