欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

pjblog2的参数第1/2页

程序员文章站 2022-05-28 16:08:03
<%  '=============================================================== ' &n...
<% 
'===============================================================
'  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