安全

<%
'过滤SQL非法字符并格式化html代码
function Replace_Text(fString)
if isnull(fString) then
Replace_Text=""
exit function
else
fString=trim(fString)
fString=replace(fString,"'","''")
fString=replace(fString,";","；")
fString=replace(fString,"--","—")
fString=server.htmlencode(fString)
Replace_Text=fString
end if 
end function

'会员发布的各种信息过滤
Function changechr(fString)
If Not IsNull(fString) Then
fString = trim(fString)
'fString = replace(fString, ";", "；")    '分号过滤
fString = replace(fString, "--", "——") '--过滤
fString = replace(fString, "%20", "")   '特殊字符过滤
fString = replace(fString, "==", "")    '==过滤
'fString = replace(fString, ">", "&gt;")
'fString = replace(fString, "<", "&lt;")
fString = Replace(fString, CHR(32), " ")  '&nbsp;
fString = Replace(fString, CHR(9), " ")   '&nbsp;
fString = Replace(fString, CHR(34), "&quot;")
fString = Replace(fString, CHR(39), "&#39;") '单引号过滤
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
changechr = fString
End If
End Function

'过滤SQL非法字符
Function checkStr(Chkstr)
 dim Str:Str=Chkstr
 if isnull(Str) then
  checkStr = ""
  exit Function
 else
  Str=replace(Str,"'","")
  Str=replace(Str,";","")
  Str=replace(Str,"--","")
  checkStr=Str
 end if
End Function

'检测传递的参数是否为数字型
Function Chkrequest(Para)
Chkrequest=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
   Chkrequest=True
End If
End Function

'检测传递的参数是否为日期型
Function Chkrequestdate(Para)
Chkrequestdate=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsDate(Para)) Then
   Chkrequestdate=True
End If
End Function

'得到当前页面的地址
Function GetUrl()
On Error Resume Next
Dim strTemp
If LCase(Request.ServerVariables("HTTPS")) = "off" Then
strTemp = "http://"
Else
strTemp = "https://"
End If
strTemp = strTemp & CheckStr(Request.ServerVariables("SERVER_NAME"))
If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & CheckStr(Request.ServerVariables("SERVER_PORT"))
strTemp = strTemp & CheckStr(Request.ServerVariables("URL"))
If Trim(Request.QueryString) <> "" Then strTemp = strTemp & "?" & CheckStr(Trim(Request.QueryString))
GetUrl = strTemp 
End Function

'检查用户是否在浏览器里输入了本页的地址
Function CheckReferer()
    Dim sReferer, Icheck
    CheckReferer = True
    sReferer = Request.ServerVariables("HTTP_REFERER")
    ServerIP = Request.ServerVariables("LOCAL_ADDR")
    Icheck = InStr(sReferer, "ServerIP")
    If Icheck = 0 Then
    CheckReferer = False
    End If
End Function

'日期格式化
Function FormatDate(DT,tp)
 dim Y,M,D
 Y=Year(DT)
 M=month(DT)
 D=Day(DT)
 if M<10 then M="0"&M
 if D<10 then D="0"&D
 select case tp
 case 1 FormatDate=Y&"年"&M&"月"&D&"日"
 case 2 FormatDate=Y&"/"&M&"/"&D
 case 3 FormatDate=M&"/"&D
    case 4 FormatDate=Y&"/"&M&"/"&D

 end select
End Function

'不允许外部提交数据的选择
Function ChkPost()
    dim HTTP_REFERER,SERVER_NAME
 dim server_v1,server_v2
 chkpost=false
    SERVER_NAME=CheckStr(Request.ServerVariables("SERVER_NAME"))
 HTTP_REFERER=CheckStr(Request.ServerVariables("HTTP_REFERER"))
 server_v1=Cstr(HTTP_REFERER)
 server_v2=Cstr(SERVER_NAME)
 if mid(server_v1,8,len(server_v2))<>server_v2 then
  chkpost=false
 else
  chkpost=true
 end if
End Function

'构造上传图片文件名随机数
function MakedownName()
dim fname
fname = now()
fname = replace(fname,"-","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
fname = int(fname) + int((10-1+1)*Rnd + 1)
MakedownName=fname
end function

'Email检测
function IsValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
   IsValidEmail = false
   exit function
end if
for each name in names
   if Len(name) <= 0 then
     IsValidEmail = false
     exit function
   end if
   for i = 1 to Len(name)
     c = Lcase(Mid(name, i, 1))
     if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
       IsValidEmail = false
       exit function
     end if
   next
   if Left(name, 1) = "." or Right(name, 1) = "." then
      IsValidEmail = false
      exit function
   end if
next
if InStr(names(1), ".") <= 0 then
   IsValidEmail = false
   exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
   IsValidEmail = false
   exit function
end if
if InStr(email, "..") > 0 then
   IsValidEmail = false
end if
end function

'Jmail邮件发送
Function SendJmail(Email,Topic,MailBody)

 Dim JMail
 on error resume next
 Set JMail = Server.CreateObject("JMail.SMTPMail")
 JMail.LazySend            = true
 JMail.silent            = true
 JMail.Charset            = "gb2312"
 JMail.ContentType      = "text/html"
 JMail.Sender            = ""&SMTPServer&""
 JMail.ReplyTo            = ""&SystemEmail&""
 JMail.SenderName      = ""&webname&"邮件发送系统"
 JMail.Subject            = Topic
 JMail.SimpleLayout      = true
 JMail.Body            = MailBody
 JMail.Priority            = 1
 JMail.AddRecipient Email
 JMail.AddHeader "Originating-IP", GBL_IPAddress
 If JMail.Execute() = false Then
  SendJmail = 0
 Else
  SendJmail = 1
 End If
 JMail.Close
 Set JMail = Nothing

End Function

'分页
Function listPages(LinkFile)
   if not (rs.eof and rs.bof) then
 gopage=currentpage
 totalpage=n
 blockPage=Int((gopage-1)/10)*10+1
' if instr(linkfile,"?page=")>0 or instr(linkfile,"&page=")>0 then
' pos=instr(linkfile,"page=")-2
' linkfile=left(linkfile,pos)
' end if
 
 If LCase(Request.ServerVariables("HTTPS")) = "off" Then
    strTemp = "http://"
    Else
    strTemp = "https://"
    End If
    strTemp = strTemp & CheckStr(Request.ServerVariables("SERVER_NAME"))
    If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & CheckStr(Request.ServerVariables("SERVER_PORT"))
    strTemp = strTemp & CheckStr(Request.ServerVariables("URL"))
    lenstrTemp=len(strTemp)+1 
 if instr(left(linkfile,lenstrTemp),"?")>0 then
 
 if blockPage = 1 Then
  Response.Write "<span disabled>【←前10页</span>&nbsp;"
 Else
  Response.Write("<span disabled>【</span><a href=" & LinkFile & "&page="&blockPage-10&">←前10页</a>&nbsp;")
 End If
   i=1
   Do Until i > 10 or blockPage > n
    If blockPage=int(gopage) Then
  Response.Write("<font color=#FF0000>[<b>"&blockPage&"</b>]</font>")
 Else
  Response.Write(" <a href=" & LinkFile & "&page="&blockPage&">["&blockPage&"]</a> ")
    End If
    blockPage=blockPage+1
    i = i + 1
    Loop
 if blockPage > totalpage Then
  Response.Write "&nbsp;<span disabled>后10页→】"
 Else
  Response.Write("&nbsp;<a href=" & LinkFile & "&page="&blockPage&">后10页→</a><span disabled>】")
 End If
 response.write" 直接到第 "
 response.write"<select οnchange=if(this.options[this.selectedIndex].value!=''){location=this.options[this.selectedIndex].value;}>"
    for i=1 to totalpage
    response.write"<option value='" & LinkFile & "&page=" & i & "'"
    if i=gopage then response.write"selected"
    response.write">"&i&"</option>"
    next
    response.write"</select>"
    response.write" 页<Br><Br>"
 
 else
 
 if blockPage = 1 Then
  Response.Write "<span disabled>【←前10页</span>&nbsp;"
 Else
  Response.Write("<span disabled>【</span><a href=" & LinkFile & "?page="&blockPage-10&">←前10页</a>&nbsp;")
 End If
   i=1
   Do Until i > 10 or blockPage > n
    If blockPage=int(gopage) Then
  Response.Write("<font color=#FF0000>[<b>"&blockPage&"</b>]</font>")
 Else
  Response.Write(" <a href=" & LinkFile & "?page="&blockPage&">["&blockPage&"]</a> ")
    End If
    blockPage=blockPage+1
    i = i + 1
    Loop
 if blockPage > totalpage Then
  Response.Write "&nbsp;<span disabled>后10页→】"
 Else
  Response.Write("&nbsp;<a href=" & LinkFile & "?page="&blockPage&">后10页→</a><span disabled>】")
 End If
 response.write" 直接到第 "
 response.write"<select οnchange=if(this.options[this.selectedIndex].value!=''){location=this.options[this.selectedIndex].value;}>"
    for i=1 to totalpage
    response.write"<option value='" & LinkFile & "?page=" & i & "'"
    if i=gopage then response.write"selected"
    response.write">"&i&"</option>"
    next
    response.write"</select>"
    response.write" 页<Br><Br>"
 
 End If
 
 Startinfo=((gopage-1)*msg_per_page)+1
 Endinfo=gopage*msg_per_page
 if Endinfo>totalrec then Endinfo=totalrec
  Response.Write("&nbsp;&nbsp;共 "&totalrec&" 条信息 当前显示第 "&Startinfo&" - "&Endinfo&" 条 每页 "&msg_per_page&" 条信息 共 "&n&" 页")
end if
End Function

'分页2
Function listPages2(LinkFile)
   if not (rs.eof and rs.bof) then
 gopage=currentpage
 totalpage=n
 blockPage=Int((gopage-1)/10)*10+1
 
 If LCase(Request.ServerVariables("HTTPS")) = "off" Then
    strTemp = "http://"
    Else
    strTemp = "https://"
    End If
    strTemp = strTemp & CheckStr(Request.ServerVariables("SERVER_NAME"))
    If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & CheckStr(Request.ServerVariables("SERVER_PORT"))
    strTemp = strTemp & CheckStr(Request.ServerVariables("URL"))
    lenstrTemp=len(strTemp)+1 
 if instr(left(linkfile,lenstrTemp),"?")>0 then
 
 if blockPage = 1 Then
  Response.Write "<span disabled>前10页</span>&nbsp;"
 Else
  Response.Write("<a href=" & LinkFile & "&page="&blockPage-10&">前10页</a>&nbsp;")
 End If
   i=1
   Do Until i > 10 or blockPage > n
    If blockPage=int(gopage) Then
  Response.Write("<font color=#FF0000><b>"&blockPage&"</b></font>")
 Else
  Response.Write(" <a href=" & LinkFile & "&page="&blockPage&">"&blockPage&"</a> ")
    End If
    blockPage=blockPage+1
    i = i + 1
    Loop
 if blockPage > totalpage Then
  Response.Write "&nbsp;<span disabled>后10页"
 Else
  Response.Write("&nbsp;<a href=" & LinkFile & "&page="&blockPage&">后10页</a><span disabled>")
 End If
 response.write" 直接到第 "
 response.write"<select οnchange=if(this.options[this.selectedIndex].value!=''){location=this.options[this.selectedIndex].value;}>"
    for i=1 to totalpage
    response.write"<option value='" & LinkFile & "&page=" & i & "'"
    if i=gopage then response.write"selected"
    response.write">"&i&"</option>"
    next
    response.write"</select>"
    response.write" 页<Br><Br>"
 
 else
 
 if blockPage = 1 Then
  Response.Write "<span disabled>【←前10页</span>&nbsp;"
 Else
  Response.Write("<span disabled>【</span><a href=" & LinkFile & "?page="&blockPage-10&">←前10页</a>&nbsp;")
 End If
   i=1
   Do Until i > 10 or blockPage > n
    If blockPage=int(gopage) Then
  Response.Write("<font color=#FF0000>[<b>"&blockPage&"</b>]</font>")
 Else
  Response.Write(" <a href=" & LinkFile & "?page="&blockPage&">["&blockPage&"]</a> ")
    End If
    blockPage=blockPage+1
    i = i + 1
    Loop
 if blockPage > totalpage Then
  Response.Write "&nbsp;<span disabled>后10页→】"
 Else
  Response.Write("&nbsp;<a href=" & LinkFile & "?page="&blockPage&">后10页→</a><span disabled>】")
 End If
 response.write" 直接到第 "
 response.write"<select οnchange=if(this.options[this.selectedIndex].value!=''){location=this.options[this.selectedIndex].value;}>"
    for i=1 to totalpage
    response.write"<option value='" & LinkFile & "?page=" & i & "'"
    if i=gopage then response.write"selected"
    response.write">"&i&"</option>"
    next
    response.write"</select>"
    response.write" 页<Br><Br>"
 
 End If
 
 Startinfo=((gopage-1)*msg_per_page)+1
 Endinfo=gopage*msg_per_page
 if Endinfo>totalrec then Endinfo=totalrec
  Response.Write("&nbsp;&nbsp;共 "&totalrec&" 条信息 当前显示第 "&Startinfo&" - "&Endinfo&" 条 每页 "&msg_per_page&" 条信息 共 "&n&" 页")
end if
End Function

'判断文件类型是否合格
Function CheckFileExt(FileExt)
 Dim ForumUpload,i
 ForumUpload="gif,jpg,bmp,jpeg,png"
 ForumUpload=Split(ForumUpload,",")
 CheckFileExt=False
 For i=0 to UBound(ForumUpload)
  If LCase(FileExt)=Lcase(Trim(ForumUpload(i))) Then
   CheckFileExt=True
   Exit Function
  End If
 Next
End Function

'格式后缀
Function FixName(UpFileExt)
 If IsEmpty(UpFileExt) Then Exit Function
 FixName = Lcase(UpFileExt)
 FixName = Replace(FixName,Chr(0),"")
 FixName = Replace(FixName,".","")
 FixName = Replace(FixName,"asp","")
 FixName = Replace(FixName,"asa","")
 FixName = Replace(FixName,"aspx","")
 FixName = Replace(FixName,"cer","")
 FixName = Replace(FixName,"cdx","")
 FixName = Replace(FixName,"htr","")
End Function

'文件Content-Type判断
Function CheckFileType(FileType)
 CheckFileType = False
 If Left(Cstr(Lcase(Trim(FileType))),6)="image/" Then CheckFileType = True
End Function

'获取IP地址
Function getIP()
    Dim strIPAddr
    If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
        strIPAddr = Request.ServerVariables("REMOTE_ADDR")
    ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
        strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
    ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
        strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
    Else
        strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    End If
    getIP = Trim(Mid(strIPAddr, 1, 30))
End Function

'分离关键词中字符
function splitChar(str)
oldstring=str
newstring=""
oldsign=0
newsign=0
i=len(oldstring)
for j=1 to i
if asc(mid(oldstring,j,1))<0  then
newsign=1
else
newsign=0
end if
if j=1 then
oldsign=newsign
end if
if oldsign=newsign then
newstring=newstring+mid(oldstring,j,1)
else
newstring=newstring+" "+mid(oldstring,j,1)
end if
oldsign=newsign
next
splitChar=newstring
end function

'突出显示匹配搜索关键词字符
Function dispRed(str,Dstr)
Dstrgroup=Split(Dstr, " ", -1, 1)
for i=0 to UBound(Dstrgroup)
if InStr(1,str,Dstrgroup(i),1)<>0 then
str1=mid(str,InStr(1,str,Dstrgroup(i),1),len(Dstrgroup(i)))
str=replace(str,Dstrgroup(i),"<font color=red>"&str1&"</font>",1,-1,1)
end if
next
dispRed=str
end Function

'URL数据获取
Function geturl(http://www.blog.com.cn/url)
   dim Str
   dim Http
   dim Arr
   set Http=CreateObject("Microsoft.XMLHTTP")
   Http.open "GET",url,false
   Http.send()
   if Http.readystate<>4 then
      exit function
   end if

   Str=bytesToBSTR(Http.responseBody,"GB2312")
   getUrl=Str
   set http=nothing
   if err.number<>0 then err.Clear
End Function

'格式化榨取数据
Function BytesToBstr(body,Cset)
   dim objstream
   set objstream = CreateObject("adodb.stream")
   objstream.Type = 1
   objstream.Mode =3
   objstream.Open
   objstream.Write body
   objstream.Position = 0
   objstream.Type = 2
   objstream.Charset = Cset
   BytesToBstr = objstream.ReadText
   objstream.Closea
   set objstream = nothing
End Function

'搜索时去除HTML标记
Function LoseHtml(ContentStr)
 Dim ClsTempLoseStr,regEx
 ClsTempLoseStr = Cstr(ContentStr)
 Set regEx = New RegExp
 regEx.Pattern = "<//*[^<>]*>"
 regEx.IgnoreCase = True
 regEx.Global = True
 ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"")
 LoseHtml = ClsTempLoseStr
End Function
%>