<% '=============================================================== ' Function For PJblog2 ' 更新时间: 2006-6-2 '=============================================================== '************************************* '防止外部提交 '************************************* function ChkPost() dim server_v1,server_v2 chkpost=false 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 chkpost=False else chkpost=True end If end function '************************************* 'IP过滤 '************************************* function MatchIP(IP) on error resume next MatchIP=false Dim SIp,SplitIP for each SIp in FilterIP SIp=replace(SIp,"*","d*") SplitIP=split(SIp,".") Dim re, strMatchs,strIP Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern="("&SplitIP(0)&"|)."&"("&SplitIP(1)&"|)."&"("&SplitIP(2)&"|)."&"("&SplitIP(3)&"|)" Set strMatchs=re.Execute(IP) strIP=strMatchs(0).SubMatches(0) & "." & strMatchs(0).SubMatches(1)& "." & strMatchs(0).SubMatches(2)& "." & strMatchs(0).SubMatches(3) if strIP=IP then MatchIP=true:exit function Set strMatchs=Nothing Set re=Nothing next end function '************************************* '获得注册码 '************************************* Function getcode() getcode= "<img src=""common/getcode.asp"" alt="""" style=""margin-right:40px;""/>" End Function '************************************* '限制上传文件类型 '************************************* 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 IsvalidPlugins(Plugins_Name) dim NoAllowNames,NoAllowName NoAllowNames="user,bloginfo,calendar,comment,search,links,archive,category,contentlist" NoAllowName=split(NoAllowNames,",") IsvalidPlugins = true Dim GName Plugins_Name=trim(lcase(Plugins_Name)) For Each GName in NoAllowName If Plugins_Name = GName Then IsvalidPlugins = false Exit For End If Next End Function '************************************* '检测是否只包含英文和数字 '************************************* Function IsValidChars(str) Dim re,chkstr Set re=new RegExp re.IgnoreCase =true re.Global=True re.Pattern="[^_.a-zA-Zd]" IsValidChars=True chkstr=re.Replace(str,"") if chkstr<>str then IsValidChars=False set re=nothing End Function '************************************* '检测是否只包含英文和数字 '************************************* Function IsvalidValue(ArrayN,Str) IsvalidValue = false Dim GName For Each GName in ArrayN If Str = GName Then IsvalidValue = 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 IsValidUserName(byVal UserName) on error resume next 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 Register_UserName If UserName = VUserName Then IsValidUserName = False 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 '************************************* '加亮关键字 '************************************* Function highlight(byVal strContent,byRef arrayWords) Dim intCounter,strTemp,intPos,intTagLength,intKeyWordLength,bUpdate if len(arrayWords)<1 then highlight=strContent:exit function For intPos = 1 to Len(strContent) bUpdate = False If Mid(strContent, intPos, 1) = "<" Then On Error Resume Next intTagLength = (InStr(intPos, strContent, ">", 1) - intPos) if err then highlight=strContent err.clear end if strTemp = strTemp & Mid(strContent, intPos, intTagLength) intPos = intPos + intTagLength End If If arrayWords <> "" Then intKeyWordLength = Len(arrayWords) If LCase(Mid(strContent, intPos, intKeyWordLength)) = LCase(arrayWords) Then strTemp = strTemp & "<span class=""high1"">" & Mid(strContent, intPos, intKeyWordLength) & "</span>" intPos = intPos + intKeyWordLength - 1 bUpdate = True End If End If If bUpdate = False Then strTemp = strTemp & Mid(strContent, intPos, 1) End If Next highlight = strTemp End Function '************************************* '过滤超链接 '************************************* Function checkURL(ByVal ChkStr) Dim str:str=ChkStr str=Trim(str) If IsNull(str) Then checkURL = "" Exit Function End If Dim re Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern="(d)(ocument.cookie)" Str = re.replace(Str,"$1ocument cookie") re.Pattern="(d)(ocument.write)" Str = re.replace(Str,"$1ocument write") re.Pattern="(s)(cript:)" Str = re.replace(Str,"$1cript ") re.Pattern="(s)(cript)" Str = re.replace(Str,"$1cript") re.Pattern="(o)(bject)" Str = re.replace(Str,"$1bject") re.Pattern="(a)(pplet)" Str = re.replace(Str,"$1pplet") re.Pattern="(e)(mbed)" Str = re.replace(Str,"$1mbed") Set re=Nothing Str = Replace(Str, ">", ">") Str = Replace(Str, "<", "<") checkURL=Str end function '************************************* '过滤文件名字 '************************************* Function FixName(UpFileExt) If IsEmpty(UpFileExt) Then Exit Function FixName = Ucase(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 '************************************* '过滤特殊字符 '************************************* Function CheckStr(byVal ChkStr) Dim Str:Str=ChkStr If IsNull(Str) Then CheckStr = "" Exit Function End If Str = Replace(Str, "&", "&") Str = Replace(Str,"'","'") Str = Replace(Str,"""",""") Dim re Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern="(w)(here)" Str = re.replace(Str,"$1here") re.Pattern="(s)(elect)" Str = re.replace(Str,"$1elect") re.Pattern="(i)(nsert)" Str = re.replace(Str,"$1nsert") re.Pattern="(c)(reate)" Str = re.replace(Str,"$1reate") re.Pattern="(d)(rop)" Str = re.replace(Str,"$1rop") re.Pattern="(a)(lter)" Str = re.replace(Str,"$1lter") re.Pattern="(d)(elete)" Str = re.replace(Str,"$1elete") re.Pattern="(u)(pdate)" Str = re.replace(Str,"$1pdate") re.Pattern="(s)(or)" Str = re.replace(Str,"$1or") Set re=Nothing CheckStr=Str End Function '************************************* '恢复特殊字符 '************************************* Function UnCheckStr(ByVal Str) If IsNull(Str) Then UnCheckStr = "" Exit Function End If Str = Replace(Str,"'","'") Str = Replace(Str,""","""") Dim re Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern="(w)(here)" str = re.replace(str,"$1here") re.Pattern="(s)(elect)" str = re.replace(str,"$1elect") re.Pattern="(i)(nsert)" str = re.replace(str,"$1nsert") re.Pattern="(c)(reate)" str = re.replace(str,"$1reate") re.Pattern="(d)(rop)" str = re.replace(str,"$1rop") re.Pattern="(a)(lter)" str = re.replace(str,"$1lter") re.Pattern="(d)(elete)" str = re.replace(str,"$1elete") re.Pattern="(u)(pdate)" str = re.replace(str,"$1pdate") re.Pattern="(s)(or)" Str = re.replace(Str,"$1or") Set re=Nothing Str = Replace(Str, "&", "&") UnCheckStr=Str End Function '************************************* '转换HTML代码 '************************************* Function HTMLEncode(ByVal reString) Dim Str:Str=reString If Not IsNull(Str) Then Str = Replace(Str, ">", ">") Str = Replace(Str, "<", "<") Str = Replace(Str, CHR(9), "    ") Str = Replace(Str, CHR(39), "'") Str = Replace(Str, CHR(32)&CHR(32), " ") Str = Replace(Str, CHR(34), """) Str = Replace(Str, CHR(13), "") Str = Replace(Str, CHR(10), "<br/>") HTMLEncode = Str End If End Function '************************************* '转换最新评论和日志HTML代码 '************************************* Function CCEncode(ByVal reString) Dim Str:Str=reString If Not IsNull(Str) Then Str = Replace(Str, ">", ">") Str = Replace(Str, "<", "<") Str = Replace(Str, CHR(9), "    ") Str = Replace(Str, CHR(39), "'") Str = Replace(Str, CHR(32)&CHR(32), " ") Str = Replace(Str, CHR(34), """) Str = Replace(Str, CHR(13), "") Str = Replace(Str, CHR(10), " ") CCEncode = Str End If End Function '************************************* '反转换HTML代码 '************************************* Function HTMLDecode(ByVal reString) Dim Str:Str=reString If Not IsNull(Str) Then Str = Replace(Str, ">", ">") Str = Replace(Str, "<", "<") Str = Replace(Str, "    ", CHR(9)) Str = Replace(Str, "'", CHR(39)) Str = Replace(Str, " ",CHR(32)&CHR(32)) Str = Replace(Str, """, CHR(34)) Str = Replace(Str, "", CHR(13)) Str = Replace(Str, "<br/>", CHR(10)) HTMLDecode = Str End If End Function '************************************* '恢复&字符 '************************************* function ClearHTML(ByVal reString) Dim Str:Str=reString If Not IsNull(Str) Then Str = Replace(Str, "&", "&") ClearHTML = Str End If End Function '************************************* '过滤textarea '************************************* Function UBBFilter(ByVal reString) Dim Str:Str=reString If Not IsNull(Str) Then Str = Replace(Str, "</textarea>", "</textarea>") UBBFilter = Str End If End Function '************************************* '过滤HTML代码 '************************************* Function EditDeHTML(byVal Content) EditDeHTML=Content IF Not IsNull(EditDeHTML) Then EditDeHTML=UnCheckStr(EditDeHTML) EditDeHTML=Replace(EditDeHTML,"&","&") EditDeHTML=Replace(EditDeHTML,"<","<") EditDeHTML=Replace(EditDeHTML,">",">") EditDeHTML=Replace(EditDeHTML,chr(34),""") EditDeHTML=Replace(EditDeHTML,chr(39),"'") End IF End Function '************************************* '日期转换函数 '************************************* Function DateToStr(DateTime,ShowType) Dim DateMonth,DateDay,DateHour,DateMinute,DateWeek,DateSecond Dim FullWeekday,shortWeekday,Fullmonth,Shortmonth,TimeZone1,TimeZone2 TimeZone1="+0800" TimeZone2="+08:00" FullWeekday=Array("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday") shortWeekday=Array("Sun","Mon","Tue","Wed","Thu","Fri","Sat") Fullmonth=Array("January","February","March","April","May","June","July","August","September","October","November","December") Shortmonth=Array("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec") DateMonth=Month(DateTime) DateDay=Day(DateTime) DateHour=Hour(DateTime) DateMinute=Minute(DateTime) DateWeek=weekday(DateTime) DateSecond=Second(DateTime) If Len(DateMonth)<2 Then DateMonth="0"&DateMonth If Len(DateDay)<2 Then DateDay="0"&DateDay If Len(DateMinute)<2 Then DateMinute="0"&DateMinute 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 DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM Case "Y-m-d H:I:S" If Len(DateHour)<2 Then DateHour="0"&DateHour 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(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 "ymd" DateToStr=Right(Year(DateTime),4)&DateMonth&DateDay Case "mdy" Dim DayEnd select Case DateDay Case 1 DayEnd="st" Case 2 DayEnd="nd" Case 3 DayEnd="rd" Case Else DayEnd="th" End Select DateToStr=Fullmonth(DateMonth-1)&" "&DateDay&DayEnd&" "&Right(Year(DateTime),4) Case "w,d m y H:I:S" DateSecond=Second(DateTime) If Len(DateHour)<2 Then DateHour="0"&DateHour If Len(DateSecond)<2 Then DateSecond="0"&DateSecond DateToStr=shortWeekday(DateWeek-1)&","&DateDay&" "& Left(Fullmonth(DateMonth-1),3) &" "&Right(Year(DateTime),4)&" "&DateHour&":"&DateMinute&":"&DateSecond&" "&TimeZone1 Case "y-m-dTH:I:S" If Len(DateHour)<2 Then DateHour="0"&DateHour If Len(DateSecond)<2 Then DateSecond="0"&DateSecond DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&"T"&DateHour&":"&DateMinute&":"&DateSecond&TimeZone2 Case Else If Len(DateHour)<2 Then DateHour="0"&DateHour DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute End Select End Function '************************************* '分页函数 '************************************* dim FirstShortCut,ShortCut FirstShortCut=false Function MultiPage(Numbers,Perpage,Curpage,Url_Add,aname,Style) CurPage=Int(Curpage) Numbers=Int(Numbers) Dim URL URL=Request.ServerVariables("Script_Name")&Url_Add MultiPage="" Dim Page,Offset,PageI ' If Int(Numbers)>Int(PerPage) Then Page=9 Offset=4 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="<div class=""page"" style="""&Style&"""><ul>" 'if Curpage<>1 then MultiPage=MultiPage&"<li class=""PageL""><a href="""&Url&"page=1"" class=""PageLbutton"" title=""第一页""></a></li>" MultiPage=MultiPage&"<li class=""pageNumber"">" if Curpage<>1 then MultiPage=MultiPage&"<a href="""&Url&"page=1"" title=""第一页"" style=""text-decoration:none""><</a> | " if not FirstShortCut then ShortCut=" accesskey="",""" else ShortCut="" if Curpage<>1 then MultiPage=MultiPage&"<a href="""&Url&"page="&CurPage-1&""" title=""上一页"" style=""text-decoration:none;"""&ShortCut&"></a>" For PageI=FromPage TO ToPage If PageI<>CurPage Then MultiPage=MultiPage&"<a href="""&Url&"page="&PageI&aname&""">"&PageI&"</a> | " Else MultiPage=MultiPage&"<strong>"&PageI&"</strong>" if PageI<>Pages then MultiPage=MultiPage&" | " End If Next if not FirstShortCut then ShortCut=" accesskey="".""" else ShortCut="" if Curpage<>pages then MultiPage=MultiPage&"<a href="""&Url&"page="&CurPage+1&""" title=""下一页"" style=""text-decoration:none"""&ShortCut&"></a>" if Curpage<>pages then MultiPage=MultiPage&"<a href="""&Url&"page="&Pages&aname&""" title=""最后一页"" style=""text-decoration:none"">></a>" MultiPage=MultiPage&"</li>" 'If Int(Pages)>Int(Page) Then ' MultiPage=MultiPage&"<li>...</li><li><a href="""&Url&"page="&Pages&aname&""">"&pages&"</a></li>" 'End If 'if Curpage<>pages then MultiPage=MultiPage&"<li class=""PageR""><a href="""&Url&"page="&Pages&aname&""" class=""PageRbutton"" title=""最后一页""></a></li>" MultiPage=MultiPage&"</ul></div>" ' End If FirstShortCut=true End Function '************************************* '切割内容 - 按行分割 '************************************* Function SplitLines(byVal Content,byVal ContentNums) Dim ts,i,l ContentNums=int(ContentNums) If IsNull(Content) Then Exit Function i=1 ts = 0 For i=1 to Len(Content) l=Lcase(Mid(Content,i,5)) If l="<br/>" Then ts=ts+1 End If l=Lcase(Mid(Content,i,4)) If l="<br>" Then ts=ts+1 End If l=Lcase(Mid(Content,i,3)) If l="<p>" 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

　　推荐阅读

　　Mssql高级注入笔记II

一些sql扩展 xp_regaddmultistring xp_regdeletekey 删除键名 xp_regdeletevalue 删除键值 xp_regenumkeys 枚举 xp_regenumvalues xp_regread 对于 xp_regremovemultistring xp_regwrite 写 xp_available>>>详细阅读

本文标题：pjblog2的参数第1/2页

地址：http://www.17bianji.com/kaifa2/ASP/33219.html

 1/2    1