pjblog的ubbcodeasp文件

<%
'===========PBlog2 UBB代码转换代码==========
'      Author:PuterJam
'         Copryright PBlog2
'         Update: 2005-12-29
'===========================================
Function UBBCode(ByVal strContent,DisSM,DisUBB,DisIMG,AutoURL,AutoKEY)
 If isEmpty(strContent) Or isNull(strContent) Then
        Exit Function
 Else
  Dim re, strMatchs, strMatch, rndID,tmpStr1,tmpStr2,tmpStr3,tmpStr4
  Set re=new RegExp
  re.IgnoreCase =True
  re.Global=True
  IF AutoURL=1 Then
   re.Pattern="([^=]][s]*?|^)(http|https|rstp|ftp|mms|ed2k)://([A-Za-z0-9./=?%-_~`@':+!]*)"
   Set strMatchs=re.Execute(strContent)
   For Each strMatch in strMatchs
    tmpStr1=strMatch.SubMatches(0)
    tmpStr2=strMatch.SubMatches(1)
    tmpStr3=checkURL(strMatch.SubMatches(2))
    strContent=replace(strContent,strMatch.Value,tmpStr1&""&tmpStr2&"://"&tmpStr3&"",1,-1,0)
   Next
   're.Pattern="(^|s)(www.S+)"
   'strContent=re.Replace(strContent,"$1$2")
  End IF

  IF Not DisUBB=1 Then
   IF Not DisIMG=1 Then
             re.Pattern="([img])(.[^]]*)[/img]"
     Set strMatchs=re.Execute(strContent)
     For Each strMatch in strMatchs
      tmpStr1=(strMatch.SubMatches(1))
      strContent=replace(strContent,strMatch.Value,"",1,-1,0)
     Next

             re.Pattern="[img=(left|right|center|absmiddle|)](.[^]]*)([/img])"
     Set strMatchs=re.Execute(strContent)
     For Each strMatch in strMatchs
      tmpStr1=strMatch.SubMatches(0)
      tmpStr2=checkURL(strMatch.SubMatches(1))
      strContent=replace(strContent,strMatch.Value,"",1,-1,0)
     Next

             re.Pattern="[img=(d*|),(d*|)](.[^]]*)[/img]"
     Set strMatchs=re.Execute(strContent)
     For Each strMatch in strMatchs
      tmpStr1=strMatch.SubMatches(0)
      tmpStr2=strMatch.SubMatches(1)
      tmpStr3=checkURL(strMatch.SubMatches(2))
      strContent=replace(strContent,strMatch.Value,"",1,-1,0)
     Next

             re.Pattern="[img=(d*|),(d*|),(left|right|center|absmiddle|)](.[^]]*)([/img])"
     Set strMatchs=re.Execute(strContent)
     For Each strMatch in strMatchs
      tmpStr1=strMatch.SubMatches(0)
      tmpStr2=strMatch.SubMatches(1)
      tmpStr3=strMatch.SubMatches(2)
      tmpStr4=checkURL(strMatch.SubMatches(3))
      strContent=replace(strContent,strMatch.Value,"",1,-1,0)
     Next
    else
             re.Pattern="([img])(.[^]]*)[/img]"
     Set strMatchs=re.Execute(strContent)
     For Each strMatch in strMatchs
      tmpStr1=checkURL(strMatch.SubMatches(1))
      strContent=replace(strContent,strMatch.Value,"查看图片",1,-1,0)
     Next

             re.Pattern="[img=(left|right|center|absmiddle|)](.[^]]*)([/img])"
     Set strMatchs=re.Execute(strContent)
     For Each strMatch in strMatchs
      tmpStr1=strMatch.SubMatches(0)
      tmpStr2=checkURL(strMatch.SubMatches(1))
      strContent=replace(strContent,strMatch.Value,"查看图片",1,-1,0)
     Next

             re.Pattern="[img=(d*|),(d*|)](.[^]]*)[/img]"
     Set strMatchs=re.Execute(strContent)
     For Each strMatch in strMatchs
      tmpStr1=strMatch.SubMatches(0)
      tmpStr2=strMatch.SubMatches(1)
      tmpStr3=checkURL(strMatch.SubMatches(2))
      strContent=replace(strContent,strMatch.Value,"查看图片",1,-1,0)
     Next

             re.Pattern="[img=(d*|),(d*|),(left|right|center|absmiddle|)](.[^]]*)([/img])"
     Set strMatchs=re.Execute(strContent)
     For Each strMatch in strMatchs
      tmpStr1=strMatch.SubMatches(0)
      tmpStr2=strMatch.SubMatches(1)
      tmpStr3=strMatch.SubMatches(2)
      tmpStr4=checkURL(strMatch.SubMatches(3))
      strContent=replace(strContent,strMatch.Value,"查看图片",1,-1,0)
     Next    
   End IF

'-----------多媒体标签----------------
   re.Pattern="[(swf|wma|wmv|rm|ra|qt)(=d*?|)(,d*?|)]([^<>]*?)[/(swf|wma|wmv|rm|ra|qt)]"
      Set strMatchs=re.Execute(strContent)
      dim strType,strWidth,strHeight,strSRC,TitleText
  For Each strMatch in strMatchs
   RAndomize
     strType=strMatch.SubMatches(0)
     if strType="swf" then
      TitleText="Flash动画"
     elseif strType="wma" then
      TitleText="播放音频文件"
     elseif strType="wmv" then
      TitleText="播放视频文件"  
     elseif strType="rm" then
      TitleText="播放real视频流文件"  
     elseif strType="ra" then
      TitleText="播放real音频流文件"  
     elseif strType="qt" then
      TitleText="播放mov视频文件"  
     end if
              strWidth=strMatch.SubMatches(1)
              strHeight=strMatch.SubMatches(2)
              if (len(strWidth)=0) then
                strWidth="400"
                else
               strWidth=right(strWidth,(len(strWidth)-1))
              end if
              if (len(strHeight)=0) then
               strHeight="300"
                else
              strHeight=right(strHeight,(len(strHeight)-1))
              end if
              strSRC=checkURL(strMatch.SubMatches(3))
   rndID="temp"&Int(100000 * Rnd)
   strContent= Replace(strContent,strMatch.Value,""&TitleText&"在线播放")
  Next
  Set strMatchs=nothing
  re.Pattern="([mid])(.[^]]*)[/mid]"
  strContent= re.Replace(strContent,"") 
'-----------常规标签----------------
   re.Pattern = "[url=(.[^]]*)](.[^[]*)[/url]"
   Set strMatchs=re.Execute(strContent)
   For Each strMatch in strMatchs
    tmpStr1=checkURL(strMatch.SubMatches(0))
    tmpStr2=strMatch.SubMatches(1)
    strContent=replace(strContent,strMatch.Value,""&tmpStr2&"",1,-1,0)
   Next

   re.Pattern = "[url](.[^[]*)[/url]"
   Set strMatchs=re.Execute(strContent)
   For Each strMatch in strMatchs
    tmpStr1=checkURL(strMatch.SubMatches(0))
    strContent=replace(strContent,strMatch.Value,""&tmpStr1&"",1,-1,0)
   Next

   re.Pattern = "[ed2k=([^r]*?)]([^r]*?)[/ed2k]"
   Set strMatchs=re.Execute(strContent)
   For Each strMatch in strMatchs
    tmpStr1=checkURL(strMatch.SubMatches(0))
    tmpStr2=strMatch.SubMatches(1)
    strContent=replace(strContent,strMatch.Value,""&tmpStr2&"",1,-1,0)
   Next

   re.Pattern = "[ed2k]([^r]*?)[/ed2k]"
   Set strMatchs=re.Execute(strContent)
   For Each strMatch in strMatchs
    tmpStr1=checkURL(strMatch.SubMatches(0))
    strContent=replace(strContent,strMatch.Value,""&tmpStr1&"",1,-1,0)
   Next

   re.Pattern = "[email=(.[^]]*)](.[^[]*)[/email]"
   Set strMatchs=re.Execute(strContent)
   For Each strMatch in strMatchs
    tmpStr1=checkURL(strMatch.SubMatches(0))
    tmpStr2=strMatch.SubMatches(1)
    strContent=replace(strContent,strMatch.Value,""&tmpStr2&"",1,-1,0)
   Next

   
   re.Pattern = "[email](.[^[]*)[/email]"
   Set strMatchs=re.Execute(strContent)
   For Each strMatch in strMatchs
    tmpStr1=checkURL(strMatch.SubMatches(0))
    strContent=replace(strContent,strMatch.Value,""&tmpStr1&"",1,-1,0)
   Next

'-----------字体格式----------------
      re.Pattern="[align=(w{4,6})]([^r]*?)[/align]"
   strContent=re.Replace(strContent,"$2")
        re.Pattern="[color=(#w{3,10}|w{3,10})]([^r]*?)[/color]"
   strContent=re.Replace(strContent,"$2")
      re.Pattern="[size=(d{1,2})]([^r]*?)[/size]"
   strContent=re.Replace(strContent,"$2")
      re.Pattern="[font=([^r]*?)]([^r]*?)[/font]"
   strContent=re.Replace(strContent,"$2")
   re.Pattern="[b]([^r]*?)[/b]"
   strContent=re.Replace(strContent,"$1")
      re.Pattern="[i]([^r]*?)[/i]"
   strContent=re.Replace(strContent,"$1")
      re.Pattern="[u]([^r]*?)[/u]"
   strContent=re.Replace(strContent,"$1")
      re.Pattern="[s]([^r]*?)[/s]"
   strContent=re.Replace(strContent,"$1")
      re.Pattern="[sup]([^r]*?)[/sup]"
   strContent=re.Replace(strContent,"^$1")
      re.Pattern="[sub]([^r]*?)[/sub]"
   strContent=re.Replace(strContent,"_$1")
      re.Pattern="[fly]([^r]*?)[/fly]"
   strContent=re.Replace(strContent,"$1")

  End IF

'-----------特殊标签----------------
  re.Pattern = "[down=(.[^]]*)](.[^[]*)[/down]"
  Set strMatchs=re.Execute(strContent)
  For Each strMatch in strMatchs
   tmpStr1=checkURL(strMatch.SubMatches(0))
   tmpStr2=strMatch.SubMatches(1)
   strContent=replace(strContent,strMatch.Value," "&tmpStr2&"",1,-1,0)
  Next  

  re.Pattern = "[down](.[^[]*)[/down]"
  Set strMatchs=re.Execute(strContent)
  For Each strMatch in strMatchs
   tmpStr1=checkURL(strMatch.SubMatches(0))
   strContent=replace(strContent,strMatch.Value," 下载此文件",1,-1,0)
  Next

  re.Pattern = "[mDown=(.[^]]*)](.[^[]*)[/mDown]"
  Set strMatchs=re.Execute(strContent)
  For Each strMatch in strMatchs
   tmpStr1=checkURL(strMatch.SubMatches(0))
   tmpStr2=strMatch.SubMatches(1)
   if len(memName)>0 then
    strContent=replace(strContent,strMatch.Value," "&tmpStr2&"",1,-1,0)
    else
    strContent=replace(strContent,strMatch.Value," 该文件只允许会员下载! 登录 | 注册",1,-1,0)
   end if
  Next

  re.Pattern = "[mDown](.[^[]*)[/mDown]"
  Set strMatchs=re.Execute(strContent)
  For Each strMatch in strMatchs
   tmpStr1=checkURL(strMatch.SubMatches(0))
   if len(memName)>0 then
    strContent=replace(strContent,strMatch.Value," 下载此文件",1,-1,0)
    else
    strContent=replace(strContent,strMatch.Value," 该文件只允许会员下载! 登录 | 注册",1,-1,0)
   end if
  Next

")
   re.Pattern = "[list=(.[^]]*)]"
   strContent = re.Replace(strContent,"
")
   re.Pattern = "[*](.[^[]*)(n|)"
   strContent = re.Replace(strContent,"
• $1
")
   strContent = Replace(strContent,"[/list]","
")

'-----------表情图标----------------
  IF Not DisSM=1 Then
   dim log_Smilies,log_SmiliesContent
   For Each log_Smilies IN Arr_Smilies
    log_SmiliesContent=Split(log_Smilies,"|")
    strContent=Replace(strContent,log_SmiliesContent(2)," ")
   Next
  End IF

'-----------关键词识别----------------
  IF AutoKEY=1 Then
   dim log_Keywords,log_KeywordsContent
   For Each log_Keywords IN Arr_Keywords
    log_KeywordsContent=Split(log_Keywords,"$|$")
    IF log_KeywordsContent(3)<>"None" Then
     strContent=Replace(strContent,log_KeywordsContent(1)," "&log_KeywordsContent(1)&"")
    Else
     strContent=Replace(strContent,log_KeywordsContent(1),""&log_KeywordsContent(1)&"")
    End IF
   Next
  End IF

  Set re=Nothing

  UBBCode=strContent
 End IF
End Function
%>