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:
相关日志: