pjblog2的参数第12页

　　<%
===============================================================
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.aspalt=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-Z\d]
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
Str=re.replace(Str,$1ocumentcookie)
re.Pattern=(d)(ocument\.write)
Str=re.replace(Str,$1ocumentwrite)
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)
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,$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)
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)(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)
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>,</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
CaseY-m-d
DateToStr=Year(DateTime)&-&DateMonth&-&DateDay
CaseY-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
CaseY-m-dH:I:S
IfLen(DateHour)<2ThenDateHour=0&DateHour
IfLen(DateSecond)<2ThenDateSecond=0&DateSecond
DateToStr=Year(DateTime)&-&DateMonth&-&DateDay&&DateHour&:&DateMinute&:&DateSecond
CaseYmdHIS
DateSecond=Second(DateTime)
IfLen(DateHour)<2ThenDateHour=0&DateHour
IfLen(DateSecond)<2ThenDateSecond=0&DateSecond
DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond
Caseym
DateToStr=Right(Year(DateTime),2)&DateMonth
Cased
DateToStr=DateDay
Caseymd
DateToStr=Right(Year(DateTime),4)&DateMonth&DateDay
Casemdy
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)
Casew,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
Casey-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=pagestyle=&Style&><ul>
ifCurpage<>1thenMultiPage=MultiPage&<liclass=PageL><ahref=&Url&page=1class=PageLbuttontitle=第一页></a></li>
MultiPage=MultiPage&<liclass=pageNumber>
ifCurpage<>1thenMultiPage=MultiPage&<ahref=&Url&page=1title=第一页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=PageRbuttontitle=最后一页></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
12下一页阅读全文