<%
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
'天楓ASP class v1.0，集常用asp函數(shù)于一體
'天楓版權(quán)所有
'QQ:76994859 EMAIL:Chenshaobo@gmail.com

'所有功能函數(shù)名如下：
' StrLength(str) 取得字符串長(zhǎng)度
' CutStr(str,strlen) 字符串長(zhǎng)度切割
' CheckIsEmpty(tstr) 檢測(cè)是否為空
' isInteger(para) 整數(shù)檢驗(yàn)
' CheckName(str) 名字字符校驗(yàn)
' CheckPassword(str) 密碼檢驗(yàn)
' CheckEmail(email) 郵箱格式檢驗(yàn)
' Alert(msg,goUrl) 彈出對(duì)話框提示
' GoBack(Str1,Str2,isback) 出錯(cuò)信息提示
' Suc(str1,str2,url) 操作成功信息提示
' ChkPost() 檢測(cè)是否站外提交表單
' PSql() 防止sql注入
' FiltrateHtmlCode(Str) 防止生成HTML
' HtmlCode(str) 過(guò)濾HTML
' Replacehtml(tstr) 清濾HTML
' GetIP() 獲取客戶端IP
' GetBrowser 獲取客戶端瀏覽器信
' GetSystem 獲取客戶端操作系統(tǒng)
' GetUrl() 獲取當(dāng)前頁(yè)面URL包含參數(shù)
' CUrl()   獲取當(dāng)前頁(yè)面URL
' GetExtend 取得文件擴(kuò)展名
' CheckExist(table,fieldname,fieldcontent,isblur) 檢測(cè)某個(gè)表中某個(gè)字段的內(nèi)容是否存在
' GetNum(table,fieldname,resulttype,args) 檢測(cè)某個(gè)表某個(gè)字段有多少條，最大值 ，最小值等
' GetFolderSize(Folderpath) 計(jì)算某個(gè)文件夾的大小
' GetFileSize(Filename) 計(jì)算某個(gè)文件的大小
' IsObjInstalled(strClassString) 檢測(cè)組件是否安裝
' SendMail JMAIL發(fā)送郵件
' ResponseCookies 寫(xiě)入cookies
' CleanCookies 清除cookies
' GetTimeover 取得程序頁(yè)面執(zhí)行時(shí)間
' FormatSize 大小格式化
' FormatTime 時(shí)間格式化
' Zodiac 取得生肖
' Constellation   取得星座
'－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Class Cls_fun

'－－－－－－－－字符處理－－－－－－－－－－－－－－－－－－－－－－－－－－

 '****************************************************
 '函數(shù)名：StrLength
 '作  用：取得字符串長(zhǎng)度（漢字為2)
 '參  數(shù)：str ----字符串內(nèi)容
 '返回值：字符串長(zhǎng)度
 '****************************************************
 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

 '****************************************************
 '函數(shù)名：CutStr
 '作  用：字符串長(zhǎng)度切割，超過(guò)顯示省略號(hào)
 '參  數(shù)：str    ----字符串內(nèi)容
 '       strlen ------要顯示的長(zhǎng)度
 '返回值：切割后字符串內(nèi)容
 '****************************************************
 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

'－－－－－－－－－－－－－－系列驗(yàn)證－－－－－－－－－－－－－－－－－－－－－－－－－－－－

    '****************************************************
 '函數(shù)名：CheckIsEmpty
 '作  用：檢查是否為空
 '參  數(shù)：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

    '****************************************************
 '函數(shù)名：isInteger
 '作  用：整數(shù)檢驗(yàn)
 '參  數(shù)：tstr ----字符
 '返回值：true是整數(shù)，false不是整數(shù)
 '****************************************************
 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

    '****************************************************
 '函數(shù)名：CheckName
 '作  用：名字字符檢驗(yàn) 
 '參  數(shù)：str ----字符串
 '返回值：true無(wú)誤，false有誤
 '****************************************************
 Public Function CheckName(Str)
  Checkname=true
  Dim Rep,pass
  Set Rep=New RegExp
  Rep.Global=True
  Rep.IgnoreCase=True
  '匹配字母、數(shù)字、下劃線、漢字且必須以字母或下劃線或漢字開(kāi)始
  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

 '****************************************************
 '函數(shù)名：CheckPassword
 '作  用：密碼檢驗(yàn)
 '參  數(shù)：str ----字符串
 '返回值：true無(wú)誤，false有誤
 '****************************************************
 Public Function CheckPassword(Str)
  Dim pass
  CheckPassword=true
  If Str <> "" Then
   Dim Rep
   Set Rep = New RegExp
   Rep.Global = True
   Rep.IgnoreCase = True
   '匹配字母、數(shù)字、下劃線、點(diǎn)號(hào)
   Rep.Pattern="[a-zA-Z0-9_\.]+$"
   Pass=rep.Test(Str)
   Set Rep=nothing
   If not Pass Then CheckPassword=false
   End If
 End Function 

 '****************************************************
 '函數(shù)名：CheckEmail
 '作  用：郵箱格式檢測(cè)
 '參  數(shù)：str ----Email地址
 '返回值：true無(wú)誤，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

'－－－－－－－－－－－－－－信息提示－－－－－－－－－－－－－－－－－－－－－－－－－－－－  
 '****************************************************
 '函數(shù)名：Alert
 '作  用：彈出對(duì)話框提示
 '參  數(shù)：msg   ----對(duì)話框信息
 '       gourl ----提示后轉(zhuǎn)向哪里
 '返回值：無(wú)
 '****************************************************
    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

    '****************************************************
 '函數(shù)名：GoBack
 '作  用：錯(cuò)誤信息提示
 '參  數(shù)：str1   ----信息提示標(biāo)題
 '       str2   ----信息提示內(nèi)容
 '       isback ----是否顯示返回
 '返回值：無(wú)
 '****************************************************
 Public Function GoBack(Str1,Str2,isback)
  If Str1="" Then Str1="錯(cuò)誤信息"
  If Str2="" Then Str2="請(qǐng)?zhí)顚?xiě)完整必填項(xiàng)目"
  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

    '****************************************************
 '函數(shù)名：Suc
 '作  用：成功提示信息
 '參  數(shù)：str1   ----信息提示標(biāo)題
 '       str2   ----信息提示內(nèi)容
 '       url    ----返回地址
 '返回值：無(wú)
 '****************************************************
 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&""" >返回繼續(xù)管理</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

'－－－－－－－－－－－－－－安全處理－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 

 '****************************************************
 '函數(shù)名：ChkPost
 '作  用：禁止站外提交表單
 '返回值：true站內(nèi)提交，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

 '****************************************************
 '函數(shù)名：PSql
 '作  用：防止SQL注入
 '返回值：為空則無(wú)注入，不為空則注入并返回注入的字符
 '****************************************************
 public Function PSql()
     Psql=""
  badwords= "'防''防;防and防exec防insert防select防update防delete防count防*防%防chr防m(xù)id防m(xù)aster防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

    '****************************************************
 '函數(shù)名：FiltrateHtmlCode
 '作  用：防止生成html代碼 
 '參  數(shù)：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

    '****************************************************
 '函數(shù)名：HtmlCode
 '作  用：過(guò)濾Html標(biāo)簽
 '參  數(shù)：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

    '****************************************************
 '函數(shù)名：Replacehtml
 '作  用：清理html
 '參  數(shù)：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


'－－－－－－－－－－－－－－－獲取客戶端和服務(wù)端的一些信息－－－－－－－－－－－－－－－－－－－

    '****************************************************
 '函數(shù)名：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

    '****************************************************
 '函數(shù)名：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

    '****************************************************
 '函數(shù)名：GetSystem
 '作  用：獲取客戶端操作系統(tǒng)
 '返回值：客戶端操作系統(tǒng)
 '****************************************************
    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

 '****************************************************
 '函數(shù)名：GetUrl
 '作  用：獲取url包括參數(shù)
 '返回值：獲取url包括參數(shù)
 '****************************************************
 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 

 '****************************************************
 '函數(shù)名：CUrl
 '作  用：獲取當(dāng)前頁(yè)面URL的函數(shù)
 '返回值：當(dāng)前頁(yè)面URL的函數(shù)
 '****************************************************
 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

    '****************************************************
 '函數(shù)名：GetExtend
 '作  用：取得文件擴(kuò)展名
 '參  數(shù)：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
'－－－－－－－－－－－－－－－－－－數(shù)據(jù)庫(kù)的操作－－－－－－－－－－－－－－－－－－－－－－－

    '****************************************************
 '函數(shù)名：CheckExist
 '作  用：檢測(cè)某個(gè)表中某個(gè)字段是否存在某個(gè)內(nèi)容
 '參  數(shù)：table        ----表名
 '       fieldname    ----字段名
 '       fieldcontent ----字段內(nèi)容
 '       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

 '****************************************************
 '函數(shù)名：GetNum
 '作  用：檢測(cè)某個(gè)表某個(gè)字段的數(shù)量或最大值或最小值
 '參  數(shù)：table      ----表名
 '       fieldname  ----字段名
 '       resulttype ----還回結(jié)果(count/max/min)
 '       args       ----附加參加(order by ...)
 '返回值：數(shù)值
 '****************************************************
 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

 '****************************************************
 '函數(shù)名：UpdateValue
 '作  用：更新表中某字段某內(nèi)容的值
 '參  數(shù)：table      ----表名
 '        fieldname  ----字段名
 '        fieldvalue ----更新后的值
 '        id         ----id
 '        url        -------更新后轉(zhuǎn)向地址
 '返回值：無(wú)
 '****************************************************
 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

'－－－－－－－－－－－－－－－服務(wù)端信息和操作－－－－－－－－－－－－－－－－－－－－－－－

    '****************************************************
 '函數(shù)名：GetFolderSize
 '作  用：計(jì)算某個(gè)文件夾的大小
 '參  數(shù)：FileName ----文件夾路徑及文件夾名稱
 '返回值：數(shù)值
 '****************************************************
 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

 '****************************************************
 '函數(shù)名：GetFileSize
 '作  用：計(jì)算某個(gè)文件的大小
 '參  數(shù)：FileName ----文件路徑及文件名
 '返回值：數(shù)值
 '****************************************************
 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

 '****************************************************
 '函數(shù)名：IsObjInstalled
 '作  用：檢查組件是否安裝
 '參  數(shù)：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

 '****************************************************
 '函數(shù)名：SendMail
 '作  用：用Jmail組件發(fā)送郵件
 '參  數(shù)：ServerAddress ----服務(wù)器地址
 '       AddRecipient  ----收信人地址
 '       Subject       ----主題
 '       Body          ----信件內(nèi)容
 '       Sender        ----發(fā)信人地址
 '****************************************************
 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= "沒(méi)有安裝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

    '****************************************************
 '函數(shù)名：ResponseCookies
 '作  用：寫(xiě)入COOKIES
 '參  數(shù)：Key ----cookie名
 '        value ----cookie值
 '        expires ---- cookie過(guò)期時(shí)間
 '****************************************************
 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

    '****************************************************
 '函數(shù)名：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

 '****************************************************
 '函數(shù)名：GetTimeOver
 '作  用：清除COOKIES
 '參  數(shù)：flag ---顯示時(shí)間單位1=秒，否則毫秒
 '****************************************************
 Public Function GetTimeOver(flag)
  Dim EndTime
  If flag = 1 Then
   EndTime=FormatNumber(Timer() - StartTime, 6, true)
   getTimeOver = " 本頁(yè)執(zhí)行時(shí)間: " & EndTime & " 秒"
  Else
   EndTime=FormatNumber((Timer() - StartTime) * 1000, 3, true)
   getTimeOver =" 本頁(yè)執(zhí)行時(shí)間: " & EndTime & " 毫秒"
  End If
 End function
'－－－－－－－－－－－－－－－－－系列格式化－－－－－－－－－－－－－－－－－－－－－－－－

 '****************************************************
 '函數(shù)名：FormatSize
 '作  用：大小格式化
 '參  數(shù)：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

 '****************************************************
 '函數(shù)名：FormatTime
 '作  用：時(shí)間格式化
 '參  數(shù)：DateTime ----要格式化的時(shí)間
 '       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

'－－－－－－－－－－－－－－－－－－－－－－雜項(xiàng)－－－－－－－－－－－－－－－－－－－－－
    '****************************************************
 '函數(shù)名：Zodiac
 '作  用：取得生消
 '參  數(shù)：birthday ----生日
 '****************************************************
 public Function Zodiac(birthday)
  if IsDate(birthday) then
   birthyear=year(birthday)
   ZodiacList=array("猴","雞","狗","豬","鼠","牛","虎","兔","龍","蛇","馬","羊")  
   Zodiac=ZodiacList(birthyear mod 12)
  end if
 End Function

    '****************************************************
 '函數(shù)名：Constellation
 '作  用：取得星座
 '參  數(shù)：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='雙魚(yú)座 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

 '=================================================
 '函數(shù)名：autopage
 '作  用：長(zhǎng)文章自動(dòng)分頁(yè)
 '參  數(shù)：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>頁(yè)碼:</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&"非法操作！頁(yè)號(hào)超出！<a href=javascript:history.back(-1)><u>返回</u></a>"
    end if
   Else
    AutoPage=content
   end if
 End Function
End Class
%>