<%
Class Cls_Fun
	Public Function IpDecode(byval uip)
		If trim(uip)="" or not isnumeric(uip) then
			IpDecode=0
		Else
			uip=Cdbl(uip)
			Dim ary_ip(3)
			ary_ip(0)=fix(uip/16777216)
			ary_ip(1)=fix((uip-ary_ip(0)*16777216)/65536)
			ary_ip(2)=fix((uip-fix(uip/65536)*65536)/256)
			uip=uip-fix(uip/65536)*65536
			ary_ip(3)=fix(uip-fix(uip/256)*256)
			IpDecode=join(ary_ip,".")
		End if
	End function
	Public function IpEncode(byval uip)
		If isnull(uip) or uip="" then
			IpEncode=0
		Else
			Dim ary_ip,n
			ary_ip=split(trim(uip),".")
			n=ubound(ary_ip)
			If n=3 then
				IpEncode=ary_ip(0)*256*256*256+ary_ip(1)*65536+ary_ip(2)*256+ary_ip(3)
			else
				IpEncode=0
			End if
		End if
	End function
	
	'防止生成html代码	
	Public Function FiltrateHtmlCode(Str)
		If Not isnull(str) And str<>"" then
			Str=Replace(Str,Chr(9),"")
			Str=replace(Str,"|","&#124;")
			Str=replace(Str,chr(39),"&#39;")
			Str=replace(Str,"<","&lt;")
			Str=replace(Str,">","&gt;")
			Str = Replace(str, CHR(13),"")
			Str = Replace(str, CHR(10),"")
			FiltrateHtmlCode=Str
		End If
	End Function
	'过滤Html标签
	Public function HtmlCode(str)
	If Not isnull(str) And str<>"" then
		str = replace(str, ">", "&gt;")
		str = replace(str, "<", "&lt;")
		str = Replace(str, CHR(32), " ")
		str = Replace(str, CHR(9), "&nbsp;")
		str = Replace(str, CHR(34), "&quot;")
		str = Replace(str, CHR(39), "&#39;")
		str = Replace(str, CHR(13), "")
		str = Replace(str, CHR(10), "")
		str = Replace(str, "script", "&#115cript")
		HtmlCode = str
	End If
	End function
	'传js字符
	Public Function GetJsStr(Str)
		If IsNull(Str) Then
			Str = ""
		Else
			Str = Replace(Str,"'","\'")
			Str = replace(Str,chr(34),"\"&chr(34))
		End If
		GetJsStr = Str
	End Function
	
	'传表单字符
	Public Function GetForm(Str)
		Str = Trim(Request.Form(Str))
		If IsEmpty(Str) Then
			GetForm = ""
			Exit Function 
		End If
		Str = Replace(Str,Chr(0),"")
		GetForm = Replace(Str,"'","''")
	End Function
		
	'传表单字符(过滤刺)
	Public Function GetStr(Str)
		Str = Trim(Request.Form(Str))
		If IsEmpty(Str) Then
			Str = ""
		Else
			Str = Replace(Str,"{","｛")
			Str = Replace(Str,"}","｝")
			Str = Replace(Str,"'","&#39")
			Str = Replace(Str,"|","&#124;")
		End If
		GetStr = Trim(Str)
	End Function
	
	'名字字符检验	
	Public Function CheckName(Str)
		Checkname=True
		Dim Rep,pass
		Set Rep=New RegExp
		Rep.Global=True
		Rep.IgnoreCase=True
		Rep.Pattern="[\u0009\u0020\u0022-\u0028\u002C-\u002E\u003A-\u003F\u005B\u005C\u0060\u007C\u007E\u00FF\uE5E5]"
		Set pass=Rep.Execute(Str)
		If pass.count<>0 Then CheckName=False
		Set Rep=Nothing
	End Function
	
	'密码检验
	Public Function CheckPassword(Str)
		Dim pass
		CheckPassword=false
		If Str <> "" Then
		Dim Rep
		Set Rep = New RegExp
		Rep.Global = True
		Rep.IgnoreCase = True
		Rep.Pattern="[\u4E00-\u9FA5\uF900-\uFA2D\u0027\u007C]"
		Pass=rep.Test(Str)
		Set Rep=nothing
		If Not Pass Then CheckPassword=True
		End If
	End Function		
	'邮箱检测
	Public function IsValidEmail(email)
		Dim Rep
		Set Rep = new RegExp
		rep.pattern = "([\.a-zA-Z0-9_-]){2,10}@([a-zA-Z0-9_-]){2,10}(\.([a-zA-Z0-9]){2,}){1,4}$"
		IsValidEmail=rep.Test(email)
		Set Rep=Nothing
		If len(email)>40 Then IsValidEmail=false
	End function
	'字符长度载取（汉字为2）
	Public Function StrLeft(str,strlen)
	   Dim l,t,i,c
	   If str="" Then
	      StrLeft=""
		  Exit Function
	   End If
	   str=Replace(Replace(Replace(Replace(Replace(str,"&nbsp;"," "),"&quot;",Chr(34)),"&gt;",">"),"&lt;","<"),"&#124;","|")
	   l=Len(str)
	   t=0
	   For i=1 To l
		  c=Abs(Asc(Mid(str,i,1)))
		  If c>255 Then
		    t=t+2
		  Else
		    t=t+1
		  End If
		  If t>=strlen Then
		    StrLeft=Left(str,i) & "..."
		    Exit For
		  Else
		    StrLeft=str
		  End If
	   Next
	   StrLeft=Replace(Replace(Replace(Replace(replace(StrLeft," ","&nbsp;"),Chr(34),"&quot;"),">","&gt;"),"<","&lt;"),"|","&#124;")
	End Function
	'栓查是否为空
	Public Function CheckIsEmpty(tstr)
		CheckIsEmpty=True
		If IsNull(tstr) or Tstr="" Then Exit Function 
		Dim Str,re
		Str=Tstr
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True
		str = Replace(str, vbNewLine, "")
		str = Replace(str, Chr(9), "")
		str = Replace(str, " ", "")
		str = Replace(str, "&nbsp;", "")
		re.Pattern="<img(.[^>]*)>"
		str =re.Replace(Str,"94kk")
		re.Pattern="<(.[^>]*)>"
		Str=re.Replace(Str,"")
		Set Re=Nothing
		If Str<>"" Then CheckIsEmpty=False
	End Function
	'清理html
	Public Function Replacehtml(tstr)
		Dim Str,re
		Str=Tstr
		Set re=new RegExp
			re.IgnoreCase =True
			re.Global=True
			re.Pattern="<(p|\/p|br)>"
			Str=re.Replace(Str,vbNewLine)
			re.Pattern="<img.[^>]*src(=| )(.[^>]*)>"
			str=re.replace(str,"[img]$2[/img]")
			re.Pattern="<(.[^>]*)>"
			Str=re.Replace(Str,"")
			Set Re=Nothing
			Replacehtml=Str
	End Function
	'脏字过滤&日文
	Public Function Checkbad(str)
		Dim Temp,Fun_I
		If IsNull(Str) Then Exit Function 
		Temp=Split(BBS94KK.Info(79),"|")
		For Fun_i=0 to ubound(Temp)
			Str=Replace(str, Temp(Fun_i), String(Len(Temp(Fun_i)),"*")) 
		Next
		Checkbad=jap(Str)
	End Function

	'Ubb标记
	Public Function UbbString(byval Str1)
		Dim UBB_94KK,i,Str,Temp
		Str=LCase(Str1)
		UBB_94KK=Split("javascript:,jscript:,object,js:,location.,vbscript:,vbs:,.value,about:,file:,document.cookie,onmouse,onexit,onerror,onclick,onkey,onload,www.,http,https,ftp,rtsp,mms,[/b],[/i],[/u],[/sup],[/sub],[/color],[/url],[/right],[/light],[em,[/size],[/dir],[/fly],[/move],[/align],[/shadow],[/sound],[/img],[/upload],[/email],[/flash],[/mp],[/rm],[/ra],[/quote],[/coin],[/mark],[/grade],[/login],[/sex],[/username],[/date],[/reply],[/buypost],[/code]",",")
		Temp=","
		For i=0 to 16
			If InStr(Str,UBB_94KK(i))>0 Then
				Temp=Temp&"0,"
				Exit For
			End If
		Next
		For i=17 to 57
			If InStr(Str,UBB_94KK(i))>0 Then
				Temp=Temp & i-16 &","
			End If
		Next
		UbbString=Temp&CheckTable(str)
	End Function
	'注入检查
	Public Function CheckIn(str)
		If instr(1,str,chr(39))>0 or instr(1,str,chr(34))>0 or instr(1,str,chr(59))>0 then
		CheckIn=False
		Else
		CheckIn=True
		End if
	End Function
	'日文编码
	Public Function jap(Istr)
		Dim japArr,ArrNum
		japArr=split("ゴ|ガ|ギ|グ|ゲ|ザ|ジ|ズ|ヅ|デ|ド|ポ|ベ|プ|ビ|パ|ヴ|ボ|ペ|ブ|ピ|バ|ヂ|ダ|ゾ|ゼ","|")
		For ArrNum=0 to Ubound(japArr)
			Istr=Replace(Istr,japArr(ArrNum),"&#"&AscW(japArr(ArrNum))&";")
		Next
		jap=Istr
	End Function
	
	'最后回复过滤	
	Public Function FixReply(Byval Tstr)
		If Tstr="" Then Exit Function
		Dim Re
		Set Re = New RegExp
		Re.Global = True
		Re.IgnoreCase = True
		Tstr=Replace(Tstr,chr(10),"")
		Tstr=Replace(Tstr,chr(0),"")
		Tstr=Replace(Tstr,chr(13),"")
	'过滤掉修饰性标签
		Re.Pattern="<(.[^>]*)>"
		Tstr=Re.Replace(Tstr,"")
		Re.pattern="\[(b|\/b|u|\/u|i|\/i|quote|\/quote|email|\/email|flash|\/flash|right|\/right|sub|\/sub|light|\/light|code|\/code|sup|\/sup)\]"
		Tstr=Re.Replace(Tstr,"")
		re.pattern="\[size=[1-7]\](.[^\[]*)\[\/size\]"
		Tstr=re.Replace(Tstr,"$1")
		re.pattern="\[em*([0-9]*)\]"
		Tstr=Re.Replace(Tstr,"")
		Re.pattern="\[align=(center|left|right)\](.[^\[]*)\[\/align\]"
		Tstr=Re.Replace(Tstr,"$2")
		Re.pattern="\[COLOR=.[^\[]*\](.[^\[]*)\[\/COLOR\]"
		Tstr=Re.replace(Tstr,"$1")
	'过滤限制性标签
		Tstr=Left(Tstr,100)'载断
		Re.Pattern="(^.*)\[(.*)\](.*)"
		FixReply=Lcase(Re.Replace(Tstr,"$2"))
		If Instr(FixReply,"=") Then
			FixReply=Left(FixReply,Instr(FixReply,"=")-1)
		Else
			FixReply=Replace(FixReply,"/","")
		End If
		Set Re=Nothing
		Select Case FixReply
		Case"upload"
		Tstr="此帖包含上传附件!"
		Case"coin","mark","grade","login","username","reply","date","buypost"
		Tstr="此帖内容保密"
		End Select
		If Tstr="" Then Tstr="......"
		FixReply=Tstr
	End Function
	
'============分词搜索
	Public Function SplitKey(Col,Key,Flag)
	Dim Num,Keys,Temp
		'SplitKey=Col&" Like '%"&Key&"%' "
		SplitKey="InStr(1,LCase("&Col&"),LCase('"&Key&"'),0)<>0"
		Keys=Split(Key," ")
		If Ubound(Keys)>0 Then
			For Num=0 To Ubound(Keys)
				'Temp=Temp&Col&" like '%"&Keys(Num)&"%' "&Flag&" "
				Temp=Temp&"InStr(1,LCase("&Col&"),LCase('"&Keys(Num)&"'),0)<>0 "&Flag&" "
			Next
			If Temp<>"" Then
				SplitKey=SplitKey&" or ("&Left(Temp,Len(Temp)-4)&")"
			End If
		End If
	End Function
'========获得搜索关键字
	Public Function GetKey(str)
		Str=Trim(Request(str))
		If Str<>"" Then
		str=Left(Str,40) '最多40个字符
		str=Replace(str,"'","")
		str=Replace(str,chr(34)&chr(34),"")
		str=Replace(str,"#","")
		str=Replace(str,"  "," ")
		str=Replace(str,"]","")
		str=Replace(str,"[","[[]")
		str=Replace(str,"%","[%]")
		GetKey=Replace(str,"_","[_]")
		End If
	End Function

'-----------红字显示搜索
	Public Function ReplaceKey(Str,Key)
		Dim I,Keys,StrT
		If Str="" Then Exit Function
		StrT=Str
		If Key<>"" Then
			'Str=Replace(Str,Key,"<span style='color:#F00'>"&Key&"</span>")
			Keys=Split(Key," ")
			For I=0 To Ubound(Keys)
			StrT=Replace(StrT,Keys(I),"#"&Keys(I)&"]")
			Next
			StrT=Replace(Replace(StrT,"#","<span style='color:#F00'>"),"]","</span>")
		End If
		ReplaceKey=StrT
	End Function	

	Public Function GetSqlStr(Str)
		If IsEmpty(Str) Or Isnull(Str) Then	Str = ""
		GetSqlStr = Str
	End Function
	'整数检验
	Public function isInteger(para)
		   on error resume Next
		   Dim str
		   Dim l,i
		   If isNUll(para) then 
			  isInteger=false
			  exit function
		   End if
		   str=cstr(para)
		   If trim(str)="" then
			  isInteger=false
			  exit function
		   End if
		   l=len(str)
		   For i=1 to l
			   If mid(str,i,1)>"9" or mid(str,i,1)<"0" then
				  isInteger=false 
				  exit function
			   End if
		   Next
		   isInteger=true
		   If err.number<>0 then err.clear
	End function
	
	 '字符长度（汉字为2）
	Public function strLength(findstr)
		Dim Rep,lens,i
		Set rep=new regexp
		rep.Global=true
		rep.IgnoreCase=true
		rep.Pattern="[\u4E00-\u9FA5\uF900-\uFA2D]"
		For each i in rep.Execute(findstr)
			lens=lens+1
		Next
		Set Rep=Nothing
		lens=lens + len(findstr)
		strLength=lens
	End function
	
	Function checkTable(str)
	checkTable="no,"
	Dim s,s1,s2
	s=Str
	s1=split(s,"<table")
	s2=split(s,"</table>")
	If UBound(s1)<>UBound(s2) Then exit Function
	s1=split(s,"<td")
	s2=split(s,"</td>")
	If UBound(s1)<>UBound(s2) Then exit Function
	s1=split(s,"<div")
	s2=split(s,"</div>")
	If UBound(s1)<>UBound(s2) Then exit Function
	s1=split(s,"<th")
	s2=split(s,"</th>")
	If UBound(s1)<>UBound(s2) Then exit Function
	checkTable=""
	End Function
End Class
%>