function.asp

来自「一套非常实用的博客源代码,功能全,界面简单易用.」· ASP 代码 · 共 752 行 · 第 1/2 页

ASP
752
字号
<%Function IsvalidFile(File_Type)   '限制上传文件类型
	IsvalidFile = False
	Dim GName
	For Each GName in UP_FileType
		If File_Type = GName Then
			IsvalidFile = True
			Exit For
		End If
	Next
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 CheckLinkStr(Str)
	Str = Replace(Str, "<script>", " ")
	Str = Replace(Str, "document.cookie", ".")
	Str = Replace(Str, "document.location", ".")	
	Str = Replace(Str, "document.write", ".")
	Str = Replace(Str, "javascript:", "javascript ")
	Str = Replace(Str, "vbscript:", "vbscript ")
	Str = Replace(Str, "javascript :", "javascript ")
	Str = Replace(Str, "vbscript :", "vbscript ")
	Str = Replace(Str, "[", "&#91;")
	Str = Replace(Str, "]", "&#93;")
	Str = Replace(Str, "<", "&#60;")
	Str = Replace(Str, ">", "&#62;")
	Str = Replace(Str, "{", "&#123;")
	Str = Replace(Str, "}", "&#125;")
	Str = Replace(Str, "|", "&#124;")
	Str = Replace(Str, "?", "&#124;")
	Str = Replace(Str, "'", "")
	Str = Replace(Str, "(", "(")
	Str = Replace(Str, ")", ")")
	Str = Replace(Str, ";", ";")
	Str = Replace(Str, ",", ",")
	Str = Replace(Str, "%", "%")
	Str = Replace(Str, "+", "+")
	Str = Replace(Str, "script", "&#115;cript")
	Str = Replace(Str, "SCRIPT", "&#083;CRIPT")
	Str = Replace(Str, "Script", "&#083;cript")
	Str = Replace(Str, "script", "&#083;cript")
	Str = Replace(Str, "object", "&#111;bject")
	Str = Replace(Str, "OBJECT", "&#079;BJECT")
	Str = Replace(Str, "Object", "&#079;bject")
	Str = Replace(Str, "object", "&#079;bject")
	Str = Replace(Str, "applet", "&#097;pplet")
	Str = Replace(Str, "APPLET", "&#065;PPLET")
	Str = Replace(Str, "Applet", "&#065;pplet")
	Str = Replace(Str, "applet", "&#065;pplet")
	Str = Replace(Str, "embed", "&#101;mbed")
	Str = Replace(Str, "EMBED", "&#069;MBED")
	Str = Replace(Str, "Embed", "&#069;mbed")
	Str = Replace(Str, "embed", "&#069;mbed")
	Str = Replace(Str, "document", "&#100;ocument")
	Str = Replace(Str, "DOCUMENT", "&#068;OCUMENT")
	Str = Replace(Str, "Document", "&#068;ocument")
	Str = Replace(Str, "document", "&#068;ocument")
	Str = Replace(Str, "cookie", "&#099;ookie")
	Str = Replace(Str, "COOKIE", "&#067;OOKIE")
	Str = Replace(Str, "Cookie", "&#067;ookie")
	Str = Replace(Str, "cookie", "&#067;ookie")
	Str = Replace(Str, "event", "&#101;vent")
	Str = Replace(Str, "EVENT", "&#069;VENT")
	Str = Replace(Str, "Event", "&#069;vent")
	Str = Replace(Str, "event", "&#069;vent")
	CheckLinkStr = Str
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, "select", "sel&#101;ct")
	Str = Replace(Str, "join", "jo&#105;n")
	Str = Replace(Str, "union", "un&#105;on")
	Str = Replace(Str, "where", "wh&#101;re")
	Str = Replace(Str, "insert", "ins&#101;rt")
	Str = Replace(Str, "delete", "del&#101;te")
	Str = Replace(Str, "update", "up&#100;ate")
	Str = Replace(Str, "like", "lik&#101;")
	Str = Replace(Str, "drop", "dro&#112;")
	Str = Replace(Str, "create", "cr&#101;ate")
	Str = Replace(Str, "modify", "mod&#105;fy")
	Str = Replace(Str, "rename", "ren&#097;me")
	Str = Replace(Str, "alter", "alt&#101;r")
	Str = Replace(Str, "cast", "ca&#115;t")
	Str = Replace(Str, "パ", "&pa;")
	Str = Replace(Str, "ポ", "&po;")
        Str = Replace(Str, "ゾ", "&zo;")
        Str = Replace(Str, "ギ", "&gi;")
        Str = Replace(Str, "ビ", "&bi;")
        Str = Replace(Str, "ヴ", "&wu;")
        Str = Replace(Str, "ダ", "&da;")
        Str = Replace(Str, "グ", "&ku;")
        Str = Replace(Str, "ピ", "&pi;")
        Str = Replace(Str, "ヂ", "&ji;")
        Str = Replace(Str, "ゲ", "&ke;")
        Str = Replace(Str, "ブ", "&bu;")
        Str = Replace(Str, "ヅ", "&zu;")
        Str = Replace(Str, "ゴ", "&ko;")
        Str = Replace(Str, "プ", "&pu;")
        Str = Replace(Str, "デ", "&de;")
        Str = Replace(Str, "ザ", "&za;")
        Str = Replace(Str, "ベ", "&be;")
        Str = Replace(Str, "ド", "&do;")
        Str = Replace(Str, "ジ", "&zi;")
        Str = Replace(Str, "ペ", "&pe;")
        Str = Replace(Str, "バ", "&ba;")
        Str = Replace(Str, "ズ", "&zi;")
        Str = Replace(Str, "ボ", "&bo;")
	CheckStr=Str
End Function

Function UnCheckStr(Str)
		Str = Replace(Str, "sel&#101;ct", "select")
		Str = Replace(Str, "jo&#105;n", "join")
		Str = Replace(Str, "un&#105;on", "union")
		Str = Replace(Str, "wh&#101;re", "where")
		Str = Replace(Str, "ins&#101;rt", "insert")
		Str = Replace(Str, "del&#101;te", "delete")
		Str = Replace(Str, "up&#100;ate", "update")
		Str = Replace(Str, "lik&#101;", "like")
		Str = Replace(Str, "dro&#112;", "drop")
		Str = Replace(Str, "cr&#101;ate", "create")
		Str = Replace(Str, "mod&#105;fy", "modify")
		Str = Replace(Str, "ren&#097;me", "rename")
		Str = Replace(Str, "alt&#101;r", "alter")
		Str = Replace(Str, "ca&#115;t", "cast")
		Str = Replace(Str, "&pa;", "パ")
		Str = Replace(Str, "&po;", "ポ")
		Str = Replace(Str, "&zo;", "ゾ")
		Str = Replace(Str, "&gi;", "ギ")
		Str = Replace(Str, "&bi;", "ビ")
		Str = Replace(Str, "&wu;", "ヴ")
		Str = Replace(Str, "&da;", "ダ")
		Str = Replace(Str, "&ku;", "グ")
		Str = Replace(Str, "&pi;", "ピ")
		Str = Replace(Str, "&ji;", "ヂ")
		Str = Replace(Str, "&ke;", "ゲ")
		Str = Replace(Str, "&bu;", "ブ")
		Str = Replace(Str, "&zu;", "ヅ")
		Str = Replace(Str, "&ko;", "ゴ")
		Str = Replace(Str, "&pu;", "プ")
		Str = Replace(Str, "&de;", "デ")
		Str = Replace(Str, "&za;", "ザ")
		Str = Replace(Str, "&be;", "ベ")
		Str = Replace(Str, "&do;", "ド")
		Str = Replace(Str, "&zi;", "ジ")
		Str = Replace(Str, "&pe;", "ペ")
		Str = Replace(Str, "&ba;", "バ")
		Str = Replace(Str, "&zi;", "ズ")
		Str = Replace(Str, "&bo;", "ボ")
		UnCheckStr=Str
End Function

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

Function EditDeHTML(byVal Content)
	EditDeHTML=Content
	IF Not IsNull(EditDeHTML) Then
		EditDeHTML=UnCheckStr(EditDeHTML)
		EditDeHTML=Replace(EditDeHTML,"&","&amp;")
		EditDeHTML=Replace(EditDeHTML,"<","&lt;")
		EditDeHTML=Replace(EditDeHTML,">","&gt;")
		EditDeHTML=Replace(EditDeHTML,CHR(34),"&quot;")
		EditDeHTML=Replace(EditDeHTML,CHR(39),"&#39;")
	End IF
End Function

Function DateToStr(DateTime,ShowType)  '日期转换函数
	Dim DateMonth,DateDay,DateHour,DateMinute
	DateMonth=Month(DateTime)
	DateDay=Day(DateTime)
	DateHour=Hour(DateTime)
	DateMinute=Minute(DateTime)
	If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
	If Len(DateDay)<2 Then DateDay="0"&DateDay
	Select Case ShowType
	Case "Y-m-d"  
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
	Case "Y-m-d H:I A"
		Dim DateAMPM
		If DateHour>12 Then 
			DateHour=DateHour-12
			DateAMPM="PM"
		Else
			DateHour=DateHour
			DateAMPM="AM"
		End If
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM
	Case "Y-m-d H:I:S"
		Dim DateSecond
		DateSecond=Second(DateTime)
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
	Case "YmdHIS"
		DateSecond=Second(DateTime)
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond	
	Case "ym"
		DateToStr=Right(Year(DateTime),2)&DateMonth
	Case "d"
		DateToStr=DateDay
	Case Else
		If Len(DateHour)<2 Then DateHour="0"&DateHour
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
	End Select
End Function

Function IsValidUserName(byVal UserName)
	Dim i,c
	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
End Function

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

Function MultiPage(Numbers,Perpage,Curpage,Url_Add) '分页函数
	CurPage=Int(Curpage)
	Dim URL
	URL=Request.ServerVariables("Script_Name")&Url_Add
	MultiPage=""
	Dim Page,Offset,PageI
	If Int(Numbers)>Int(PerPage) Then
		Page=10
		Offset=2
		Dim Pages,FromPage,ToPage
		If Numbers Mod Cint(Perpage)=0 Then
			Pages=Int(Numbers/Perpage)
		Else
			Pages=Int(Numbers/Perpage)+1
		End If
		FromPage=Curpage-Offset
		ToPage=Curpage+Page-Offset-1
		If Page>Pages Then
			FromPage=1
			ToPage=Pages
		Else
			If FromPage<1 Then
				Topage=Curpage+1-FromPage
				FromPage=1
				If (ToPage-FromPage)<Page And (ToPage-FromPage)<Pages Then ToPage=Page
			ElseIF Topage>Pages Then
				FromPage =Curpage-Pages +ToPage
				ToPage=Pages
				If (ToPage-FromPage)<Page And (ToPage-FromPage)<Pages Then FromPage=Pages-Page+1
			End If
		End If
		MultiPage="<a href="""&Url&"page=1""><img src=""images/icon_ar.gif"" border=""0"" align=""absmiddle""></a> "
		For PageI=FromPage TO ToPage
			If PageI<>CurPage Then
				MultiPage=MultiPage&"<a href="""&Url&"page="&PageI&""">["&PageI&"]</a>&nbsp;"
			Else
				MultiPage=MultiPage&"<b>["&PageI&"]</b>&nbsp;"
			End If
		Next
		If Int(Pages)>Int(Page) Then
			MultiPage=MultiPage&" ... <a href="""&Url&"page="&Pages&"""> ["&pages&"] <img src=""images/icon_al.gif"" border=""0"" align=""absmiddle""></a>&nbsp;<input type=""text"" name=""custompage"" size=""1"" class=""custompage"" onKeyDown=""javascript: if(window.event.keyCode == 13) window.location='"&Url&"page='+this.value;"">"
		Else
			MultiPage=MultiPage&" <a href="""&Url&"page="&Pages&"""><img src=""images/icon_al.gif"" border=""0"" align=""absmiddle""></a>"
		End If
	End If
End Function

Function SplitLines(byVal Content,byVal ContentNums) '切割内容
	Dim ts,i,l
	If IsNull(Content) Then Exit Function
	i=1
	ts = 0
	For i=1 to Len(Content)
      	l=Mid(Content,i,4)
      	If l="<br>" Then
         	ts=ts+1
      	End If
      	If ts>ContentNums Then Exit For 
	Next
	If ts>ContentNums Then
    	Content=Left(Content,i-1)
	End If
	SplitLines=Content
End Function

Sub GetCurPage
	If CheckStr(Request.QueryString("Page"))<>Empty Then
		Curpage=CheckStr(Request.QueryString("Page"))
		If IsInteger(Curpage)=False Then
			CurPage=1
		Else
			If CurPage<0 Then
				CurPage=1
			End If
		End If
	Else
		CurPage=1

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?