www.gusucode.com > 栽豆迷你博客 MiniBlog 3.0 正式版源码程序 > Include/Function.asp

    <%
'---------------------------------------------------------------------
' NB联盟防注入函数 ReqNum / ReqStr
'调用：查询数字型的字段比如Request("ID"),就可以换成ReqNum("ID")
'调用：查询数字型的字段比如Request("text")，就可以写为ReqStr("text")。
'---------------------------------------------------------------------
Function ReqNum ( StrName )
     ReqNum = Request ( StrName )
     if Not isNumeric ( ReqNum ) then
          Response.Write "<BR>"
          Response.Write "出错。"
          Response.End
     End if
End Function

Function ReqStr ( StrName )
    ReqStr = Replace ( Request(StrName), "'", "''" )
End Function

'------------------------------------
' 隐藏IP末两位
'------------------------------------
Function IpArray(IpStr)
	If IpStr="" then Exit Function
        Dim ips
        ips = Split(IpStr, ".")
        IpArray = ips(0) & "." & ips(1) & ".*.*"
End Function
	
'------------------------------------
' HTML代码转换
'------------------------------------
Function HTMLEncode(fString)
If Not IsNull(fString) And fString <> "" Then
	fString = Replace(fString, "&", "&amp;")
	fString = Replace(fString, ">", "&gt;")
	fString = Replace(fString, "<", "&lt;")
	fString = Replace(fString, Chr(32), "&nbsp;")
	fString = Replace(fString, Chr(9), "&nbsp;&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>")
	fString = Replace(fString, Chr(255), "&nbsp;")
	HTMLEncode = fString
End If
End Function

'------------------------------------  
'计算随机数    
'------------------------------------   
function randomStr(intLength)    
    dim strSeed,seedLength,pos,str,i 
    strSeed = "abcdefghijklmnopqrstuvwxyz1234567890"   
    seedLength=len(strSeed)    
    str=""   
    Randomize    
    for i=1 to intLength    
     str=str+mid(strSeed,int(seedLength*rnd)+1,1)    
    next    
    randomStr=str
end function

'------------------------------------
'检测是否只包含英文
'------------------------------------    
Function IsValidChars(str)    
    Dim re,chkstr    
    Set re=new RegExp    
    re.IgnoreCase =true    
    re.Global=True   
    re.Pattern="[^_\.a-zA-Z\d]" 
    IsValidChars=True   
    chkstr=re.Replace(str,"")    
    if chkstr<>str then IsValidChars=False   
    set re=nothing    
End Function

'------------------------------------
' 检测是否有效的数字
'------------------------------------
Function ValidInteger(str)
	If Str="" then Exit Function
	Dim re,chkstr
	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True
	re.Pattern="[^_\.0-9\d]"
	ValidInteger=True
	chkstr=re.Replace(Str,"")
	ValidInteger=IsInteger(chkstr)
End Function

'------------------------------------
' 检测是否有效的数字
'------------------------------------
Public Function IsInteger(Para) 
	If Para="" then Exit Function
	IsInteger=False
	If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then IsInteger=Para
End Function

'------------------------------------
'检测是否只包含英文和数字
'------------------------------------
Function IsvalidValue(Str)
	IsvalidValue = false
	Dim GName
	For Each GName in ArrayN
		If Str = GName Then
			 IsvalidValue = true
			Exit For
		End If
	Next
End Function

'------------------------------------
'检测是否有效的E-mail地址
'------------------------------------
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

'------------------------------------
'简单检测是否有效的Http地址
'------------------------------------
Function IsValidUrl(Url)
	IsValidUrl = False
	Dim Domain,Domain1,Domain2
	Domain = Split(Url,"//"):Domain1= Split(Url,":"):Domain2= Split(Url,".")
	If UBound(Domain) > 0 and UBound(Domain1) > 0 and UBound(Domain2) > 0 then IsValidUrl = True
End Function

'------------------------------------
'检测是否有效的用户名
'------------------------------------
Function IsValidUserName(UserName)
	Dim i,c
	Dim VUserName
	IsValidUserName = True
	For i = 1 To Len(UserName)
		c = Lcase(Mid(UserName, i, 1))
		If InStr("$!<>?#^%@~`&*();:+='"" 	", c) > 0 Then
				IsValidUserName = False
				Exit Function
		End IF
	Next
	For Each VUserName in Caluoob.BadNames
		If UserName = VUserName Then
			IsValidUserName = False
			Exit For
		End If
	Next
End Function

'------------------------------------
'过滤特殊字符
'------------------------------------
Function CheckStr(ChkStr) 
	Dim Str:Str=ChkStr
	If IsNull(Str) Then
		CheckStr = ""
		Exit Function 
	End If
    Str = Replace(Str, "&", "&amp;")
    Str = Replace(Str,"'","&#39;")
    Str = Replace(Str,"""","&#34;")
	CheckStr=Str
End Function

'------------------------------------
' 过滤禁止使用文符
'------------------------------------
Function ChkBadWords(FString,Stxt,Str)
If fString="" then Exit Function
dim bwords,i_back
	fString=replace(fString,"'","''")
		bwords = split(Config_System(str), "|")
		For i_back = 0 to ubound(bwords)
			 fString = Replace(fString,bwords(i_back),string(len(bwords(i_back)),Stxt))
		next
		ChkBadWords = fString
End Function

'------------------------------------
' 公用分页
'------------------------------------
Function SubClassPage(Page,MaxPage,AllPage,StrHreF)
If Page=empty or page<1 then Page=1
SubClassPage="<ul class=paginator>"
Dim J,StaPage,EndPage,NetPage,S
StaPage=Page-3
EndPage=Page+3
  If StaPage < 1 then StaPage=1
  If AllPage mod MaxPage=0 Then
  Endpage = AllPage\MaxPage
  Else
  Endpage = AllPage\MaxPage + 1
  End If
  NetPage=Page+3
  If StaPage<2 Then NetPage=Page+4
  If NetPage>Endpage Then NetPage=Endpage
  If int(Page) > int(EndPage) then Exit Function
If int(Page)=1 then
SubClassPage=SubClassPage & ""
else
SubClassPage=SubClassPage & "<li><a href="&StrHreF&">首页</a></li>"
end if
For J=StaPage to NetPage
S=J:If Len(S)<2 Then S="0"&J
If J<>int(Page) then
SubClassPage=SubClassPage & "<li><a href="&StrHreF&J&">"&S&"</a></li>"
else
SubClassPage=SubClassPage & "<li class=current>"&S&"</li>"
end if
Next
If int(Page)=Endpage then
SubClassPage=SubClassPage & ""
else
SubClassPage=SubClassPage & "<li><a href="&StrHreF&Endpage&">末页</a></li>"
end if
SubClassPage=SubClassPage & "</ul>"
End Function

'------------------------------------
' 过滤Html
'------------------------------------
Function RemoveHTML(strHTML)
	Dim objRegExp, Match, Matches
	Set objRegExp = New Regexp
	objRegExp.IgnoreCase = True
	objRegExp.Global = True
	objRegExp.Pattern = "<.+?>"
	Set Matches = objRegExp.Execute(strHTML)
	For Each Match in Matches
	strHtml=Replace(strHTML,Match.Value,"")
	Next
	RemoveHTML=strHTML
	Set objRegExp = Nothing
End Function

'------------------------------------
' UBB代码输出
'------------------------------------
function UBB(Content)
	Content = HTMLEncode(Content)
Dim re
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
	
	re.Pattern = "\[IMG\](http|https|ftp)://(.[^\[]*)\[\/IMG\]"
	Content = re.Replace(Content,"<IMG SRC=""$1://$2"" border=""0"" border=0 align=absMiddle border=0>")

	re.Pattern = "^((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)"
	Content = re.Replace(Content,"<a target=_blank href=$1>$1</a>")

	re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+)$([^\[]*)"
	Content = re.Replace(Content,"<a target=_blank href=$1>$1</a>")

	re.Pattern = "([^>=""])((http|https|ftp|rtsp|mms):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+)"
	Content = re.Replace(Content,"$1<a target=_blank href=$2>$2</a>")

	re.Pattern = "(^[(http://|http:\\)])((www|cn)[.](\w)+[.]{1,}(net|com|cn|org|cc)(((\/[\~]*|\\[\~]*)(\w)+)|[.](\w)+)*(((([?](\w)+){1}[=]*))*((\w)+){1}([\&](\w)+[\=](\w)+)*)*)"
	Content = re.Replace(Content,"<a target=_blank href=http://$2>$2</a>")


set re=Nothing
UBB=Content
end function
%>