ASP函数集(2)

继续上面的
15.打开Access数据库
<%
Function DbOpen()
Dim connStr
Set Conn = server.createobject("adodb.connection")
ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source ="& Server.MapPath(DBPath)
Conn.Open connStr'"DS_mincn.com"
DBSTATE = 1
End Function
%>


16.关闭数据库

<%
Function Dbclose()
Conn.Close()
Set Conn = Nothing
DBSTATE = 0
End Function
%>


17.FSO读取文件

<%
Function ReadFile(LocalFilePath)
Dim ObjFile,FSO_Temlet,FSO_Stream,TruePath
TruePath = Server.MapPath(LocalFilePath)
Set ObjFile=Server.CreateObject("Scripting.FileSystemObject")
If ObjFile.FileExists(TruePath) Then
  Set FSO_Temlet = ObjFile.GetFile(TruePath)
  Set FSO_Stream = FSO_Temlet.OpenAsTextStream(1)
  ReadFile = FSO_Stream.ReadAll
  Set FSO_Temlet = Nothing
  Set FSO_Stream = Nothing
Else
  ReadFile = "FileNotFound"&TruePath
End If
Set ObjFile = Nothing
End Function
%>


18.中断函数

<%
Function Break(ErrInfo,DbOff,ToErrCenter)
If DbOff = 1 Then DBClose()
If ToErrCenter = 1 Then
  Response.Redirect("ShowError.asp?msg="&Server.URLEncode(ErrorArr(0)))
  Response.End()
Else
  Response.Write "

"& ErrInfo &"

"
  Response.End()
End If
End Function

%>


19.用Jmail组件发送邮件
<%
'****************************************************
'函数名:SendMail
'作 用:用Jmail组件发送邮件
'参 数:MailtoAddress ----收信人地址
' MailtoName -----收信人姓名
' Subject -----主题
' MailBody -----信件内容
' FromName -----发信人姓名
' MailFrom -----发信人地址
' Priority -----信件优先级
'****************************************************
function SendMail(MailtoAddress,MailtoName,Subject,MailBody,FromName,MailFrom,Priority)
    on error resume next
    Dim JMail
    Set JMail=Server.CreateObject("JMail.Message")
    if err then
        SendMail= "
  • 没有安装JMail组件
  • "
            err.clear
            exit function
        end if
        JMail.Charset="gb2312" '邮件编码
        JMail.silent=true
        JMail.ContentType = "text/html" '邮件正文格式
        'JMail.ServerAddress=MailServer '用来发送邮件的SMTP服务器
        '如果服务器需要SMTP身份验证则还需指定以下参数
        JMail.MailServerUserName = MailServerUserName '登录用户名
        JMail.MailServerPassWord = MailServerPassword '登录密码
        JMail.MailDomain = MailDomain '域名(如果用“name@domain.com”这样的用户名登录时,请指明domain.com
        JMail.AddRecipient MailtoAddress,MailtoName '收信人
        JMail.Subject=Subject '主题
        JMail.HMTLBody=MailBody '邮件正文(HTML格式)
        JMail.Body=MailBody '邮件正文(纯文本格式)
        JMail.FromName=FromName '发信人姓名
        JMail.From = MailFrom '发信人Email
        JMail.Priority=Priority '邮件等级,1为加急,3为普通,5为低级
        JMail.Send(MailServer)
        SendMail =JMail.ErrorMessage
        JMail.Close
        Set JMail=nothing
    end function
    %>


    20.处理含有?和&的网址
    <%
    ***********************************************
    '函数名:JoinChar
    '作 用:向地址中加入 ? 或 &
    '参 数:strUrl ----网址
    '返回值:加了 ? 或 & 的网址
    '***********************************************
    function JoinChar(strUrl)
        if strUrl="" then
            JoinChar=""
            exit function
        end if
        if InStr(strUrl,"?")        if InStr(strUrl,"?")>1 then
                if InStr(strUrl,"&")                JoinChar=strUrl & "&"
                else
                    JoinChar=strUrl
                end if
            else
                JoinChar=strUrl & "?"
            end if
        else
            JoinChar=strUrl
        end if
    end function
    %>


    21.生成静态页面

    <%
    '=================================================
    '过程名:savestaticpage
    '作 用:保存为静态页面
    '参 数:from——地址,tofile——文件名
    '=================================================
    sub savestaticpage(from,tofile)
        set fso=Server.CreateObject("Scripting.FileSystemObject"
        PostUrl="http://"& host && ... ot; & from
        Rvalue=SendToSp(PostUrl)
        Rvalue=Bytes2bStr(Rvalue)
        if Rvalue="" then
            if err then
                WriteErrMsg(err.description)
            end if
            response.End()
        end if
        Set hf = fso.CreateTextFile(tofile, True)
        hf.Write Rvalue
        hf.Close
        set hf=nothing
        set fso=nothing
    end sub
    '读取URL接口
    Function SendToSp(PostUrl)
        IsSuccess=""
        Set xml = Server.CreateObject("Microsoft.XMLHTTP" )
        xml.Open "GET",PostUrl,False
        xml.Send
        'if xml.readystate<>4 then
        '    WriteErrMsg("更新页面失败,可能是服务器故障,请稍后在试!!!"
        '    SendToSp=""
        '    exit function
        'end if
        IsSuccess= xml.Responsebody
        Set xml = Nothing
        SendToSp = IsSuccess
    End Function

    Const adTypeBinary = 1
    Const adTypeText = 2

    '转换接口值为字符串
    Function Bytes2bStr(vin)
    Dim BytesStream,StringReturn

    Set BytesStream = Server.CreateObject("ADODB.Stream")
    With BytesStream
    .Type=adTypeText
    .Open
    .WriteText vin
    .Position = 0
    .Charset = "GB2312" )
    .Position = 2
    StringReturn = .ReadText
    .close
    End With
    Set BytesStream = Nothing
    Bytes2bStr = StringReturn
    End Function

    %>


    22.过滤非法字符

    <%
    '**************************************************
    '函数名:ReplaceBadChar
    '作 用:过滤非法的SQL字符
    '参 数:strChar-----要过滤的字符
    '返回值:过滤后的字符
    '**************************************************
    Function Checkstr(Str)
    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),"
    ", 1, -1, 1)
    CheckStr = Replace(Str,"'","''", 1, -1, 1)
    end function
    %>


    上一篇: ASP函数集
    下一篇: ASP函数集(3)
    文章来自: 本站原创
    引用通告: 查看所有引用 | 我要引用此文章
    Tags:
    相关日志:
    评论: 2 | 引用: 607 | 查看次数: 33592
    发表评论
    昵 称:
    密 码: 游客发言不需要密码.
    邮 箱: 邮件地址支持Gravatar头像,邮箱地址不会公开.
    网 址: 输入网址便于回访.
    内 容:
    验证码:
    选 项:
    虽然发表评论不用注册,但是为了保护您的发言权,建议您注册帐号.
    字数限制 30 字 | UBB代码 关闭 | [img]标签 关闭