%
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'天楓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;",""),"#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_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  "');"goUrlvbNewLine"/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 ?1 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 ?1 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=strTempM_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_NamePage_Name
        Else
            CUrl = "http://"Domain_NamePage_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 = " 本頁執行時間?1 "  EndTime  " 秒"
        Else
            EndTime=FormatNumber((Timer() - StartTime) * 1000, 3, true)
            getTimeOver =" 本頁執行時間?1 "  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=ConstellationMonConstellationDay
            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=AutoPagecontentStr(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
            Else
                AutoPage=content
            end if
    End Function
End Class
%>