ASP常用自编函数搜集整理

'产生在1到50内的10个随机数

function showrnd(x,y) '第一个参数要得到多少个数，第二个指定最

if y<x then

 exit function

end if

redim n(x)

dim i,q

dim isok

for i=1 to 10

Randomize

n(i)=round((y-1)* Rnd)+1

isok=false

do while not isok

  for q=1 to i

    if n(i)=n(q-1) then

     n(i)=Int((y-1)* Rnd)+1

  isok=false

     exit for

 end if

  isok=true

  next

loop

response.write n(i)&<br>

next

end function

 

 

<%

'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

'天枫ASP class v1.0，集常用asp函数于一体

'天枫版权所有http://www.52515.net

'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,"&nbsp;"," "),"&quot;",Chr(34)),"&gt;",">"),"&lt;","<"),"|","|")

     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," ","&nbsp;"),Chr(34),"&quot;"),">","&gt;"),"<","&lt;"),"|","|")

  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, "&nbsp;", "")

  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"<divmargin-left:5px;border:1px solid #0066cc;98%""><divheight: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><divline-height:50px;background:#F7F7F7;vertical-align:middle;font-size:14px;100%""><div  style=""color:red;font:50px/50px 宋体;float:left;5%"">×</div><div  style=""margin-top:8px;float:right;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&"&nbsp;&nbsp;<a href="""&url&""" >返回继续管理</a>"

  Response.Write"<divmargin-left:5px;border:1px solid #0066cc;98%""><divheight: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><divline-height:50px;background:#F7F7F7;vertical-align:middle;font-size:14px;100%""><div  style=""color:red;font:50px/50px 宋体;float:left;5%"">√</div><div  style=""margin-top:8px;float:right;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,"<","&lt;")

   Str=replace(Str,">","&gt;")

   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, ">", "&gt;")

   str = replace(str, "<", "&lt;")

   str = Replace(str, CHR(32), " ")

   str = Replace(str, CHR(9), "&nbsp;")

   str = Replace(str, CHR(34), "&quot;")

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

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

      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

%>