旅途笔记

岂有豪情似旧时,花开花落两由之
  博客园  :: 首页  :: 新随笔  :: 联系 :: 订阅 订阅  :: 管理

asp常用函数

Posted on 2008-02-28 15:53  allonkwok  阅读(322)  评论(0编辑  收藏  举报
'-------------------------------------


'所有功能函数名如下:
'
 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;","<"),"|","|")
     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;"),"|","|")
  
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 & "');"&goUrl&vbNewLine&"</script>")
  Response.End
End Function

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

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

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

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

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

    
'****************************************************
'
函数名:FiltrateHtmlCode
'
作  用:防止生成html代码 
'
参  数:str ----字符串
'
****************************************************
Public Function FiltrateHtmlCode(Str)
  
If Not isnull(str) And str<>"" then
   Str
=Replace(Str,Chr(9),"")
   Str
=replace(Str,"|","|")
   Str
=replace(Str,chr(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), "'")
   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,"")
   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, 6true)
   getTimeOver 
= " 本页执行时间: " & EndTime & " 秒"
  
Else
   EndTime
=FormatNumber((Timer() - StartTime) * 10003true)
   getTimeOver 
=" 本页执行时间: " & EndTime & " 毫秒"
  
End If
End function
'-----------------系列格式化------------------------

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

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

'----------------------杂项---------------------
    '****************************************************
'
函数名:Zodiac
'
作  用:取得生消
'
参  数:birthday ----生日
'
****************************************************
public Function Zodiac(birthday)
  
if IsDate(birthday) then
   birthyear
=year(birthday)
   ZodiacList
=array("","","","","","","","","","","","")  
   Zodiac
=ZodiacList(birthyear mod 12)
  
end if
End Function

    
'****************************************************
'
函数名:Constellation
'
作  用:取得星座
'
参  数:birthday ----生日
'
****************************************************
public Function Constellation(birthday)
  
if IsDate(birthday) then
   ConstellationMon
=month(birthday)
   ConstellationDay
=day(birthday)
   
if Len(ConstellationMon)<2 then ConstellationMon="0"&ConstellationMon
   
if Len(ConstellationDay)<2 then ConstellationDay="0"&ConstellationDay
   MyConstellation
=ConstellationMon&ConstellationDay
   
if MyConstellation < 0120 then
    constellation
="<img src=images/Constellation/g.gif title='魔羯座 Capricorn'>"
   
elseif MyConstellation < 0219 then
    constellation
="<img src=images/Constellation/h.gif title='水瓶座 Aquarius'>"
   
elseif MyConstellation < 0321 then
    constellation
="<img src=images/Constellation/i.gif title='双鱼座 Pisces'>"
   
elseif MyConstellation < 0420 then
    constellation
="<img src=images/Constellation/^.gif title='白羊座 Aries'>"
   
elseif MyConstellation < 0521 then
    constellation
="<img src=images/Constellation/_.gif title='金牛座 Taurus'>"
   
elseif MyConstellation < 0622 then
    constellation
="<img src=images/Constellation/`.gif title='双子座 Gemini'>"
   
elseif MyConstellation < 0723 then
    constellation
="<img src=images/Constellation/a.gif title='巨蟹座 Cancer'>"
   
elseif MyConstellation < 0823 then
    constellation
="<img src=images/Constellation/b.gif title='狮子座 Leo'>"
   
elseif MyConstellation < 0923 then
    constellation
="<img src=images/Constellation/c.gif title='处女座 Virgo'>"
   
elseif MyConstellation < 1024 then
    constellation
="<img src=images/Constellation/d.gif title='天秤座 Libra'>"
   
elseif MyConstellation < 1122 then
    constellation
="<img src=images/Constellation/e.gif title='天蝎座 Scorpio'>"
   
elseif MyConstellation < 1222 then
    constellation
="<img src=images/Constellation/f.gif title='射手座 Sagittarius'>"
   
elseif MyConstellation > 1221 then
    constellation
="<img src=images/Constellation/g.gif title='魔羯座 Capricorn'>"
   
end if
  
end if
End Function

'=================================================
'
函数名:autopage
'
作  用:长文章自动分页
'
参  数:id,content,urlact
'
=================================================
Function AutoPage(content,paramater,pagevar)
   contentStr
=split(content,pagevar) 
   pagesize
=ubound(contentStr)
   
if pagesize>0 then
    
If Int(Request("page"))="" or Int(Request("page"))=0 Then 
     pageNum
=1 
    
Else 
     pageNum
=Request("page"
    
End if 
    
if pageNum-1<=pagesize then
     AutoPage
=AutoPage&contentStr(pageNum-1)
     AutoPage
=AutoPage&"<div style=""margin-top:10px;text-align:right;padding-right:15px;""><font color=blue>页码:</font><font color=red>"
     
For i=0 to pagesize 
      
if i=pageNum-1 then 
       AutoPage
=AutoPage&"[<font color=red>"&i+1&"</font>] "
      
else 
       
if instr(paramater,"?")>0 then
        AutoPage
=AutoPage&"<a href="""&paramater&"&page="&i+1&""">["&(i+1)&"]</a>"
       
else
        AutoPage
=AutoPage&"<a href="""&paramater&"?page="&i+1&""">["&(i+1)&"]</a>"
       
end if
      
end if  
     
Next 
     AutoPage
=AutoPage&"</font></div>"
    
else
     AutoPage
=AutoPage&"非法操作!页号超出!<a href=javascript:history.back(-1)><u>返回</u></a>"
    
end if
   
Else
    AutoPage
=content
   
end if
End Function
End Class