当前位置:首页 > 编程学习 > 常用asp函数

常用asp函数

编程学习2008-02-0419370


<%
'-------------------------------------
'所有功能函数名如下:
' 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="[\一-\龥\?-\?]"
    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_一-\龥][\w\一-\龥]+$"
    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,"|","&#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=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="""&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
     
    AutoPage=content
End Function


扫描二维码推送至手机访问。

版权声明:本文由海阔天空发布,如需转载请注明出处。

本文链接:https://www.apull.net/html/20080204101.html

分享给朋友:

相关文章

MD5加密VB版

MD5加密VB版

'MD5加密VB版 '调用方法:str=MD5("Apull",32),就能得到"Apull"的32位的MD5。 Private m_lOnBits(30) Private m_l2Power(30) Private Const BITS_TO_A_BYTE = 8 Private Const BYTES_TO_A_WORD = 4 Private Const BITS_TO_A_WORD = 32 Private Fu...

用VB类实现文件对话框

用VB类实现文件对话框

用VB类实现文件对话框'类名:ComDlg.cls '作用:文件打开保存对话框 ' ' ' 'By:Apull '2007-5-21 'http://www.apull.net Option Explicit Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _ pOpenfil...

ASP错误提示大全

ASP错误提示大全

Microsoft VBScript 语法错误(0×800A03E9)–>内存不足Microsoft VBScript 语法错误(0×800A03EA)–>语法错误Microsoft VBScript 语法错误(0×800A03EB)–>缺少’:’Microsoft VBScript 语法错误(0×800A03ED)–>缺少’(’Mi...

[转].NET实现中英文验证码

[转].NET实现中英文验证码

最终效果如图:  CheckCode.aspx.cs代码如下protected void Page_Load(object sender, EventArgs e) { //获取GB2312编码页(表) /**//** * 生成中文验证验码所要使用的方法 * 注,生成中文验证码时要改变一下生成验证码图片的宽度 * var imageCode = new System.Drawing.Bitmap((int)Math....

发表评论

访客

看不清,换一张

◎欢迎参与讨论,请在这里发表您的看法和观点。