服务器之家:专注于服务器技术及软件下载分享
分类导航

PHP教程|ASP.NET教程|Java教程|ASP教程|编程技术|正则表达式|C/C++|IOS|C#|Swift|Android|JavaScript|易语言|

服务器之家 - 编程语言 - ASP教程 - 天枫常用的ASP函数封装如下

天枫常用的ASP函数封装如下

2019-09-25 10:18asp代码网 ASP教程

对于用asp开发网站的朋友可以借鉴下他的asp函数,方便学习与提高开发效率

代码如下:


<% 
'------------------------------------- 
'天枫ASP class v1.0,集常用asp函数于一体 
'天枫版权所有
'QQ:76994859 EMAIL:Chenshaobo@gmail.com 

'所有功能函数名如下: 
' StrLength(str) 取得字符串长度 
' CutStr(str,strlen) 字符串长度切割 
' CheckIsEmpty(tstr) 检测是否为空 
' isInteger(para) 整数检验 
' CheckName(str) 名字字符校验 
' CheckPassword(str) 密码检验 
' CheckEmail(email) 邮箱格式检验 
' Alert(msg,goUrl) 弹出对话框提示 
' GoBack(Str1,Str2,isback) 出错信息提示 
' Suc(str1,str2,url) 操作成功信息提示 
' ChkPost() 检测是否站外提交表单 
' PSql() 防止sql注入 
' FiltrateHtmlCode(Str) 防止生成HTML 
' HtmlCode(str) 过滤HTML 
' Replacehtml(tstr) 清滤HTML 
' GetIP() 获取客户端IP 
' GetBrowser 获取客户端浏览器信 
' GetSystem 获取客户端操作系统 
' GetUrl() 获取当前页面URL包含参数 
' CUrl()   获取当前页面URL 
' GetExtend 取得文件扩展名 
' CheckExist(table,fieldname,fieldcontent,isblur) 检测某个表中某个字段的内容是否存在 
' GetNum(table,fieldname,resulttype,args) 检测某个表某个字段有多少条,最大值 ,最小值等 
' GetFolderSize(Folderpath) 计算某个文件夹的大小 
' GetFileSize(Filename) 计算某个文件的大小 
' IsObjInstalled(strClassString) 检测组件是否安装 
' SendMail JMAIL发送邮件 
' ResponseCookies 写入cookies 
' CleanCookies 清除cookies 
' GetTimeover 取得程序页面执行时间 
' FormatSize 大小格式化 
' FormatTime 时间格式化 
' Zodiac 取得生肖 
' Constellation   取得星座 
'------------------------------------- 

Class Cls_fun 

'--------字符处理-------------------------- 

 '**************************************************** 
 '函数名:StrLength 
 '作  用:取得字符串长度(汉字为2) 
 '参  数:str ----字符串内容 
 '返回值:字符串长度 
 '**************************************************** 
 Public function StrLength(str) 
   Dim Rep,lens,i 
   Set rep=new regexp 
   rep.Global=true 
   rep.IgnoreCase=true 
   rep.Pattern="[\u4E00-\u9FA5\uF900-\uFA2D]" 
   For each i in rep.Execute(str) 
    lens=lens+1 
   Next 
   Set Rep=Nothing 
   lens=lens + len(str) 
   strLength=lens 
  End Function 

 '**************************************************** 
 '函数名:CutStr 
 '作  用:字符串长度切割,超过显示省略号 
 '参  数:str    ----字符串内容 
 '       strlen ------要显示的长度 
 '返回值:切割后字符串内容 
 '**************************************************** 
 Public Function CutStr(str,strlen) 
     Dim l,t,i,c 
     If str="" Then 
     cutstr="" 
     Exit Function 
     End If 
     str=Replace(Replace(Replace(Replace(Replace(str," "," "),""",Chr(34)),">",">"),"<","<"),"|","|") 
     l=Len(str) 
     t=0 
     For i=1 To l 
     c=Abs(Asc(Mid(str,i,1))) 
     If c>255 Then 
    t=t+2 
     Else 
    t=t+1 
     End If 
     If t>=strlen Then 
    cutstr=Left(str,i) & "..." 
    Exit For 
     Else 
    cutstr=str 
     End If 
     Next 
     cutstr=Replace(Replace(Replace(Replace(replace(cutstr," "," "),Chr(34),"""),">",">"),"<","<"),"|","|") 
  End Function 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

延伸 · 阅读

精彩推荐