asp好用的函数集

一些函数库共享给大家,希望能给初学者启示,给老手也有所帮助吧.

    先谢谢大家支持!

    <%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
    <%
    StartTime=timer() '程序执行时间检测

    '###############################################################
    '┌──VIBO───────────────────┐
    '│          VIBO STUDIO 版权所有          │
    '└───────────────────────┘
    ' Author:Vibo
    ' Email:vibo_cn@hotmail.com
    '----------------- Vibo ASP站点开发常用函数库 ------------------
    'OpenDB(vdata_url) -------------------- 打开数据库
    'getIp()  ------------------------------- 得到真实IP
    'getIPAdress(sip)------------------------ 查找ip对应的真实地址
    'IP2Num(sip) ---------------------------- 限制某段IP地址
    'chkFrom() ------------------------------ 防站外提交设定
    'getsys() ------------------------------- 操作系统检测
    'GetBrowser() --------------------------- 浏览器版本检测
    'GetSearcher() -------------------------- 识别搜索引擎
    '
    '---------------------- 数据过滤 ↓----------------------------
    'CheckStr(byVal ChkStr) ----------------- 检查无效字符
    'CheckSql() ----------------------------- 防止SQL注入

    'UnCheckStr(Str)------------------------- 检查非法sql命令
    'Checkstr(Str) -------------------------- ASP最新SQL防注入过滤涵数

    'HTMLEncode(reString) ------------------- 过滤转换HTML代码
    'DateToStr(DateTime,ShowType) ----------- 日期转换函数
    'Date2Chinese(iDate) -------------------- 获得ASP的中文日期字符串
    'lenStr(str) ---------------------------- 计算字符串长度（字节）

    'CreateArr(str) ------------------------- 生成二维数组
    'ShowRsArr(rsArr) ----------------------- 用表格显示记录集getrows生成的数组的表结构

    '---------------------- 外接组件使用函数↓------------------------
    'sendMail(to_Email,from_Email,from_Name,mail_Subject,mail_Body,mail_htmlBody) -----'Jmail组件发送邮件

    '-----------------------------------------系统检测函数↓------------------------------------------
    'IsValidUrl(url) ------------------------ 检测网页是否有效
    'getHTMLPage(filename) ------------------ 获取文件内容
    'CheckFile(FilePath) -------------------- 检查某一文件是否存在
    'CheckDir(FolderPath) ------------------- 检查某一目录是否存在
    'MakeNewsDir(foldername) ---------------- 根据指定名称生成目录
    'CreateHTMLPage(filename,FileData,C_mode) 生成文件

    'CheckBadWord(byVal ChkStr) ------------- 过滤脏字
    '###############################################################

    Dim ipData_url
    ipData_url="./Ip.mdb"

    Response.Write("--------------客户端信息检测------------"&"<br>")
    Response.Write(getsys()&"<br>")
    Response.Write(GetBrowser()&"<br>")
    Response.Write(GetSearcher()&"<br>")
    Response.Write("IP:"&getIp()&"<br>")
    Response.Write("来源:"&(getIPAdress(GetIp()))&"<br>")
    Response.Write("<br>")

    Response.Write("--------------数据提交检测--------------"&"<br>")
    if not chkFrom then
      Response.write("请不要从站外提交内容！"&"<br>")
        Response.end
    else
      Response.write("本站提交内容！"&"<br><br>")
    End if


    function OpenDB(vdata_url)
    '------------------------------打开数据库
    '使用:Conn = OpenDB("data/data.mdb")
      Dim vibo_Conn
      Set vibo_Conn= Server.CreateObject("ADODB.Connection")
      vibo_Conn.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(vdata_url)
      vibo_Conn.Open
      OpenDB=vibo_Conn
    End Function

    function getIp()
    '-----------------------得到真实IP
    userip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    If userip = "" Then userip = Request.ServerVariables("REMOTE_ADDR")
    getIp=userip
    End function

    Function getIPAdress(sip)
    '---------------------查找ip对应的真实地址
    Dim iparr,iprs,country,city
    If sip="127.0.0.1" then sip= "192.168.0.1"
    iparr=split(sip,".")
    sip=cint(iparr(0))*256*256*256+cint(iparr(1))*256*256+cint(iparr(2))*256+cint(iparr(3))-1
    Dim vibo_ipconn_STRING
    vibo_ipconn_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(ipData_url)
    Set iprs = Server.CreateObject("ADODB.Recordset")
    iprs.ActiveConnection = vibo_ipconn_STRING
    iprs.Source = "SELECT Top 1 city, country FROM address WHERE ip1 <=" & sip & " and " & sip & "<=ip2"
    iprs.CursorType = 0
    iprs.CursorLocation = 2
    iprs.LockType = 1
    iprs.Open()

    If iprs.bof and iprs.eof then
      country="未知地区"
      city=""
    Else
      country=iprs.Fields.Item("country").Value
      city=iprs.Fields.Item("city").Value
    End If
    getIPAdress=country&city
    iprs.Close()
    Set iprs = Nothing
    End Function

    Function IP2Num(sip)
    '--------------------限制某段IP地址

      dim str1,str2,str3,str4
      dim num
      IP2Num=0
      if isnumeric(left(sip,2)) then
            str1=left(sip,instr(sip,".")-1)
            sip=mid(sip,instr(sip,".")+1)
            str2=left(sip,instr(sip,".")-1)
            sip=mid(sip,instr(sip,".")+1)
            str3=left(sip,instr(sip,".")-1)
            str4=mid(sip,instr(sip,".")+1)
            num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
            IP2Num = num
      end if
    end function

    'userIPnum = IP2Num(Request.ServerVariables("REMOTE_ADDR"))
    'if userIPnum > IP2Num("192.168.0.0") and userIPnum < IP2Num("192.168.0.255") then
      'response.write ("<center>您的IP被禁止</center>")
      'response.end
    'end if


    Function chkFrom()
    '----------------------------防站外提交设定
        Dim server_v1,server_v2, server1, server2
        chkFrom=False
        server1=Cstr(Request.ServerVariables("HTTP_REFERER"))
        server2=Cstr(Request.ServerVariables("SERVER_NAME"))
        If Mid(server1,8,len(server2))=server2 Then chkFrom=True
    End Function
    'if not chkFrom then
        'Response.write("请不要从站外提交内容！")
        'Response.end
    'End if

    function getsys()
    '----------------------------------操作系统检测
    vibo_soft=Request.ServerVariables("HTTP_USER_AGENT")
    if instr(vibo_soft,"Windows NT 5.0") then
        msm="Win 2000"
    elseif instr(vibo_soft,"Windows NT 5.1") then
        msm="Win XP"
    elseif instr(vibo_soft,"Windows NT 5.2") then
        msm="Win 2003"
    elseif instr(vibo_soft,"4.0") then
        msm="Win NT"
    elseif instr(vibo_soft,"NT") then
        msm="Win NT"
    elseif instr(vibo_soft,"Windows CE") then
        msm="Windows CE"
    elseif instr(vibo_soft,"Windows 9") then
        msm="Win 9x"
    elseif instr(vibo_soft,"9x") then
        msm="Windows ME"
    elseif instr(vibo_soft,"98") then
        msm="Windows 98"
    elseif instr(vibo_soft,"Windows 95") then
        msm="Windows 95"
    elseif instr(vibo_soft,"Win32") then
        msm="Win32"
    elseif instr(vibo_soft,"unix") or instr(vibo_soft,"linux") or instr(vibo_soft,"SunOS") or instr(vibo_soft,"BSD") then
        msm="类Unix"
    elseif instr(vibo_soft,"Mac") then
        msm="Mac"
    else
        msm="Other"
    end if
    getsys=msm
    End Function

    function GetBrowser()
    '----------------------------------浏览器版本检测
    dim vibo_soft
    vibo_soft=Request.ServerVariables("HTTP_USER_AGENT")
    Browser="unknown"
    version="unknown"
    'vibo_soft="Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; TencentTraveler ; .NET CLR 1.1.4322)"
    If Left(vibo_soft,7) ="Mozilla" Then '有此标识为浏览器
                vibo_soft=Split(vibo_soft,";")
                If InStr(vibo_soft(1),"MSIE")>0 Then
                    Browser="Microsoft Internet Explorer "
                    version=Trim(Left(Replace(vibo_soft(1),"MSIE",""),6))
                ElseIf InStr(vibo_soft(4),"Netscape")>0 Then
                    Browser="Netscape "
                    tmpstr=Split(vibo_soft(4),"/")
                    version=tmpstr(UBound(tmpstr))
                ElseIf InStr(vibo_soft(4),"rv:")>0 Then
                    Browser="Mozilla "
                    tmpstr=Split(vibo_soft(4),":")
                    version=tmpstr(UBound(tmpstr))
                    If InStr(version,")") > 0 Then
                        tmpstr=Split(version,")")
                        version=tmpstr(0)
                    End If
                End If
    ElseIf Left(vibo_soft,5) ="Opera" Then
                vibo_soft=Split(vibo_soft,"/")
                Browser="Mozilla "
                tmpstr=Split(vibo_soft(1)," ")
                version=tmpstr(0)
    End If
    If version<>"unknown" Then
                Dim Tmpstr1
                Tmpstr1=Trim(Replace(version,".",""))
                If Not IsNumeric(Tmpstr1) Then
                    version="unknown"
                End If
    End If
    GetBrowser=Browser &" "& version
    End function

    function GetSearcher()
    '----------------------识别搜索引擎
    Dim botlist,Searcher
    Dim vibo_soft
    vibo_soft=Request.ServerVariables("HTTP_USER_AGENT")

    Botlist="Google,Isaac,SurveyBot,Baiduspider,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir,TencentTraveler"
    Botlist=split(Botlist,",")
      For i=0 to UBound(Botlist)
      If InStr(vibo_soft,Botlist(i))>0  Then
         Searcher=Botlist(i)&" 搜索器"
         IsSearch=True
         Exit For
      End If
      Next
    If IsSearch Then
      GetSearcher=Searcher
    else
      GetSearcher="unknown"
    End if
    End function


    '----------------------------------数据过滤 ↓---------------------------------------
    Function CheckSql() '防止SQL注入
        Dim sql_injdata
        SQL_injdata = "'|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare"
        SQL_inj = split(SQL_Injdata,"|")
        If Request.QueryString<>"" Then
            For Each SQL_Get In Request.QueryString
                For SQL_Data=0 To Ubound(SQL_inj)
                    if instr(Request.QueryString(SQL_Get),Sql_Inj(Sql_DATA))>0 Then
                        Response.Write "<Script Language='javascript'>{alert('请不要在参数中包含非法字符！');history.back(-1)}</Script>"
                        Response.end
                    end if
                next
            Next
        End If
        If Request.Form<>"" Then
            For Each Sql_Post In Request.Form
                For SQL_Data=0 To Ubound(SQL_inj)
                    if instr(Request.Form(Sql_Post),Sql_Inj(Sql_DATA))>0 Then
                        Response.Write "<Script Language='javascript'>{alert('请不要在参数中包含非法字符！');history.back(-1)}    </Script>"
                        Response.end
                    end if
                next
            next
        end if
    End Function

    Function CheckStr(byVal ChkStr) '检查无效字符
        Dim Str:Str=ChkStr
        Str=Trim(Str)
        If IsNull(Str) Then
            CheckStr = ""
            Exit Function
        End If
        Dim re
        Set re=new RegExp
        re.IgnoreCase =True
        re.Global=True
        re.Pattern="(\r\n){3,}"
        Str=re.Replace(Str,"$1$1$1")
        Set re=Nothing
        Str = Replace(Str,"'","''")
        Str = Replace(Str, "select", "select")
        Str = Replace(Str, "join", "join")
        Str = Replace(Str, "union", "union")
        Str = Replace(Str, "where", "where")
        Str = Replace(Str, "insert", "insert")
        Str = Replace(Str, "delete", "delete")
        Str = Replace(Str, "update", "update")
        Str = Replace(Str, "like", "like")
        Str = Replace(Str, "drop", "drop")
        Str = Replace(Str, "create", "create")
        Str = Replace(Str, "modify", "modify")
        Str = Replace(Str, "rename", "rename")
        Str = Replace(Str, "alter", "alter")
        Str = Replace(Str, "cast", "cast")
        CheckStr=Str
    End Function

    Function UnCheckStr(Str) '检查非法sql命令
            Str = Replace(Str, "select", "select")
            Str = Replace(Str, "join", "join")
            Str = Replace(Str, "union", "union")
            Str = Replace(Str, "where", "where")
            Str = Replace(Str, "insert", "insert")
            Str = Replace(Str, "delete", "delete")
            Str = Replace(Str, "update", "update")
            Str = Replace(Str, "like", "like")
            Str = Replace(Str, "drop", "drop")
            Str = Replace(Str, "create", "create")
            Str = Replace(Str, "modify", "modify")
            Str = Replace(Str, "rename", "rename")
            Str = Replace(Str, "alter", "alter")
            Str = Replace(Str, "cast", "cast")
            UnCheckStr=Str
    End Function

    Function Checkstr(Str) 'SQL防注入过滤涵数
        If Isnull(Str) Then
        CheckStr = ""
        Exit Function
        End If
        Str = Replace(Str,Chr(0),"", 1, -1, 1)
        Str = Replace(Str, """", """", 1, -1, 1)
        Str = Replace(Str,"<","<", 1, -1, 1)
        Str = Replace(Str,">",">", 1, -1, 1)
        Str = Replace(Str, "script", "script", 1, -1, 0)
        Str = Replace(Str, "SCRIPT", "SCRIPT", 1, -1, 0)
        Str = Replace(Str, "Script", "Script", 1, -1, 0)
        Str = Replace(Str, "script", "Script", 1, -1, 1)
        Str = Replace(Str, "object", "object", 1, -1, 0)
        Str = Replace(Str, "OBJECT", "OBJECT", 1, -1, 0)
        Str = Replace(Str, "Object", "Object", 1, -1, 0)
        Str = Replace(Str, "object", "Object", 1, -1, 1)
        Str = Replace(Str, "applet", "applet", 1, -1, 0)
        Str = Replace(Str, "APPLET", "APPLET", 1, -1, 0)
        Str = Replace(Str, "Applet", "Applet", 1, -1, 0)
        Str = Replace(Str, "applet", "Applet", 1, -1, 1)
        Str = Replace(Str, "[", "[")
        Str = Replace(Str, "]", "]")
        Str = Replace(Str, """", "", 1, -1, 1)
        Str = Replace(Str, "=", "=", 1, -1, 1)
        Str = Replace(Str, "'", "''", 1, -1, 1)
        Str = Replace(Str, "select", "select", 1, -1, 1)
        Str = Replace(Str, "execute", "execute", 1, -1, 1)
        Str = Replace(Str, "exec", "exec", 1, -1, 1)
        Str = Replace(Str, "join", "join", 1, -1, 1)
        Str = Replace(Str, "union", "union", 1, -1, 1)
        Str = Replace(Str, "where", "where", 1, -1, 1)
        Str = Replace(Str, "insert", "insert", 1, -1, 1)
        Str = Replace(Str, "delete", "delete", 1, -1, 1)
        Str = Replace(Str, "update", "update", 1, -1, 1)
        Str = Replace(Str, "like", "like", 1, -1, 1)
        Str = Replace(Str, "drop", "drop", 1, -1, 1)
        Str = Replace(Str, "create", "create", 1, -1, 1)
        Str = Replace(Str, "rename", "rename", 1, -1, 1)
        Str = Replace(Str, "count", "count", 1, -1, 1)
        Str = Replace(Str, "chr", "chr", 1, -1, 1)
        Str = Replace(Str, "mid", "mid", 1, -1, 1)
        Str = Replace(Str, "truncate", "truncate", 1, -1, 1)
        Str = Replace(Str, "nchar", "nchar", 1, -1, 1)
        Str = Replace(Str, "char", "char", 1, -1, 1)
        Str = Replace(Str, "alter", "alter", 1, -1, 1)
        Str = Replace(Str, "cast", "cast", 1, -1, 1)
        Str = Replace(Str, "exists", "exists", 1, -1, 1)
        Str = Replace(Str,Chr(13),"<br>", 1, -1, 1)
        CheckStr = Replace(Str,"'","''", 1, -1, 1)
    End Function

    Function HTMLEncode(reString) '过滤转换HTML代码
        Dim Str:Str=reString
        If Not IsNull(Str) Then
            Str = UnCheckStr(Str)
            Str = Replace(Str, "&", "&")
            Str = Replace(Str, ">", ">")
            Str = Replace(Str, "<", "<")
            Str = Replace(Str, CHR(32), " ")
          Str = Replace(Str, CHR(9), "    ")
            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), "<br>")
            HTMLEncode = Str
        End If
    End Function

    Function DateToStr(DateTime,ShowType)  '日期转换函数
        Dim DateMonth,DateDay,DateHour,DateMinute
        DateMonth=Month(DateTime)
        DateDay=Day(DateTime)
        DateHour=Hour(DateTime)
        DateMinute=Minute(DateTime)
        If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
        If Len(DateDay)<2 Then DateDay="0"&DateDay
        Select Case ShowType
        Case "Y-m-d"
            DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
        Case "Y-m-d H:I A"
            Dim DateAMPM
            If DateHour>12 Then
                DateHour=DateHour-12
                DateAMPM="PM"
            Else
                DateHour=DateHour
                DateAMPM="AM"
            End If
            If Len(DateHour)<2 Then DateHour="0"&DateHour
            If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
            DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM
        Case "Y-m-d H:I:S"
            Dim DateSecond
            DateSecond=Second(DateTime)
            If Len(DateHour)<2 Then DateHour="0"&DateHour
            If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
            If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
            DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
        Case "YmdHIS"
            DateSecond=Second(DateTime)
            If Len(DateHour)<2 Then DateHour="0"&DateHour
            If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
            If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
            DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond
        Case "ym"
            DateToStr=Right(Year(DateTime),2)&DateMonth
        Case "d"
            DateToStr=DateDay
        Case Else
            If Len(DateHour)<2 Then DateHour="0"&DateHour
            If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
            DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
        End Select
    End Function

    Function Date2Chinese(iDate) '获得ASP的中文日期字符串
    　　 Dim num(10)
    　　 Dim iYear
    　　 Dim iMonth
    　　 Dim iDay

    　　 num(0) = "〇"
    　　 num(1) = "一"
    　　 num(2) = "二"
    　　 num(3) = "三"
    　　 num(4) = "四"
    　　 num(5) = "五"
    　　 num(6) = "六"
    　　 num(7) = "七"
    　　 num(8) = "八"
    　　 num(9) = "九"

    　　 iYear = Year(iDate)
    　　 iMonth = Month(iDate)
    　　 iDay = Day(iDate)
    　　 Date2Chinese = num(iYear \ 1000) + num((iYear \ 100) Mod 10) + num((iYear\ 10) Mod 10) + num(iYear Mod 10) + "年"
    　　 If iMonth >= 10 Then
    　　　　 If iMonth = 10 Then
    　　　　　　 Date2Chinese = Date2Chinese + "十" + "月"
    　　　　 Else
    　　　　　　 Date2Chinese = Date2Chinese + "十" + num(iMonth Mod 10) + "月"
    　　　　 End If
    　　 Else
    　　　　 Date2Chinese = Date2Chinese + num(iMonth Mod 10) + "月"
    　　 End If
    　　 If iDay >= 10 Then
    　　　　 If iDay = 10 Then
    　　　　　　 Date2Chinese = Date2Chinese +"十" + "日"
    　　　　 ElseIf iDay = 20 Or iDay = 30 Then
    　　　　　　 Date2Chinese = Date2Chinese + num(iDay \ 10) + "十" + "日"
    　　　　 ElseIf iDay > 20 Then
    　　　　　　 Date2Chinese = Date2Chinese + num(iDay \ 10) + "十" +num(iDay Mod 10) + "日"
    　　　　 Else
    　　　　　　 Date2Chinese = Date2Chinese + "十" + num(iDay Mod 10) + "日"
    　　　　 End If
    　　 Else
    　　　　 Date2Chinese = Date2Chinese + num(iDay Mod 10) + "日"
    　　 End If
    End Function


    Function lenStr(str)'计算字符串长度（字节）
        dim l,t,c
        dim i
        l=len(str)
        t=0
    for i=1 to l
        c=asc(mid(str,i,1))
        if c<0 then c=c+65536
      if c<255 then t=t+1
        if c>255 then t=t+2
    next
      lenstr=t
    End Function

    Function CreateArr(str) '生成二维数组数据如："1,a1,b1,c1,d1|2,a2,b2,c2,d2|5,a3,b3,c3,d3|8,a4,b4,c4,d4"
    dim arr()
    str=split(str,"|")
    for i=0 to UBound(str)
        arrstr=split(str(i),",")
        for j=0 to Ubound(arrstr)
            ReDim Preserve arr(UBound(str),UBound(arrstr))
            arr(i,j)=arrstr(j)
        next
    next
    CreateArr=arr
    End Function

[1] [2]

Function ShowRsArr(rsArr) '用表格显示记录集getrows生成的数组的表结构
    showHtml="<table width=100% border=1 cellspacing=0 cellpadding=0>"
        If Not IsEmpty(rsArr) Then
            For y=0 To Ubound(rsArr,2)
            showHtml=showHtml&"<tr>"
                for x=0 to Ubound(rsArr,1)
                    showHtml=showHtml& "<td>"&rsArr(x,y)&"</td>"
                next
            showHtml=showHtml&"</tr>"
            next
        Else
            RshowHtml=showHtml&"<tr>"
            showHtml=showHtml&"<td>No Records</td>"
            showHtml=showHtml&"</tr>"
        End If
            showHtml=showHtml&"</table>"
        ShowRsArr=showHtml
    End Function


    '-----------------------------------------外接组件使用函数↓------------------------------------------

    Function sendMail(to_Email,from_Email,from_Name,mail_Subject,mail_Body,mail_htmlBody) 'Jmail 发送邮件
      Set vibo_mail = Server.CreateObject("JMAIL.Message") '建立发送邮件的对象
      vibo_mail.silent = true                               '屏蔽例外错误，返回FALSE跟TRUE两值j
      vibo_mail.logging = true                               '启用邮件日志
      vibo_mail.Charset = "gb2312"                         '邮件的文字编码为国标

      'vibo_mail.ContentType = "text/html"                   '邮件的格式为HTML格式
      'vibo_mail.Prority = 1                                  '邮件的紧急程序，1 为最快，5 为最慢， 3 为默认值

      vibo_mail.AddRecipient to_Email                      '邮件收件人的地址
      vibo_mail.From = from_Email                            '发件人的E-MAIL地址
      vibo_mail.FromName = from_Name                         '发件人姓名
      vibo_mail.MailServerUserName = "system@aaa.com"    '登录邮件服务器所需的用户名
      vibo_mail.MailServerPassword = "asdasd"    '登录邮件服务器所需的密码
      vibo_mail.Subject = mail_Subject                      '邮件的标题
      vibo_mail.Body = mail_Body                            '正文
      vibo_mail.HTMLBody = mail_htmlBody                   'HTML正文
      vibo_mail.ReturnReceipt = True
      vibo_mail.Send("smtp.263xmail.com")                   '执行邮件发送（通过邮件服务器地址）
      vibo_mail.Close()
      set vibo_mail=nothing
    End Function

    '---------------------------------------程序执行时间检测↓----------------------------------------------
    EndTime=Timer()
    If EndTime<StartTime Then
      EndTime=EndTime+24*3600
    End if
    runTime=(EndTime-StartTime)*1000
    Response.Write("------------程序执行时间检测------------"&"<br>")
    Response.Write("程序执行时间"&runTime&"毫秒")


    '-----------------------------------------系统检测使用函数↓------------------------------------------
    '---------------------检测网页是否有效-----------------------
    Function IsValidUrl(url)
            Set xl = Server.CreateObject("Microsoft.XMLHTTP")
            xl.Open "HEAD",url,False
            xl.Send
            IsValidUrl = (xl.status=200)
    End Function
    'If IsValidUrl(""&fileurl&"") Then
    '    response.redirect fileurl
    'Else
    '    Response.Write "由于下载用户过多,程序检测到文件暂时无法下载,请更换其他下载地址!感谢您对本软件网站的支持哦^_^"
    'End If
    '------------------检查某一目录是否存在-------------------

    Function getHTMLPage(filename) '获取文件内容
        Dim fso,file
      Set fso = Server.CreateObject("Scripting.FileSystemObject")
      Set File=fso.OpenTextFile(server.mappath(filename))
      showHtml=File.ReadAll
      File.close
      Set File=nothing
      Set fso=nothing
        getHTMLPage=showHtml '输出
    End function

    Function CheckDir(FolderPath)
      dim fso
      folderpath=Server.MapPath(".")&"\"&folderpath
      Set fso = Server.CreateObject("Scripting.FileSystemObject")
      If fso.FolderExists(FolderPath) then
      '存在
            CheckDir = True
      Else
      '不存在
            CheckDir = False
      End if
      Set fso = nothing
    End Function

    Function CheckFile(FilePath) '检查某一文件是否存在
      Dim fso
      Filepath=Server.MapPath(FilePath)
      Set fso = Server.CreateObject("Scripting.FileSystemObject")
      If fso.FileExists(FilePath) then
      '存在
            CheckFile = True
      Else
      '不存在
            CheckFile = False
      End if
      Set fso = nothing
    End Function

    '-------------根据指定名称生成目录---------
    Function MakeNewsDir(foldername)
      dim fso,f
      Set fso = Server.CreateObject("Scripting.FileSystemObject")
      Set f = fso.CreateFolder(foldername)
      MakeNewsDir = True
      Set fso = nothing
    End Function

    Function CreateHTMLPage(filename,FileData,C_mode) '生成文件
        if C_mode=0 then '使用FSO生成
            Dim fso,txt
            Set fso = CreateObject("Scripting.FileSystemObject")
            Filepath=Server.MapPath(filename)
            if CheckFile(filename) then fso.DeleteFile Filepath,True '防止续写
            Set txt=fso.OpenTextFile(Filepath,8,True)
            txt.Write FileData
            txt.Close
            Set fso = nothing
        elseif C_mode=1 then '使用Stream生成
            Dim viboStream
            On Error Resume Next
            Set viboStream = Server.createObject("ADODB.Stream")

            If Err.Number=-2147221005 Then
                Response.Write "<div align='center' style=""font-size:12px;font-family:Tahoma;"">非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
                Err.Clear
                Response.End
          End If

          With viboStream
            .Type = 2
            .Open
            .CharSet = "GB2312"
            .Position = objStream.Size
            .WriteText = FileData
            .SaveToFile Server.MapPath(filename),2
            .Close
          End With
          Set viboStream = Nothing
        end if
        Response.Write "<div align='center' style=""font-size:12px;font-family:Tahoma;"">恭喜!文件 <a href="""&filename&""" target=""_blank"" style=""font-weight: bold;color: #FF0000;"">"&filename&"</a> 已经生成完毕!...</div>"
        Response.Flush()
    End Function

    Function CheckBadWord(byVal ChkStr)'过滤脏字
        Dim Str:Str = ChkStr
        Str = Trim(Str)
        If IsNull(Str) Then
            CheckBadWord = ""
            Exit Function
        End If

        DIC = getHTMLPage("include/badWord.txt")'载入脏字词典
        DICArr = split(DIC,CHR(10))
        For i  =0 To Ubound(DICArr )
            WordDIC = split(DICArr(i),"=")
            Str = Replace(Str,WordDIC(0),WordDIC(1))
        next
        CheckBadWord = Str
    End function
    %>

上一页 [1] [2]

更多的asp好用的函数集请到论坛查看: http://BBS.TC711.COM

【双击滚屏】【评论】【收藏】【打印】【关闭】来源：互联网日期：2007-1-13