<%
'===============================================================
'FunctionForPJblog2
'更新时间:2006-6-2
'===============================================================
'*************************************
'防止外部提交
'*************************************
functionChkPost()
dimserver_v1,server_v2
chkpost=false
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
IfMid(server_v1,8,Len(server_v2))<>server_v2then
chkpost=False
else
chkpost=True
endIf
endfunction
'*************************************
'IP过滤
'*************************************
functionMatchIP(IP)
onerrorresumenext
MatchIP=false
DimSIp,SplitIP
foreachSIpinFilterIP
SIp=replace(SIp,"*","d*")
SplitIP=split(SIp,".")
Dimre,strMatchs,strIP
Setre=newRegExp
re.IgnoreCase=True
re.Global=True
re.Pattern="("&SplitIP(0)&"|)."&"("&SplitIP(1)&"|)."&"("&SplitIP(2)&"|)."&"("&SplitIP(3)&"|)"
SetstrMatchs=re.Execute(IP)
strIP=strMatchs(0).SubMatches(0)&"."&strMatchs(0).SubMatches(1)&"."&strMatchs(0).SubMatches(2)&"."&strMatchs(0).SubMatches(3)
ifstrIP=IPthenMatchIP=true:exitfunction
SetstrMatchs=Nothing
Setre=Nothing
next
endfunction
'*************************************
'获得注册码
'*************************************
Functiongetcode()
getcode="<imgsrc=""common/getcode.asp""alt=""""style=""margin-right:40px;""/>"
EndFunction
'*************************************
'限制上传文件类型
'*************************************
FunctionIsvalidFile(File_Type)
IsvalidFile=False
DimGName
ForEachGNameinUP_FileType
IfFile_Type=GNameThen
IsvalidFile=True
ExitFor
EndIf
Next
EndFunction
'*************************************
'限制插件名称
'*************************************
FunctionIsvalidPlugins(Plugins_Name)
dimNoAllowNames,NoAllowName
NoAllowNames="user,bloginfo,calendar,comment,search,links,archive,category,contentlist"
NoAllowName=split(NoAllowNames,",")
IsvalidPlugins=true
DimGName
Plugins_Name=trim(lcase(Plugins_Name))
ForEachGNameinNoAllowName
IfPlugins_Name=GNameThen
IsvalidPlugins=false
ExitFor
EndIf
Next
EndFunction
'*************************************
'检测是否只包含英文和数字
'*************************************
FunctionIsValidChars(str)
Dimre,chkstr
Setre=newRegExp
re.IgnoreCase=true
re.Global=True
re.Pattern="[^_.a-zA-Zd]"
IsValidChars=True
chkstr=re.Replace(str,"")
ifchkstr<>strthenIsValidChars=False
setre=nothing
EndFunction
'*************************************
'检测是否只包含英文和数字
'*************************************
FunctionIsvalidValue(ArrayN,Str)
IsvalidValue=false
DimGName
ForEachGNameinArrayN
IfStr=GNameThen
IsvalidValue=true
ExitFor
EndIf
Next
EndFunction
'*************************************
'检测是否有效的数字
'*************************************
FunctionIsInteger(Para)
IsInteger=False
IfNot(IsNull(Para)OrTrim(Para)=""OrNotIsNumeric(Para))Then
IsInteger=True
EndIf
EndFunction
'*************************************
'用户名检测
'*************************************
FunctionIsValidUserName(byValUserName)
onerrorresumenext
Dimi,c
DimVUserName
IsValidUserName=True
Fori=1ToLen(UserName)
c=Lcase(Mid(UserName,i,1))
IfInStr("$!<>?#^%@~`&*();:+='""",c)>0Then
IsValidUserName=False
ExitFunction
EndIF
Next
ForEachVUserNameinRegister_UserName
IfUserName=VUserNameThen
IsValidUserName=False
ExitFor
EndIf
Next
EndFunction
'*************************************
'检测是否有效的E-mail地址
'*************************************
FunctionIsValidEmail(Email)
Dimnames,name,i,c
IsValidEmail=True
Names=Split(email,"@")
IfUBound(names)<>1Then
IsValidEmail=False
ExitFunction
EndIf
ForEachnameINnames
IfLen(name)<=0Then
IsValidEmail=False
ExitFunction
EndIf
Fori=1toLen(name)
c=Lcase(Mid(name,i,1))
IfInStr("abcdefghijklmnopqrstuvwxyz_-.",c)<=0AndNotIsNumeric(c)Then
IsValidEmail=false
ExitFunction
EndIf
Next
IfLeft(name,1)="."orRight(name,1)="."Then
IsValidEmail=false
ExitFunction
EndIf
Next
IfInStr(names(1),".")<=0Then
IsValidEmail=False
ExitFunction
EndIf
i=Len(names(1))-InStrRev(names(1),".")
Ifi<>2Andi<>3Then
IsValidEmail=False
ExitFunction
EndIf
IfInStr(email,"..")>0Then
IsValidEmail=False
EndIf
EndFunction
'*************************************
'加亮关键字
'*************************************
Functionhighlight(byValstrContent,byRefarrayWords)
DimintCounter,strTemp,intPos,intTagLength,intKeyWordLength,bUpdate
iflen(arrayWords)<1thenhighlight=strContent:exitfunction
ForintPos=1toLen(strContent)
bUpdate=False
IfMid(strContent,intPos,1)="<"Then
OnErrorResumeNext
intTagLength=(InStr(intPos,strContent,">",1)-intPos)
iferrthen
highlight=strContent
err.clear
endif
strTemp=strTemp&Mid(strContent,intPos,intTagLength)
intPos=intPos+intTagLength
EndIf
IfarrayWords<>""Then
intKeyWordLength=Len(arrayWords)
IfLCase(Mid(strContent,intPos,intKeyWordLength))=LCase(arrayWords)Then
strTemp=strTemp&"<spanclass=""high1"">"&Mid(strContent,intPos,intKeyWordLength)&"</span>"
intPos=intPos+intKeyWordLength-1
bUpdate=True
EndIf
EndIf
IfbUpdate=FalseThen
strTemp=strTemp&Mid(strContent,intPos,1)
EndIf
Next
highlight=strTemp
EndFunction
'*************************************
'过滤超链接
'*************************************
FunctioncheckURL(ByValChkStr)
Dimstr:str=ChkStr
str=Trim(str)
IfIsNull(str)Then
checkURL=""
ExitFunction
EndIf
Dimre
Setre=newRegExp
re.IgnoreCase=True
re.Global=True
re.Pattern="(d)(ocument.cookie)"
Str=re.replace(Str,"$1ocumentcookie")
re.Pattern="(d)(ocument.write)"
Str=re.replace(Str,"$1ocumentwrite")
re.Pattern="(s)(cript:)"
Str=re.replace(Str,"$1cri")
re.Pattern="(s)(cript)"
Str=re.replace(Str,"$1cri")
re.Pattern="(o)(bject)"
Str=re.replace(Str,"$1bj")
re.Pattern="(a)(pplet)"
Str=re.replace(Str,"$1ppl")
re.Pattern="(e)(mbed)"
Str=re.replace(Str,"$1mb")
Setre=Nothing
Str=Replace(Str,">",">")
Str=Replace(Str,"<","<")
checkURL=Str
endfunction
'*************************************
'过滤文件名字
'*************************************
FunctionFixName(UpFileExt)
IfIsEmpty(UpFileExt)ThenExitFunction
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","")
EndFunction
'*************************************
'过滤特殊字符
'*************************************
FunctionCheckStr(byValChkStr)
DimStr:Str=ChkStr
IfIsNull(Str)Then
CheckStr=""
ExitFunction
EndIf
Str=Replace(Str,"&","&")
Str=Replace(Str,"'","")
Str=Replace(Str,"""","")
Dimre
Setre=newRegExp
re.IgnoreCase=True
re.Global=True
re.Pattern="(w)(here)"
Str=re.replace(Str,"$1h")
re.Pattern="(s)(elect)"
Str=re.replace(Str,"$1el")
re.Pattern="(i)(nsert)"
Str=re.replace(Str,"$1ns")
re.Pattern="(c)(reate)"
Str=re.replace(Str,"$1r")
re.Pattern="(d)(rop)"
Str=re.replace(Str,"$1ro")
re.Pattern="(a)(lter)"
Str=re.replace(Str,"$1lt")
re.Pattern="(d)(elete)"
Str=re.replace(Str,"$1el")
re.Pattern="(u)(pdate)"
Str=re.replace(Str,"$1p")
re.Pattern="(s)(or)"
Str=re.replace(Str,"$1o")
Setre=Nothing
CheckStr=Str
EndFunction
'*************************************
'恢复特殊字符
'*************************************
FunctionUnCheckStr(ByValStr)
IfIsNull(Str)Then
UnCheckStr=""
ExitFunction
EndIf
Str=Replace(Str,"")
Str=Replace(Str,"")
Dimre
Setre=newRegExp
re.IgnoreCase=True
re.Global=True
re.Pattern="(w)(h"
str=re.replace(str,"$1here")
re.Pattern="(s)(el"
str=re.replace(str,"$1elect")
re.Pattern="(i)(ns"
str=re.replace(str,"$1nsert")
re.Pattern="(c)(r"
str=re.replace(str,"$1reate")
re.Pattern="(d)(ro"
str=re.replace(str,"$1rop")
re.Pattern="(a)(lt"
str=re.replace(str,"$1lter")
re.Pattern="(d)(el"
str=re.replace(str,"$1elete")
re.Pattern="(u)(p"
str=re.replace(str,"$1pdate")
re.Pattern="(s)(o"
Str=re.replace(Str,"$1or")
Setre=Nothing
Str=Replace(Str,"&","&")
UnCheckStr=Str
EndFunction
'*************************************
'转换HTML代码
'*************************************
FunctionHTMLEncode(ByValreString)
DimStr:Str=reString
IfNotIsNull(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
EndIf
EndFunction
'*************************************
'转换最新评论和日志HTML代码
'*************************************
FunctionCCEncode(ByValreString)
DimStr:Str=reString
IfNotIsNull(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
EndIf
EndFunction
'*************************************
'反转换HTML代码
'*************************************
FunctionHTMLDecode(ByValreString)
DimStr:Str=reString
IfNotIsNull(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
EndIf
EndFunction
'*************************************
'恢复&字符
'*************************************
functionClearHTML(ByValreString)
DimStr:Str=reString
IfNotIsNull(Str)Then
Str=Replace(Str,"&","&")
ClearHTML=Str
EndIf
EndFunction
'*************************************
'过滤textarea
'*************************************
FunctionUBBFilter(ByValreString)
DimStr:Str=reString
IfNotIsNull(Str)Then
Str=Replace(Str,"</textarea>","<")
UBBFilter=Str
EndIf
EndFunction
'*************************************
'过滤HTML代码
'*************************************
FunctionEditDeHTML(byValContent)
EditDeHTML=Content
IFNotIsNull(EditDeHTML)Then
EditDeHTML=UnCheckStr(EditDeHTML)
EditDeHTML=Replace(EditDeHTML,"&","&")
EditDeHTML=Replace(EditDeHTML,"<","<")
EditDeHTML=Replace(EditDeHTML,">",">")
EditDeHTML=Replace(EditDeHTML,chr(34),""")
EditDeHTML=Replace(EditDeHTML,chr(39),"")
EndIF
EndFunction
'*************************************
'日期转换函数
'*************************************
FunctionDateToStr(DateTime,ShowType)
DimDateMonth,DateDay,DateHour,DateMinute,DateWeek,DateSecond
DimFullWeekday,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)
IfLen(DateMonth)<2ThenDateMonth="0"&DateMonth
IfLen(DateDay)<2ThenDateDay="0"&DateDay
IfLen(DateMinute)<2ThenDateMinute="0"&DateMinute
SelectCaseShowType
Case"Y-m-d"
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
Case"Y-m-dH:IA"
DimDateAMPM
IfDateHour>12Then
DateHour=DateHour-12
DateAMPM="PM"
Else
DateHour=DateHour
DateAMPM="AM"
EndIf
IfLen(DateHour)<2ThenDateHour="0"&DateHour
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&""&DateHour&":"&DateMinute&""&DateAMPM
Case"Y-m-dH:I:S"
IfLen(DateHour)<2ThenDateHour="0"&DateHour
IfLen(DateSecond)<2ThenDateSecond="0"&DateSecond
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&""&DateHour&":"&DateMinute&":"&DateSecond
Case"YmdHIS"
DateSecond=Second(DateTime)
IfLen(DateHour)<2ThenDateHour="0"&DateHour
IfLen(DateSecond)<2ThenDateSecond="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"
DimDayEnd
selectCaseDateDay
Case1
DayEnd="st"
Case2
DayEnd="nd"
Case3
DayEnd="rd"
CaseElse
DayEnd="th"
EndSelect
DateToStr=Fullmonth(DateMonth-1)&""&DateDay&DayEnd&""&Right(Year(DateTime),4)
Case"w,dmyH:I:S"
DateSecond=Second(DateTime)
IfLen(DateHour)<2ThenDateHour="0"&DateHour
IfLen(DateSecond)<2ThenDateSecond="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"
IfLen(DateHour)<2ThenDateHour="0"&DateHour
IfLen(DateSecond)<2ThenDateSecond="0"&DateSecond
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&"T"&DateHour&":"&DateMinute&":"&DateSecond&TimeZone2
CaseElse
IfLen(DateHour)<2ThenDateHour="0"&DateHour
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&""&DateHour&":"&DateMinute
EndSelect
EndFunction
'*************************************
'分页函数
'*************************************
dimFirstShortCut,ShortCut
FirstShortCut=false
FunctionMultiPage(Numbers,Perpage,Curpage,Url_Add,aname,Style)
CurPage=Int(Curpage)
Numbers=Int(Numbers)
DimURL
URL=Request.ServerVariables("Script_Name")&Url_Add
MultiPage=""
DimPage,Offset,PageI
'IfInt(Numbers)>Int(PerPage)Then
Page=9
Offset=4
DimPages,FromPage,ToPage
IfNumbersModCint(Perpage)=0Then
Pages=Int(Numbers/Perpage)
Else
Pages=Int(Numbers/Perpage)+1
EndIf
FromPage=Curpage-Offset
ToPage=Curpage+Page-Offset-1
IfPage>PagesThen
FromPage=1
ToPage=Pages
Else
IfFromPage<1Then
Topage=Curpage+1-FromPage
FromPage=1
If(ToPage-FromPage)<PageAnd(ToPage-FromPage)<PagesThenToPage=Page
ElseIFTopage>PagesThen
FromPage=Curpage-Pages+ToPage
ToPage=Pages
If(ToPage-FromPage)<PageAnd(ToPage-FromPage)<PagesThenFromPage=Pages-Page+1
EndIf
EndIf
MultiPage="<divclass=""page""style="""&Style&"""><ul>"
'ifCurpage<>1thenMultiPage=MultiPage&"<liclass=""PageL""><ahref="""&Url&"page=1""class=""PageLbutton""title=""第一页""></a></li>"
MultiPage=MultiPage&"<liclass=""pageNumber"">"
ifCurpage<>1thenMultiPage=MultiPage&"<ahref="""&Url&"page=1""title=""第一页""style=""text-decoration:none""><</a>|"
ifnotFirstShortCutthenShortCut="accesskey="","""elseShortCut=""
ifCurpage<>1thenMultiPage=MultiPage&"<ahref="""&Url&"page="&CurPage-1&"""title=""上一页""style=""text-decoration:none;"""&ShortCut&"></a>"
ForPageI=FromPageTOToPage
IfPageI<>CurPageThen
MultiPage=MultiPage&"<ahref="""&Url&"page="&PageI&aname&""">"&PageI&"</a>|"
Else
MultiPage=MultiPage&"<strong>"&PageI&"</strong>"
ifPageI<>PagesthenMultiPage=MultiPage&"|"
EndIf
Next
ifnotFirstShortCutthenShortCut="accesskey=""."""elseShortCut=""
ifCurpage<>pagesthenMultiPage=MultiPage&"<ahref="""&Url&"page="&CurPage+1&"""title=""下一页""style=""text-decoration:none"""&ShortCut&"></a>"
ifCurpage<>pagesthenMultiPage=MultiPage&"<ahref="""&Url&"page="&Pages&aname&"""title=""最后一页""style=""text-decoration:none"">></a>"
MultiPage=MultiPage&"</li>"
'IfInt(Pages)>Int(Page)Then
'MultiPage=MultiPage&"<li>...</li><li><ahref="""&Url&"page="&Pages&aname&""">"&pages&"</a></li>"
'EndIf
'ifCurpage<>pagesthenMultiPage=MultiPage&"<liclass=""PageR""><ahref="""&Url&"page="&Pages&aname&"""class=""PageRbutton""title=""最后一页""></a></li>"
MultiPage=MultiPage&"</ul></div>"
'EndIf
FirstShortCut=true
EndFunction
'*************************************
'切割内容-按行分割
'*************************************
FunctionSplitLines(byValContent,byValContentNums)
Dimts,i,l
ContentNums=int(ContentNums)
IfIsNull(Content)ThenExitFunction
i=1
ts=0
Fori=1toLen(Content)
l=Lcase(Mid(Content,i,5))
Ifl="<br/>"Then
ts=ts+1
EndIf
l=Lcase(Mid(Content,i,4))
Ifl="<br>"Then
ts=ts+1
EndIf
l=Lcase(Mid(Content,i,3))
Ifl="<p>"Then
ts=ts+1
EndIf
Ifts>ContentNumsThenExitFor
Next
Ifts>ContentNumsThen
Content=Left(Content,i-1)
EndIf
SplitLines=Content
EndFunction
当前1/2页12下一页阅读全文
【pjblog2的参数第1/2页】相关文章：
★ ASP类的写法