<%

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

'所有功能函数名如下：

' 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="[\一-\龥\?-\?]"

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

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

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_一-\龥][\w\一-\龥]+$"

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

        Str=replace(Str,chr(39),"&#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), "&#39;")

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

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

    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,"[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 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&"<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="""&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

    AutoPage=content

End Function

%>