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

时间:2021-07-14 14:45:20

代码如下:


<% 
'------------------------------------- 
'天枫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-u9FA5uF900-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][wu4e00-u9fa5]+$" 
        Set pass=Rep.Execute(Str) 
        If pass.count=0 Then CheckName=false 
        Set Rep=Nothing 
    End Function 

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

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

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

    '**************************************************** 
    '函数名:GoBack 
    '作  用:错误信息提示 
    '参  数:str1   ----信息提示标题 
    '       str2   ----信息提示内容 
    '       isback ----是否显示返回 
    '返回值:无 
    '**************************************************** 
    Public Function GoBack(Str1,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