当前位置: 移动技术网 > IT编程>开发语言>Asp > pjblog2的参数第1/2页

pjblog2的参数第1/2页

2017年12月12日  | 移动技术网IT编程  | 我要评论
<%  '=============================================================== ' &n

'*************************************
'切割内容 - 按字符分割
'*************************************
function cutstr(byval str,byval strlen)
    dim l,t,c,i
    if isnull(str) then cutstr="":exit function
    l=len(str)
    strlen=int(strlen)
    t=0
    for i=1 to l
        c=asc(mid(str,i,1))
        if c<0 or c>255 then t=t+2 else t=t+1
        if t>=strlen then
            cutstr=left(str,i)&"..."
            exit for
        else
            cutstr=str
        end if
    next
end function

'*************************************
'trackback function
'*************************************
function trackback(trackback_url, url, title, excerpt, blog_name) 
    dim query_string, objxmlhttp

    query_string = "title="&cutstr(server.urlencode(title),100)&"&url="&server.urlencode(url)&"&blog_name="&server.urlencode(blog_name)&"&excerpt="&cutstr(server.urlencode(excerpt), 252)
    set objxmlhttp = server.createobject(getxmlhttp)

    objxmlhttp.open "post", trackback_url, false
    objxmlhttp.setrequestheader "content-type","application/x-www-form-urlencoded"

    'handling timeout
    on error resume next
    objxmlhttp.send query_string
    err.clear

    set objxmlhttp = nothing
end function


'*************************************
'删除引用标签
'*************************************
function delquote(strcontent)
    if isnull(strcontent) then exit function
    dim re
    set re=new regexp
    re.ignorecase =true
    re.global=true
    re.pattern="\[quote\](.[^\]]*?)\[\/quote\]"
    strcontent= re.replace(strcontent,"")
    re.pattern="\[quote=(.[^\]]*)\](.[^\]]*?)\[\/quote\]"
    strcontent= re.replace(strcontent,"")
    set re=nothing
    delquote=strcontent
end function

'*************************************
'获取客户端ip
'*************************************
function getip() 
         dim strip,ip_ary,strip_list
         strip_list=replace(request.servervariables("http_x_forwarded_for"),"'","")

         if instr(strip_list,",")<>0 then
            ip_ary = split(strip_list,",")
            strip = ip_ary(0)
         else
            strip = strip_list
         end if

         if strip=empty then strip=replace(request.servervariables("remote_addr"),"'","")
         getip=strip
end function


'*************************************
'获取客户端浏览器信息
'*************************************
function getbrowser(strua) 
 dim arrinfo,strtype,temp1,temp2
 strtype=""
 strua=lcase(strua)
 arrinfo=array("unkown","unkown")
 '浏览器判断
    if instr(strua,"mozilla")>0 then arrinfo(0)="mozilla"
    if instr(strua,"icab")>0 then arrinfo(0)="icab"
    if instr(strua,"lynx")>0 then arrinfo(0)="lynx"
    if instr(strua,"links")>0 then arrinfo(0)="links"
    if instr(strua,"elinks")>0 then arrinfo(0)="elinks"
    if instr(strua,"jbrowser")>0 then arrinfo(0)="jbrowser"
    if instr(strua,"konqueror")>0 then arrinfo(0)="konqueror"
    if instr(strua,"wget")>0 then arrinfo(0)="wget"
    if instr(strua,"ask jeeves")>0 or instr(strua,"teoma")>0 then arrinfo(0)="ask jeeves/teoma"
    if instr(strua,"wget")>0 then arrinfo(0)="wget"
    if instr(strua,"opera")>0 then arrinfo(0)="opera"

    if instr(strua,"gecko")>0 then 
      strtype="[gecko]"
      arrinfo(0)="mozilla"
      if instr(strua,"aol")>0 then arrinfo(0)="aol"
      if instr(strua,"netscape")>0 then arrinfo(0)="netscape"
      if instr(strua,"firefox")>0 then arrinfo(0)="firefox"
      if instr(strua,"chimera")>0 then arrinfo(0)="chimera"
      if instr(strua,"camino")>0 then arrinfo(0)="camino"
      if instr(strua,"galeon")>0 then arrinfo(0)="galeon"
      if instr(strua,"k-meleon")>0 then arrinfo(0)="k-meleon"
      arrinfo(0)=arrinfo(0)+strtype
   end if

   if instr(strua,"bot")>0 or instr(strua,"crawl")>0 then 
      strtype="[bot/crawler]"
      arrinfo(0)=""
      if instr(strua,"grub")>0 then arrinfo(0)="grub"
      if instr(strua,"googlebot")>0 then arrinfo(0)="googlebot"
      if instr(strua,"msnbot")>0 then arrinfo(0)="msn bot"
      if instr(strua,"slurp")>0 then arrinfo(0)="yahoo! slurp"
      arrinfo(0)=arrinfo(0)+strtype
  end if

  if instr(strua,"applewebkit")>0 then 
      strtype="[applewebkit]"
      arrinfo(0)=""
      if instr(strua,"omniweb")>0 then arrinfo(0)="omniweb"
      if instr(strua,"safari")>0 then arrinfo(0)="safari"
      arrinfo(0)=arrinfo(0)+strtype
  end if 

  if instr(strua,"msie")>0 then 
      strtype="[msie"
      temp1=mid(strua,(instr(strua,"msie")+4),6)
      temp2=instr(temp1,";")
      temp1=left(temp1,temp2-1)
      strtype=strtype & temp1 &"]"
      arrinfo(0)="internet explorer"
      if instr(strua,"msn")>0 then arrinfo(0)="msn"
      if instr(strua,"aol")>0 then arrinfo(0)="aol"
      if instr(strua,"webtv")>0 then arrinfo(0)="webtv"
      if instr(strua,"myie2")>0 then arrinfo(0)="myie2"
      if instr(strua,"maxthon")>0 then arrinfo(0)="maxthon"
      if instr(strua,"gosurf")>0 then arrinfo(0)="gosurf"
      if instr(strua,"netcaptor")>0 then arrinfo(0)="netcaptor"
      if instr(strua,"sleipnir")>0 then arrinfo(0)="sleipnir"
      if instr(strua,"avant browser")>0 then arrinfo(0)="avantbrowser"
      if instr(strua,"greenbrowser")>0 then arrinfo(0)="greenbrowser"
      if instr(strua,"slimbrowser")>0 then arrinfo(0)="slimbrowser"
      arrinfo(0)=arrinfo(0)+strtype
   end if

 '操作系统判断
    if instr(strua,"windows")>0 then arrinfo(1)="windows"
    if instr(strua,"windows ce")>0 then arrinfo(1)="windows ce"
    if instr(strua,"windows 95")>0 then arrinfo(1)="windows 95"
    if instr(strua,"win98")>0 then arrinfo(1)="windows 98"
    if instr(strua,"windows 98")>0 then arrinfo(1)="windows 98"
    if instr(strua,"windows 2000")>0 then arrinfo(1)="windows 2000"
    if instr(strua,"windows xp")>0 then arrinfo(1)="windows xp"

    if instr(strua,"windows nt")>0 then
      arrinfo(1)="windows nt"
      if instr(strua,"windows nt 5.0")>0 then arrinfo(1)="windows 2000"
      if instr(strua,"windows nt 5.1")>0 then arrinfo(1)="windows xp"
      if instr(strua,"windows nt 5.2")>0 then arrinfo(1)="windows 2003"
    end if
    if instr(strua,"x11")>0 or instr(strua,"unix")>0 then arrinfo(1)="unix"
    if instr(strua,"sunos")>0 or instr(strua,"sun os")>0 then arrinfo(1)="sun os"
    if instr(strua,"powerpc")>0 or instr(strua,"ppc")>0 then arrinfo(1)="powerpc"
    if instr(strua,"macintosh")>0 then arrinfo(1)="mac"
    if instr(strua,"mac osx")>0 then arrinfo(1)="macosx"
    if instr(strua,"freebsd")>0 then arrinfo(1)="freebsd"
    if instr(strua,"linux")>0 then arrinfo(1)="linux"
    if instr(strua,"palmsource")>0 or instr(strua,"palmos")>0 then arrinfo(1)="palmos"
    if instr(strua,"wap ")>0 then arrinfo(1)="wap"

 'arrinfo(0)=strua 
 getbrowser=arrinfo
end function

'*************************************
'计算随机数
'*************************************
function randomstr(intlength)
    dim strseed,seedlength,pos,str,i
    strseed = "abcdefghijklmnopqrstuvwxyz1234567890"
    seedlength=len(strseed)
    str=""
    randomize
    for i=1 to intlength
     str=str+mid(strseed,int(seedlength*rnd)+1,1)
    next
    randomstr=str
end function

'*************************************
'自动闭合ubb
'*************************************
function closeubb(strcontent)
  dim arrtags,i,openpos,closepos,re,strmatchs,j,match
    set re=new regexp
    re.ignorecase =true
    re.global=true
    arrtags=array("code","quote","list","color","align","font","size","b","i","u","html")
  for i=0 to ubound(arrtags)
   openpos=0
   closepos=0

   re.pattern="\["+arrtags(i)+"(=[^\[\]]+|)\]"
   set strmatchs=re.execute(strcontent)
   for each match in strmatchs
    openpos=openpos+1
   next
   re.pattern="\[/"+arrtags(i)+"\]"
   set strmatchs=re.execute(strcontent)
   for each match in strmatchs
    closepos=closepos+1
   next
   for j=1 to openpos-closepos
      strcontent=strcontent+"[/"+arrtags(i)+"]"
   next
  next
closeubb=strcontent
end function

'*************************************
'自动闭合html
'*************************************
function closehtml(strcontent)
  dim arrtags,i,openpos,closepos,re,strmatchs,j,match
    set re=new regexp
    re.ignorecase =true
    re.global=true
    arrtags=array("p","div","span","table","ul","font","b","u","i","h1","h2","h3","h4","h5","h6")
  for i=0 to ubound(arrtags)
   openpos=0
   closepos=0

   re.pattern="\<"+arrtags(i)+"( [^\<\>]+|)\>"
   set strmatchs=re.execute(strcontent)
   for each match in strmatchs
    openpos=openpos+1
   next
   re.pattern="\</"+arrtags(i)+"\>"
   set strmatchs=re.execute(strcontent)
   for each match in strmatchs
    closepos=closepos+1
   next
   for j=1 to openpos-closepos
      strcontent=strcontent+"</"+arrtags(i)+">"
   next
  next
closehtml=strcontent
end function

'*************************************
'读取文件
'*************************************
function loadfromfile(byval file)
    dim objstream
    dim rtext
    rtext=array(0,"")
    on error resume next
    set objstream = server.createobject("adodb.stream")
    if err then 
        rtext=array(err.number,err.description)
        loadfromfile=rtext
        err.clear
        exit function
    end if
    with objstream
        .type = 2
        .mode = 3
        .open
        .charset = "utf-8"
        .position = objstream.size
        .loadfromfile server.mappath(file)
        if err.number<>0 then
           rtext=array(err.number,err.description)
           loadfromfile=rtext
           err.clear
           exit function
        end if
        rtext=array(0,.readtext)
        .close
    end with
    loadfromfile=rtext
    set objstream = nothing
end function

'*************************************
'保存文件
'*************************************
function savetofile(byval strbody,byval file)
    dim objstream
    dim rtext
    rtext=array(0,"")
    on error resume next
    set objstream = server.createobject("adodb.stream")
    if err then 
        rtext=array(err.number,err.description)
        err.clear
        exit function
    end if
    with objstream
        .type = 2
        .open
        .charset = "utf-8"
        .position = objstream.size
        .writetext = strbody
        .savetofile server.mappath(file),2
        .close
    end with
    rtext=array(0,"保存文件成功!")
    savetofile=rtext
    set objstream = nothing
end function

'*************************************
'数据库添加修改操作
'*************************************
function dbquest(table,dbarray,action)
 dim addcount,tempdb,i,v
 if action<>"insert" or action<>"update" then action="insert"
 if action="insert" then v=2 else v=3
 if not isarray(dbarray) then
   dbquest=-1
   exit function
 else
   set tempdb=server.createobject("adodb.recordset")
   on error resume next
   tempdb.open table,conn,1,v
   if err then
    dbquest=-2
    exit function
   end if
   if action="insert" then tempdb.addnew
   addcount=ubound(dbarray,1)
   for i=0 to addcount
    tempdb(dbarray(i)(0))=dbarray(i)(1)
   next
   tempdb.update
   tempdb.close
   set tempdb=nothing
   dbquest=0
 end if
end function

'*************************************
'检测系统组件是否安装
'*************************************
function checkobjinstalled(strclassstring)
    on error resume next
    dim temp
    err = 0
    dim tmpobj
    set tmpobj = server.createobject(strclassstring)
    temp = err
    if temp = 0 or temp = -2147221477 then
        checkobjinstalled=true
    elseif temp = 1 or temp = -2147221005 then
        checkobjinstalled=false
    end if
    err.clear
    set tmpobj = nothing
    err = 0
end function

'*************************************
'判断服务器microsoft.xmldom
'*************************************
function getxmldom
    on error resume next
    dim temp
    getxmldom="microsoft.xmldom"
    err = 0
    dim tmpobj
    set tmpobj = server.createobject(getxmldom)
    temp = err
    if temp = 1 or temp = -2147221005 then
        getxmldom="msxml2.domdocument.5.0"
    end if
    err.clear
    set tmpobj = nothing
    err = 0
end function

'*************************************
'判断服务器msxml2.serverxmlhttp
'*************************************
function getxmlhttp
    on error resume next
    dim temp
    getxmlhttp="msxml2.serverxmlhttp"
    err = 0
    dim tmpobj
    set tmpobj = server.createobject(getxmlhttp)
    temp = err
    if temp = 1 or temp = -2147221005 then
        getxmlhttp="msxml2.serverxmlhttp.5.0"
    end if
    err.clear
    set tmpobj = nothing
    err = 0
end function

'*************************************
'检查插件是否成功安装
'*************************************
function checkplugins 
   dim plugs,plug,plugitem
   checkplugins=-1
    plugs=split(function_plugin,"$*$")
    for each plug in plugs
      plugitem = split(plug,"%|%")
      if getplugins=plugitem(0) then 
        checkplugins=plugitem
        exit function
      end if
    next
end function 

'*************************************
'显示帮助信息
'*************************************
sub showmsg(title,des,icon,showtype)
 on error resume next
 conn.close
 set conn=nothing
 err.clear
 session(cookiename&"_showmsg")=true
 session(cookiename&"_title")=title
 session(cookiename&"_des")=des
 session(cookiename&"_icon")=icon
 'icon 类型
 'messageicon
 'erroricon
 'warningicon
 'questionicon
 if showtype="plugins" then
   response.redirect("../../showmsg.asp")
 else
   response.redirect("showmsg.asp")
 end if
end sub

'*************************************
'垃圾关键字过滤
'*************************************
function filterspam(str,path)
  on error resume next
     filterspam = false
     dim spamxml,spamitem
     set spamxml = server.createobject(getxmldom)
       if err then  
           err.clear
           exit function
       end if
     spamxml.async = false  
     spamxml.load(server.mappath(path))
     if spamxml.parseerror.errorcode=0 then
       for each spamitem in spamxml.selectnodes("//key")
               if instr(lcase(str),lcase(spamitem.text))<>0 then
                  filterspam = true
                  exit function
               end if
       next
     end if
     set spamxml=nothing
end function

%> p;   if instr(strua,"links")>0 then arrinfo(0)="links"
    if instr(strua,"elinks")>0 then arrinfo(0)="elinks"
    if instr(strua,"jbrowser")>0 then arrinfo(0)="jbrowser"
    if instr(strua,"konqueror")>0 then arrinfo(0)="konqueror"
    if instr(strua,"wget")>0 then arrinfo(0)="wget"
    if instr(strua,"ask jeeves")>0 or instr(strua,"teoma")>0 then arrinfo(0)="ask jeeves/teoma"
    if instr(strua,"wget")>0 then arrinfo(0)="wget"
    if instr(strua,"opera")>0 then arrinfo(0)="opera"

    if instr(strua,"gecko")>0 then 
      strtype="[gecko]"
      arrinfo(0)="mozilla"
      if instr(strua,"aol")>0 then arrinfo(0)="aol"
      if instr(strua,"netscape")>0 then arrinfo(0)="netscape"
      if instr(strua,"firefox")>0 then arrinfo(0)="firefox"
      if instr(strua,"chimera")>0 then arrinfo(0)="chimera"
      if instr(strua,"camino")>0 then arrinfo(0)="camino"
      if instr(strua,"galeon")>0 then arrinfo(0)="galeon"
      if instr(strua,"k-meleon")>0 then arrinfo(0)="k-meleon"
      arrinfo(0)=arrinfo(0)+strtype
   end if

   if instr(strua,"bot")>0 or instr(strua,"crawl")>0 then 
      strtype="[bot/crawler]"
      arrinfo(0)=""
      if instr(strua,"grub")>0 then arrinfo(0)="grub"
      if instr(strua,"googlebot")>0 then arrinfo(0)="googlebot"
      if instr(strua,"msnbot")>0 then arrinfo(0)="msn bot"
      if instr(strua,"slurp")>0 then arrinfo(0)="yahoo! slurp"
      arrinfo(0)=arrinfo(0)+strtype
  end if

  if instr(strua,"applewebkit")>0 then 
      strtype="[applewebkit]"
      arrinfo(0)=""
      if instr(strua,"omniweb")>0 then arrinfo(0)="omniweb"
      if instr(strua,"safari")>0 then arrinfo(0)="safari"
      arrinfo(0)=arrinfo(0)+strtype
  end if 

  if instr(strua,"msie")>0 then 
      strtype="[msie"
      temp1=mid(strua,(instr(strua,"msie")+4),6)
      temp2=instr(temp1,";")
      temp1=left(temp1,temp2-1)
      strtype=strtype & temp1 &"]"
      arrinfo(0)="internet explorer"
      if instr(strua,"msn")>0 then arrinfo(0)="msn"
      if instr(strua,"aol")>0 then arrinfo(0)="aol"
      if instr(strua,"webtv")>0 then arrinfo(0)="webtv"
      if instr(strua,"myie2")>0 then arrinfo(0)="myie2"
      if instr(strua,"maxthon")>0 then arrinfo(0)="maxthon"
      if instr(strua,"gosurf")>0 then arrinfo(0)="gosurf"
      if instr(strua,"netcaptor")>0 then arrinfo(0)="netcaptor"
      if instr(strua,"sleipnir")>0 then arrinfo(0)="sleipnir"
      if instr(strua,"avant browser")>0 then arrinfo(0)="avantbrowser"
      if instr(strua,"greenbrowser")>0 then arrinfo(0)="greenbrowser"
      if instr(strua,"slimbrowser")>0 then arrinfo(0)="slimbrowser"
      arrinfo(0)=arrinfo(0)+strtype
   end if

 '操作系统判断
    if instr(strua,"windows")>0 then arrinfo(1)="windows"
    if instr(strua,"windows ce")>0 then arrinfo(1)="windows ce"
    if instr(strua,"windows 95")>0 then arrinfo(1)="windows 95"
    if instr(strua,"win98")>0 then arrinfo(1)="windows 98"
    if instr(strua,"windows 98")>0 then arrinfo(1)="windows 98"
    if instr(strua,"windows 2000")>0 then arrinfo(1)="windows 2000"
    if instr(strua,"windows xp")>0 then arrinfo(1)="windows xp"

    if instr(strua,"windows nt")>0 then
      arrinfo(1)="windows nt"
      if instr(strua,"windows nt 5.0")>0 then arrinfo(1)="windows 2000"
      if instr(strua,"windows nt 5.1")>0 then arrinfo(1)="windows xp"
      if instr(strua,"windows nt 5.2")>0 then arrinfo(1)="windows 2003"
    end if
    if instr(strua,"x11")>0 or instr(strua,"unix")>0 then arrinfo(1)="unix"
    if instr(strua,"sunos")>0 or instr(strua,"sun os")>0 then arrinfo(1)="sun os"
    if instr(strua,"powerpc")>0 or instr(strua,"ppc")>0 then arrinfo(1)="powerpc"
    if instr(strua,"macintosh")>0 then arrinfo(1)="mac"
    if instr(strua,"mac osx")>0 then arrinfo(1)="macosx"
    if instr(strua,"freebsd")>0 then arrinfo(1)="freebsd"
    if instr(strua,"linux")>0 then arrinfo(1)="linux"
    if instr(strua,"palmsource")>0 or instr(strua,"palmos")>0 then arrinfo(1)="palmos"
    if instr(strua,"wap ")>0 then arrinfo(1)="wap"

 'arrinfo(0)=strua 
 getbrowser=arrinfo
end function

'*************************************
'计算随机数
'*************************************
function randomstr(intlength)
    dim strseed,seedlength,pos,str,i
    strseed = "abcdefghijklmnopqrstuvwxyz1234567890"
    seedlength=len(strseed)
    str=""
    randomize
    for i=1 to intlength
     str=str+mid(strseed,int(seedlength*rnd)+1,1)
    next
    randomstr=str
end function

'*************************************
'自动闭合ubb
'*************************************
function closeubb(strcontent)
  dim arrtags,i,openpos,closepos,re,strmatchs,j,match
    set re=new regexp
    re.ignorecase =true
    re.global=true
    arrtags=array("code","quote","list","color","align","font","size","b","i","u","html")
  for i=0 to ubound(arrtags)
   openpos=0
   closepos=0

   re.pattern="\["+arrtags(i)+"(=[^\[\]]+|)\]"
   set strmatchs=re.execute(strcontent)
   for each match in strmatchs
    openpos=openpos+1
   next
   re.pattern="\[/"+arrtags(i)+"\]"
   set strmatchs=re.execute(strcontent)
   for each match in strmatchs
    closepos=closepos+1
   next
   for j=1 to openpos-closepos
      strcontent=strcontent+"[/"+arrtags(i)+"]"
   next
  next
closeubb=strcontent
end function

'*************************************
'自动闭合html
'*************************************
function closehtml(strcontent)
  dim arrtags,i,openpos,closepos,re,strmatchs,j,match
    set re=new regexp
    re.ignorecase =true
    re.global=true
    arrtags=array("p","div","span","table","ul","font","b","u","i","h1","h2","h3","h4","h5","h6")
  for i=0 to ubound(arrtags)
   openpos=0
   closepos=0

   re.pattern="\<"+arrtags(i)+"( [^\<\>]+|)\>"
   set strmatchs=re.execute(strcontent)
   for each match in strmatchs
    openpos=openpos+1
   next
   re.pattern="\</"+arrtags(i)+"\>"
   set strmatchs=re.execute(strcontent)
   for each match in strmatchs
    closepos=closepos+1
   next
   for j=1 to openpos-closepos
      strcontent=strcontent+"</"+arrtags(i)+">"
   next
  next
closehtml=strcontent
end function

'*************************************
'读取文件
'*************************************
function loadfromfile(byval file)
    dim objstream
    dim rtext
    rtext=array(0,"")
    on error resume next
    set objstream = server.createobject("adodb.stream")
    if err then 
        rtext=array(err.number,err.description)
        loadfromfile=rtext
        err.clear
        exit function
    end if
    with objstream
        .type = 2
        .mode = 3
        .open
        .charset = "utf-8"
        .position = objstream.size
        .loadfromfile server.mappath(file)
        if err.number<>0 then
           rtext=array(err.number,err.description)
           loadfromfile=rtext
           err.clear
           exit function
        end if
        rtext=array(0,.readtext)
        .close
    end with
    loadfromfile=rtext
    set objstream = nothing
end function

'*************************************
'保存文件
'*************************************
function savetofile(byval strbody,byval file)
    dim objstream
    dim rtext
    rtext=array(0,"")
    on error resume next
    set objstream = server.createobject("adodb.stream")
    if err then 
        rtext=array(err.number,err.description)
        err.clear
        exit function
    end if
    with objstream
        .type = 2
        .open
        .charset = "utf-8"
        .position = objstream.size
        .writetext = strbody
        .savetofile server.mappath(file),2
        .close
    end with
    rtext=array(0,"保存文件成功!")
    savetofile=rtext
    set objstream = nothing
end function

'*************************************
'数据库添加修改操作
'*************************************
function dbquest(table,dbarray,action)
 dim addcount,tempdb,i,v
 if action<>"insert" or action<>"update" then action="insert"
 if action="insert" then v=2 else v=3
 if not isarray(dbarray) then
   dbquest=-1
   exit function
 else
   set tempdb=server.createobject("adodb.recordset")
   on error resume next
   tempdb.open table,conn,1,v
   if err then
    dbquest=-2
    exit function
   end if
   if action="insert" then tempdb.addnew
   addcount=ubound(dbarray,1)
   for i=0 to addcount
    tempdb(dbarray(i)(0))=dbarray(i)(1)
   next
   tempdb.update
   tempdb.close
   set tempdb=nothing
   dbquest=0
 end if
end function

'*************************************
'检测系统组件是否安装
'*************************************
function checkobjinstalled(strclassstring)
    on error resume next
    dim temp
    err = 0
    dim tmpobj
    set tmpobj = server.createobject(strclassstring)
    temp = err
    if temp = 0 or temp = -2147221477 then
        checkobjinstalled=true
    elseif temp = 1 or temp = -2147221005 then
        checkobjinstalled=false
    end if
    err.clear
    set tmpobj = nothing
    err = 0
end function

'*************************************
'判断服务器microsoft.xmldom
'*************************************
function getxmldom
    on error resume next
    dim temp
    getxmldom="microsoft.xmldom"
    err = 0
    dim tmpobj
    set tmpobj = server.createobject(getxmldom)
    temp = err
    if temp = 1 or temp = -2147221005 then
        getxmldom="msxml2.domdocument.5.0"
    end if
    err.clear
    set tmpobj = nothing
    err = 0
end function

'*************************************
'判断服务器msxml2.serverxmlhttp
'*************************************
function getxmlhttp
    on error resume next
    dim temp
    getxmlhttp="msxml2.serverxmlhttp"
    err = 0
    dim tmpobj
    set tmpobj = server.createobject(getxmlhttp)
    temp = err
    if temp = 1 or temp = -2147221005 then
        getxmlhttp="msxml2.serverxmlhttp.5.0"
    end if
    err.clear
    set tmpobj = nothing
    err = 0
end function

'*************************************
'检查插件是否成功安装
'*************************************
function checkplugins 
   dim plugs,plug,plugitem
   checkplugins=-1
    plugs=split(function_plugin,"$*$")
    for each plug in plugs
      plugitem = split(plug,"%|%")
      if getplugins=plugitem(0) then 
        checkplugins=plugitem
        exit function
      end if
    next
end function 

'*************************************
'显示帮助信息
'*************************************
sub showmsg(title,des,icon,showtype)
 on error resume next
 conn.close
 set conn=nothing
 err.clear
 session(cookiename&"_showmsg")=true
 session(cookiename&"_title")=title
 session(cookiename&"_des")=des
 session(cookiename&"_icon")=icon
 'icon 类型
 'messageicon
 'erroricon
 'warningicon
 'questionicon
 if showtype="plugins" then
   response.redirect("../../showmsg.asp")
 else
   response.redirect("showmsg.asp")
 end if
end sub

'*************************************
'垃圾关键字过滤
'*************************************
function filterspam(str,path)
  on error resume next
     filterspam = false
     dim spamxml,spamitem
     set spamxml = server.createobject(getxmldom)
       if err then  
           err.clear
           exit function
       end if
     spamxml.async = false  
     spamxml.load(server.mappath(path))
     if spamxml.parseerror.errorcode=0 then
       for each spamitem in spamxml.selectnodes("//key")
               if instr(lcase(str),lcase(spamitem.text))<>0 then
                  filterspam = true
                  exit function
               end if
       next
     end if
     set spamxml=nothing
end function

%>
2

如您对本文有疑问或者有任何想说的,请点击进行留言回复,万千网友为您解惑!

相关文章:

验证码:
移动技术网