pjblog2的参数第1/2页

<% 
'===============================================================
'  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