<%
'===============================================================
' 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-z\d]"
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
1
如对本文有疑问，
点击进行留言回复！！
我要评论
网友评论