欢迎来到福编程网,本站提供各种互联网专业知识!

pjblog的ubbcodeasp文件

发布时间:2006-08-11 作者: 来源:转载
复制代码代码如下:
复制代码 代码如下:

<%
'===========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="[code](.*?)[/code]"
strContent= re.Replace(strContent,"

程序代码
$1
")

re.Pattern="[quote](.*?)[/quote]"
strContent= re.Replace(strContent,"

引用内容
$1
")
re.Pattern="[quote=(.[^]]*)](.*?)[/quote]"
strContent= re.Replace(strContent,"
引用来自 $1
$2
")

re.Pattern="[hidden](.*?)[/hidden]"
if len(memName)>0 then
strContent= re.Replace(strContent,"

显示被隐藏内容
$1
")
else
strContent= re.Replace(strContent,"
隐藏内容
该内容已经被作者隐藏,只有会员才允许查阅 登录 | 注册
")
end if

re.Pattern="[hidden=(.[^]]*)](.*?)[/hidden]"
if len(memName)>0 then
strContent= re.Replace(strContent,"

显示被隐藏内容来自 $1
$2
")
else
strContent= re.Replace(strContent,"
隐藏内容
该内容已经被作者隐藏,只有会员才允许查阅 登录 | 注册
")
end if

re.Pattern="[html](.*?)[/html]"
Set strMatchs=re.Execute(strContent)
For Each strMatch in strMatchs
RAndomize
rndID="temp"&Int(100000 * Rnd)
strContent=Replace(strContent,strMatch.Value,"

HTML代码

[Ctrl+A 全部选择 提示:你可先修改部分代码,再按运行]

",1,-1,0)
Next
Set strMatchs=nothing
'-----------List标签----------------
strContent = Replace(strContent,"[list]","
    ")
    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
    %>

相关推荐