推荐下天枫常用ASP函数封装,推荐大家使用


复制代码 代码如下:

<%
-------------------------------------
天枫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," "," "),""",Chr(34)),">",">"),"<","<"),"|","|")
           l=Len(str)
           t=0
           For i=1 To l
              c=Abs(Asc(Mid(str,i,1)))
              If c>255 Then
                t=t+2
              Else
                t=t+1
              End If
              If t>=strlen Then
                cutstr=Left(str,i) & "..."
                Exit For
              Else
                cutstr=str
              End If
           Next
           cutstr=Replace(Replace(Replace(Replace(replace(cutstr," "," "),Chr(34),"""),">",">"),"<","<"),"|","|")
        End Function

--------------系列验证----------------------------

    ****************************************************
    函数名:CheckIsEmpty
    作  用:检查是否为空
    参  数:tstr ----字符串
    返回值:true不为空,false为空
    ****************************************************
    Public Function CheckIsEmpty(tstr)
        CheckIsEmpty=false
        If IsNull(tstr) or Tstr="" Then Exit Function 
        Dim Str,re
        Str=Tstr
        Set re=new RegExp
        re.IgnoreCase =True
        re.Global=True
        str= Replace(str, vbNewLine, "")
        str = Replace(str, Chr(9), "")
        str = Replace(str, " ", "")
        str = Replace(str, " ", "")
        re.Pattern="<img(.[^>]*)>"
        str =re.Replace(Str,"94kk")
        re.Pattern="<(.[^>]*)>"
        Str=re.Replace(Str,"")
        Set Re=Nothing
        If Str<>"" Then CheckIsEmpty=true
    End Function

    ****************************************************
    函数名:isInteger
    作  用:整数检验
    参  数:tstr ----字符
    返回值:true是整数,false不是整数
    ****************************************************
    Public function isInteger(para)
           on error resume Next
           Dim str
           Dim l,i
           If isNUll(para) then 
              isInteger=false
              exit function
           End if
           str=cstr(para)
           If trim(str)="" then
              isInteger=false
              exit function
           End if
           l=len(str)
           For i=1 to l
               If mid(str,i,1)>"9" or mid(str,i,1)<"0" then
                  isInteger=false 
                  exit function
               End if
           Next
           isInteger=true
           If err.number<>0 then err.clear
    End Function

    ****************************************************
    函数名:CheckName
    作  用:名字字符检验    
    参  数:str ----字符串
    返回值:true无误,false有误
    ****************************************************
    Public Function CheckName(Str)
        Checkname=true
        Dim Rep,pass
        Set Rep=New RegExp
        Rep.Global=True
        Rep.IgnoreCase=True
        匹配字母、数字、下划线、汉字且必须以字母或下划线或汉字开始
        Rep.Pattern="^[a-zA-Z_u4e00-\u9fa5][\w\u4e00-\u9fa5]+$"
        Set pass=Rep.Execute(Str)
        If pass.count=0 Then CheckName=false
        Set Rep=Nothing
    End Function

    ****************************************************
    函数名:CheckPassword
    作  用:密码检验
    参  数:str ----字符串
    返回值:true无误,false有误
    ****************************************************
    Public Function CheckPassword(Str)
        Dim pass
        CheckPassword=true
        If Str <> "" Then
            Dim Rep
            Set Rep = New RegExp
            Rep.Global = True
            Rep.IgnoreCase = True
            匹配字母、数字、下划线、点号
            Rep.Pattern="[a-zA-Z0-9_\.]+$"
            Pass=rep.Test(Str)
            Set Rep=nothing
            If not Pass Then CheckPassword=false
            End If
    End Function    

    ****************************************************
    函数名:CheckEmail
    作  用:邮箱格式检测
    参  数:str ----Email地址
    返回值:true无误,false有误
    ****************************************************
    Public function CheckEmail(email)
        CheckEmail=true
        Dim Rep
        Set Rep = new RegExp
        rep.pattern="([\.a-zA-Z0-9_-]){2,10}@([a-zA-Z0-9_-]){2,10}(\.([a-zA-Z0-9]){2,}){1,4}$"
        pass=rep.Test(email)
        Set Rep=Nothing
        If not pass Then CheckEmail=false
    End function

--------------信息提示----------------------------        
    ****************************************************
    函数名:Alert
    作  用:弹出对话框提示
    参  数:msg   ----对话框信息
           gourl ----提示后转向哪里
    返回值:无
    ****************************************************
    Public Function Alert(msg,goUrl)
        msg = replace(msg,"","\")
          If goUrl="" Then
              goUrl="history.go(-1);"
        Else
            goUrl="window.location.href="&goUrl&""
        End IF
        Response.Write ("<script language=""JavaScript"" type=""text/javascript"">"&vbNewLine&"alert(" & msg & ");"&goUrl&vbNewLine&"</script>")
        Response.End
    End Function

    ****************************************************
    函数名:GoBack
    作  用:错误信息提示
    参  数:str1   ----信息提示标题
           str2   ----信息提示内容
           isback ----是否显示返回
    返回值:无
    ****************************************************
    Public Function GoBack(Str1,Str2,isback)
        If Str1="" Then Str1="错误信息"
        If Str2="" Then Str2="请填写完整必填项目"
        If isback="" Then 
            Str2=Str2&" <a href=""javascript:history.go(-1)"">返回重填</a></li>"
        else
            Str2=Str2
        end if
        Response.Write"<div style=""margin-left:5px;border:1px solid #0066cc;width:98%""><div style=""height:22px;font-weight:bold;color : white;font-size:14px;background:#799AE1;background:url(images/th.gif);;text-align:left;line-height:20px;padding:3px;"">"&Str1&" </div><div style=""line-height:50px;background:#F7F7F7;vertical-align:middle;font-size:14px;width:100%""><div  style=""color:red;font:50px/50px 宋体;float:left;width:5%"">×</div><div  style=""margin-top:8px;float:right;width:90%;text-align:left;padding-left:3px;"">"&str2&"</div></div></div>"
        response.end
    End Function

    ****************************************************
    函数名:Suc
    作  用:成功提示信息
    参  数:str1   ----信息提示标题
           str2   ----信息提示内容
           url    ----返回地址
    返回值:无
    ****************************************************
    Public Function Suc(str1,str2,url)
        If str1="" Then Str1="操作成功"
        If str2="" Then Str2="成功的完成这次操作!"
        If url="" Then url="javascript:history.go(-1)"
        str2=str2&"  <a href="""&url&""" >返回继续管理</a>"
        Response.Write"<div style=""margin-left:5px;border:1px solid #0066cc;width:98%""><div style=""height:22px;font-weight:bold;color : white;font-size:14px;background:#799AE1;background:url(images/th.gif);;text-align:left;line-height:20px;padding:3px;"">"&Str1&" </div><div style=""line-height:50px;background:#F7F7F7;vertical-align:middle;font-size:14px;width:100%""><div  style=""color:red;font:50px/50px 宋体;float:left;width:5%"">√</div><div  style=""margin-top:8px;float:right;width:90%;text-align:left;padding-left:3px;"">"&str2&"</div></div></div>"
    End Function

--------------安全处理----------------------------    

    ****************************************************
    函数名:ChkPost
    作  用:禁止站外提交表单
    返回值:true站内提交,flase站外提交
    ****************************************************
    Public Function ChkPost()
        Dim url1,url2
        chkpost=true
        url1=Cstr(Request.ServerVariables("HTTP_REFERER"))
        url2=Cstr(Request.ServerVariables("SERVER_NAME"))
        If Mid(url1,8,Len(url2))<>url2 Then
             chkpost=false
             exit function
        End If
    End function

    ****************************************************
    函数名:PSql
    作  用:防止SQL注入
    返回值:为空则无注入,不为空则注入并返回注入的字符
    ****************************************************
    public Function PSql()
        Psql=""
        badwords= "防防;防and防exec防insert防select防update防delete防count防*防%防chr防mid防master防truncate防char防declare防|"
        badword=split(badwords,"防")
        If Request.Form<>"" Then
            For Each TF_Post In Request.Form
                For i=0 To Ubound(badword)
                    If Instr(LCase(Request.Form(TF_Post)),badword(i))>0 Then
                        Psql=badword(i)
                        exit function
                    End If
                Next
            Next
        End If
        If Request.QueryString<>"" Then
            For Each TF_Get In Request.QueryString
                For i=0 To Ubound(badword)
                    If Instr(LCase(Request.QueryString(TF_Get)),badword(i))>0 Then
                        Psql=badword(i)
                        exit function
                    End If
                Next
            Next
        End If
    End Function

    ****************************************************
    函数名:FiltrateHtmlCode
    作  用:防止生成html代码    
    参  数:str ----字符串
    ****************************************************
    Public Function FiltrateHtmlCode(Str)
        If Not isnull(str) And str<>"" then
            Str=Replace(Str,Chr(9),"")
            Str=replace(Str,"|","|")
            Str=replace(Str,chr(39),"'")
            Str=replace(Str,"<","<")
            Str=replace(Str,">",">")
            Str = Replace(str, CHR(13),"")
            Str = Replace(str, CHR(10),"")
            FiltrateHtmlCode=Str
        End If
    End Function

    ****************************************************
    函数名:HtmlCode
    作  用:过滤Html标签
    参  数:str ----字符串
    ****************************************************
    Public function HtmlCode(str)
        If Not isnull(str) And str<>"" then
            str = replace(str, ">", ">")
            str = replace(str, "<", "<")
            str = Replace(str, CHR(32), " ")
            str = Replace(str, CHR(9), " ")
            str = Replace(str, CHR(34), """)
            str = Replace(str, CHR(39), "'")
            str = Replace(str, CHR(13), "")
            str = Replace(str, CHR(10), "")
            str = Replace(str, "script", "script")
            HtmlCode = str
        End If
    End Function

    ****************************************************
    函数名:Replacehtml
    作  用:清理html
    参  数:tstr ----字符串
    ****************************************************
    Public Function Replacehtml(tstr)
        Dim Str,re
        Str=Tstr
        Set re=new RegExp
            re.IgnoreCase =True
            re.Global=True
            re.Pattern="<(p|\/p|br)>"
            Str=re.Replace(Str,vbNewLine)
            re.Pattern="<img.[^>]*src(=| )(.[^>]*)>"
            str=re.replace(str,"[img]$2[/img]")
            re.Pattern="<(.[^>]*)>"
            Str=re.Replace(Str,"")
            Set Re=Nothing
            Replacehtml=Str
    End Function


---------------获取客户端和服务端的一些信息-------------------

    ****************************************************
    函数名:GetIP
    作  用:获取客户端IP地址
    返回值:客户端IP地址
    ****************************************************
    Public Function GetIP()
        Dim Temp
        Temp = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
        If Temp = "" or isnull(Temp) or isEmpty(Temp) Then Temp = Request.ServerVariables("REMOTE_ADDR")
        If Instr(Temp,"")>0 Then Temp="0.0.0.0"
        GetIP = Temp
    End Function

    ****************************************************
    函数名:GetBrowser
    作  用:获取客户端浏览器信息
    返回值:客户端浏览器信息
    ****************************************************
    Public Function GetBrowser()
           info=Request.ServerVariables(HTTP_USER_AGENT) 
        if Instr(info,"NetCaptor 6.5.0")>0 then
            browser="NetCaptor 6.5.0"
        elseif Instr(info,"MyIe 3.1")>0 then
            browser="MyIe 3.1"
        elseif Instr(info,"NetCaptor 6.5.0RC1")>0 then
            browser="NetCaptor 6.5.0RC1"
        elseif Instr(info,"NetCaptor 6.5.PB1")>0 then
            browser="NetCaptor 6.5.PB1"
        elseif Instr(info,"MSIE 5.5")>0 then
            browser="Internet Explorer 5.5"
        elseif Instr(info,"MSIE 6.0")>0 then
            browser="Internet Explorer 6.0"
        elseif Instr(info,"MSIE 6.0b")>0 then
            browser="Internet Explorer 6.0b"
        elseif Instr(info,"MSIE 5.01")>0 then
            browser="Internet Explorer 5.01"
        elseif Instr(info,"MSIE 5.0")>0 then
            browser="Internet Explorer 5.00"
        elseif Instr(info,"MSIE 4.0")>0 then
            browser="Internet Explorer 4.01"
        else
            browser="其它"
        end if
    End Function

    ****************************************************
    函数名:GetSystem
    作  用:获取客户端操作系统
    返回值:客户端操作系统
    ****************************************************
    Function GetSystem()
        info=Request.ServerVariables(HTTP_USER_AGENT) 
        if Instr(info,"NT 5.1")>0 then
            system="Windows XP"
        elseif Instr(info,"Tel")>0 then
            system="Telport"
        elseif Instr(info,"webzip")>0 then
            system="webzip"
        elseif Instr(info,"flashget")>0 then
            system="flashget"
        elseif Instr(info,"offline")>0 then
            system="offline"
        elseif Instr(info,"NT 5")>0 then
            system="Windows 2000"
        elseif Instr(info,"NT 4")>0 then
            system="Windows NT4"
        elseif Instr(info,"98")>0 then
            system="Windows 98"
        elseif Instr(info,"95")>0 then
            system="Windows 95"
        elseif instr(info,"unix") or instr(info,"linux") or instr(info,"SunOS") or instr(info,"BSD") then
            system="类Unix"
        elseif instr(thesoft,"Mac") then
            system="Mac"
        else
            system="其它"
        end if
    End Function

    ****************************************************
    函数名:GetUrl
    作  用:获取url包括参数
    返回值:获取url包括参数
    ****************************************************
    Public Function GetUrl()   
        Dim strTemp     
        strTemp=Request.ServerVariables("Script_Name")      
        If  Trim(Request.QueryString)<> "" Then
            strTemp=strTemp&"?"
            For Each M_item In Request.QueryString
                strTemp=strTemp&M_item&"="&Server.UrlEncode(Trim(Request.QueryString(""&M_item&"")))
            next
        end if
        GetUrl=strTemp   
    End Function 

    ****************************************************
    函数名:CUrl
    作  用:获取当前页面URL的函数
    返回值:当前页面URL的函数
    ****************************************************
    Function CUrl()
        Domain_Name = LCase(Request.ServerVariables("Server_Name"))
        Page_Name = LCase(Request.ServerVariables("Script_Name"))
        Quary_Name = LCase(Request.ServerVariables("Quary_String"))
        If Quary_Name ="" Then
            CUrl = "http://"&Domain_Name&Page_Name
        Else
            CUrl = "http://"&Domain_Name&Page_Name&"?"&Quary_Name
        End If
    End Function

    ****************************************************
    函数名:GetExtend
    作  用:取得文件扩展名
    参  数:filename ----文件名
    ****************************************************
    Public Function GetExtend(filename)
        dim tmp
        if filename<>"" then
            tmp=mid(filename,instrrev(filename,".")+1,len(filename)-instrrev(filename,"."))
            tmp=LCase(tmp)
            if instr(1,tmp,"asp")>0 or instr(1,tmp,"php")>0 or instr(1,tmp,"php3")>0 or instr(1,tmp,"aspx")>0 then
                getextend="txt"
            else
                getextend=tmp
            end if
        else
            getextend=""
        end if
    End Function
------------------数据库的操作-----------------------

    ****************************************************
    函数名:CheckExist
    作  用:检测某个表中某个字段是否存在某个内容
    参  数:table        ----表名
           fieldname    ----字段名
           fieldcontent ----字段内容
           isblur       ----是否模糊匹配
    返回值:false不存在,true存在
    ****************************************************
    Function CheckExist(table,fieldname,fieldcontent,isblur)
        CheckExist=false
        If isblur=1 Then
            set rsCheckExist=conn.execute("select * from "&table&" where "&fieldname&" like %"&fieldcontent&"%")
        else
            set rsCheckExist=conn.execute("select * from "&table&" where "&fieldname&"= "&fieldcontent&"")
        End if
        if not (rsCheckExist.eof and rsCheckExist.bof) then CheckExist=true
        rsCheckExist.close
        set rsCheckExist=nothing
    End Function

    ****************************************************
    函数名:GetNum
    作  用:检测某个表某个字段的数量或最大值或最小值
    参  数:table      ----表名
           fieldname  ----字段名
           resulttype ----还回结果(count/max/min)
           args       ----附加参加(order by ...)
    返回值:数值
    ****************************************************
    Function GetNum(table,fieldname,resulttype,args)
        GetFieldContentNum=0
        if fieldname="" then fieldname="*"
        sqlGetFieldContentNum="select "&resulttype&"("&fieldname&") from "&table& args
        set rsGetFieldContentNum=conn.execute(sqlGetFieldContentNum)    
        if not (rsGetFieldContentNum.eof and rsGetFieldContentNum.bof) then GetFieldContentNum=rsGetFieldContentNum(0)
        rsGetFieldContentNum.close
        set rsGetFieldContentNum=nothing
    End Function

    ****************************************************
    函数名:UpdateValue
    作  用:更新表中某字段某内容的值
    参  数:table      ----表名
            fieldname  ----字段名
            fieldvalue ----更新后的值
            id         ----id
            url        -------更新后转向地址
    返回值:无
    ****************************************************
    Public Function UpdateValue(table,fieldname,fieldvalue,id,url)
        conn.Execute("update "&table&" set "&fieldname&"="&fieldvalue&" where id="&CLng(trim(id)))
        if url<>"" then response.redirect url
    End Function

---------------服务端信息和操作-----------------------

    ****************************************************
    函数名:GetFolderSize
    作  用:计算某个文件夹的大小
    参  数:FileName ----文件夹路径及文件夹名称
    返回值:数值
    ****************************************************
    Public Function GetFolderSize(Folderpath)
        dim fso,d,size,showsize
        set fso=server.createobject("scripting.filesystemobject")         
        drvpath=server.mappath(Folderpath)     
        if fso.FolderExists(drvpath) Then
            set d=fso.getfolder(drvpath)         
            size=d.size
            GetFolderSize=FormatSize(size)
        Else
            GetFolderSize=Folderpath&"文件夹不存在"
        End If 
    End Function

    ****************************************************
    函数名:GetFileSize
    作  用:计算某个文件的大小
    参  数:FileName ----文件路径及文件名
    返回值:数值
    ****************************************************
    Public Function GetFileSize(FileName)
        Dim fso,drvpath,d,size,showsize
        set fso=server.createobject("scripting.filesystemobject")
        filepath=server.mappath(FileName)
        if fso.FileExists(filepath) then
            set d=fso.getfile(filepath)    
            size=d.size
            GetFileSize=FormatSize(size)
        Else
            GetFileSize=FileName&"文件不存在"
        End If
        set fso=nothing
    End Function

    ****************************************************
    函数名:IsObjInstalled
    作  用:检查组件是否安装
    参  数:strClassString ----组件名称
    返回值:false不存在,true存在
    ****************************************************
    Public Function IsObjInstalled(strClassString)
        On Error Resume Next
        IsObjInstalled=False
        Err=0
        Dim xTestObj
        Set xTestObj=Server.CreateObject(strClassString)
        If 0=Err Then IsObjInstalled=True
        Set xTestObj=Nothing
        Err=0
    End Function

    ****************************************************
    函数名:SendMail
    作  用:用Jmail组件发送邮件
    参  数:ServerAddress ----服务器地址
           AddRecipient  ----收信人地址
           Subject       ----主题
           Body          ----信件内容
           Sender        ----发信人地址
    ****************************************************
    Public function SendMail(MailServerAddress,AddRecipient,Subject,Body,Sender,MailFrom)
        on error resume next
        Dim JMail
        Set JMail=Server.CreateObject("JMail.SMTPMail")
        if err then
            SendMail= "没有安装JMail组件"
            err.clear
            exit function
        end if
        JMail.Logging=True
        JMail.Charset="gb2312"
        JMail.ContentType = "text/html"
        JMail.ServerAddress=MailServerAddress
        JMail.AddRecipient=AddRecipient
        JMail.Subject=Subject
        JMail.Body=MailBody
        JMail.Sender=Sender
        JMail.From = MailFrom
        JMail.Priority=1
        JMail.Execute 
        Set JMail=nothing 
        if err then 
            SendMail=err.description
            err.clear
        else
            SendMail="OK"
        end if
    end function

    ****************************************************
    函数名:ResponseCookies
    作  用:写入COOKIES
    参  数:Key ----cookie名
            value ----cookie值
            expires ---- cookie过期时间
    ****************************************************
    Public Function ResponseCookies(Key,Value,Expires)
        DomainPath=Left(Request.ServerVariables("script_name"),inStrRev(Request.ServerVariables("script_name"),"/"))
        Response.Cookies(Key)=""&Value&""
        if Expires<>0 then Response.Cookies(Key).Expires=date+Expires
        Response.Cookies(Key).Path=DomainPath
    End Function

    ****************************************************
    函数名:CleanCookies
    作  用:清除COOKIES
    ****************************************************
    Public Function CleanCookies()
        DomainPath=Left(Request.ServerVariables("script_name"),inStrRev(Request.ServerVariables("script_name"),"/"))
        For Each objCookie In Request.Cookies
            Response.Cookies(objCookie)= ""
            Response.Cookies(objCookie).Path=DomainPath
        Next
    End Function

    ****************************************************
    函数名:GetTimeOver
    作  用:清除COOKIES
    参  数:flag ---显示时间单位1=秒,否则毫秒
    ****************************************************
    Public Function GetTimeOver(flag)
        Dim EndTime
        If flag = 1 Then
            EndTime=FormatNumber(Timer() - StartTime, 6, true)
            getTimeOver = " 本页执行时间: " & EndTime & " 秒"
        Else
            EndTime=FormatNumber((Timer() - StartTime) * 1000, 3, true)
            getTimeOver =" 本页执行时间: " & EndTime & " 毫秒"
        End If
    End function
-----------------系列格式化------------------------

    ****************************************************
    函数名:FormatSize
    作  用:大小格式化
    参  数:size ----要格式化的大小
    ****************************************************
    Public Function FormatSize(dsize)
        if dsize>=1073741824 then
            FormatSize=Formatnumber(dsize/1073741824,2) & " GB"
        elseif dsize>=1048576 then
            FormatSize=Formatnumber(dsize/1048576,2) & " MB"
        elseif dsize>=1024 then
            FormatSize=Formatnumber(dsize/1024,2) & " KB"
        else
            FormatSize=dsize & " Byte"
        end if
    End Function

    ****************************************************
    函数名:FormatTime
    作  用:时间格式化
    参  数:DateTime ----要格式化的时间
           Format   ----格式的形式
    ****************************************************
    Public Function FormatTime(DateTime,Format) 
        select case Format
        case "1"
             FormatTime=""&year(DateTime)&"年"&month(DateTime)&"月"&day(DateTime)&"日"
        case "2"
             FormatTime=""&month(DateTime)&"月"&day(DateTime)&"日"
        case "3" 
             FormatTime=""&year(DateTime)&"/"&month(DateTime)&"/"&day(DateTime)&""
        case "4"
             FormatTime=""&month(DateTime)&"/"&day(DateTime)&""
        case "5"
             FormatTime=""&month(DateTime)&"月"&day(DateTime)&"日"&FormatDateTime(DateTime,4)&""
        case "6"
           temp="周日,周一,周二,周三,周四,周五,周六"
           temp=split(temp,",") 
           FormatTime=temp(Weekday(DateTime)-1)
        case Else
        FormatTime=DateTime
        end select
    End Function

----------------------杂项---------------------
    ****************************************************
    函数名:Zodiac
    作  用:取得生消
    参  数:birthday ----生日
    ****************************************************
    public Function Zodiac(birthday)
        if IsDate(birthday) then
            birthyear=year(birthday)
            ZodiacList=array("猴","鸡","狗","猪","鼠","牛","虎","兔","龙","蛇","马","羊")        
            Zodiac=ZodiacList(birthyear mod 12)
        end if
    End Function

    ****************************************************
    函数名:Constellation
    作  用:取得星座
    参  数:birthday ----生日
    ****************************************************
    public Function Constellation(birthday)
        if IsDate(birthday) then
            ConstellationMon=month(birthday)
            ConstellationDay=day(birthday)
            if Len(ConstellationMon)<2 then ConstellationMon="0"&ConstellationMon
            if Len(ConstellationDay)<2 then ConstellationDay="0"&ConstellationDay
            MyConstellation=ConstellationMon&ConstellationDay
            if MyConstellation < 0120 then
                constellation="<img src=images/Constellation/g.gif 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="""¶mater&"&page="&i+1&""">["&(i+1)&"]</a>"
                            else
                                AutoPage=AutoPage&"<a href="""¶mater&"?page="&i+1&""">["&(i+1)&"]</a>"
                            end if
                        end if  
                    Next 
                    AutoPage=AutoPage&"</font></div>"
                else
                    AutoPage=AutoPage&"非法操作!页号超出!<a href=javascript:history.back(-1)><u>返回</u></a>"
                end if
            Else
                AutoPage=content
            end if
    End Function
End Class
%>

调用:set fun=new cls_fun