一聚教程网:一个值得你收藏的教程网站

最新下载

热门教程

asp 通用UBB代码转换程序

时间:2009-07-06 编辑:简简单单 来源:一聚教程网


<%
const ImagePath="images/"
function UBBCode(strContent)
strContent= FilterJS(strContent)
dim re
dim po,ii
dim reContent
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
po=0
ii=0
 
re.Pattern="[IMG](http|https|ftp)://(.[^[]*)[/IMG]"
strContent=re.Replace(strContent,"按此在新窗口浏览图片screen.width-333)this.width=screen.width-333"">")
re.Pattern="[UPLOAD=(gif|jpg|jpeg|bmp|png)](.[^[]*)(gif|jpg|jpeg|bmp|png)[/UPLOAD]"
strContent= re.Replace(strContent,"
此主题相关图片如下:
按此在新窗口浏览图片screen.width-333)this.width=screen.width-333"">")

re.Pattern="[UPLOAD=(.[^[]*)](.[^[]*)[/UPLOAD]"
strContent= re.Replace(strContent,"
点击浏览该文件")

re.Pattern="[DIR=*([0-9]*),*([0-9]*)](.[^[]*)[/DIR]"
strContent=re.Replace(strContent," re.Pattern="[QT=*([0-9]*),*([0-9]*)](.[^[]*)[/QT]"
strContent=re.Replace(strContent," re.Pattern="[MP=*([0-9]*),*([0-9]*)](.[^[]*)[/MP]"
strContent=re.Replace(strContent," re.Pattern="[RM=*([0-9]*),*([0-9]*)](.[^[]*)[/RM]"
strContent=re.Replace(strContent,"

re.Pattern="([FLASH])(.[^[]*)([/FLASH])"
strContent= re.Replace(strContent,"点击开新窗口欣赏该FLASH动画![全屏欣赏]
flash/swflash.cab#version=5,0,0,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 >$2")

re.Pattern="([FLASH=*([0-9]*),*([0-9]*)])(.[^[]*)([/FLASH])"
strContent= re.Replace(strContent,"点击开新窗口欣赏该FLASH动画![全屏欣赏]

re.Pattern="([URL])(.[^[]*)([/URL])"
strContent= re.Replace(strContent,"$2")
re.Pattern="([URL=(.[^[]*)])(.[^[]*)([/URL])"
strContent= re.Replace(strContent,"$3")

re.Pattern="([EMAIL])(S+@.[^[]*)([/EMAIL])"
strContent= re.Replace(strContent,"$2mailto:$2"">$2>")
re.Pattern="([EMAIL=(S+@.[^[]*)])(.[^[]*)([/EMAIL])"
strContent= re.Replace(strContent,"mailto:$2"" TARGET=_blank>$3")

'自动识别网址
're.Pattern = "^((http|https|ftp|rtsp|mms):(//|\\)[A-Za-z0-9./=?%-&_~`@':+!]+)"
'strContent = re.Replace(strContent,"$1")
're.Pattern = "((http|https|ftp|rtsp|mms):(//|\\)[A-Za-z0-9./=?%-&_~`@':+!]+)$"
'strContent = re.Replace(strContent,"$1")
're.Pattern = "([^>=""])((http|https|ftp|rtsp|mms):(//|\\)[A-Za-z0-9./=?%-&_~`@':+!]+)"
'strContent = re.Replace(strContent,"$1$2")

'自动识别www等开头的网址
're.Pattern = "([^(http://|http:\)])((www|cn)[.](w)+[.]{1,}(net|com|cn|org|cc)(((/[~]*|\[~]*)(w)+)|[.](w)+)*(((([?](w)+){1}[=]*))*((w)+){1}([&](w)+[=](w)+)*)*)"
'strContent = re.Replace(strContent,"$2")

'自动识别Email地址,如打开本功能在浏览内容很多的帖子会引起服务器停顿
're.Pattern = "([^(=)])((w)+[@]{1}((w)+[.]){1,3}(w)+)"
'strContent = re.Replace(strContent,"$2mailto:$2"">$2>")

re.Pattern="[em(.[^[]*)]"
strContent=re.Replace(strContent,"")

re.Pattern="[HTML](.[^[]*)[/HTML]"
strContent=re.Replace(strContent,"

以下内容为程序代码:
$1
")
re.Pattern="[code](.[^[]*)[/code]"
strContent=re.Replace(strContent,"
以下内容为程序代码:
$1
")

re.Pattern="[color=(.[^[]*)](.[^[]*)[/color]"
strContent=re.Replace(strContent,"$2")
re.Pattern="[face=(.[^[]*)](.[^[]*)[/face]"
strContent=re.Replace(strContent,"$2")
re.Pattern="[align=(center|left|right)](.*)[/align]"
strContent=re.Replace(strContent,"

$2
")

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

$1

")
re.Pattern="[fly](.*)[/fly]"
strContent=re.Replace(strContent,"$1")
re.Pattern="[move](.*)[/move]"
strContent=re.Replace(strContent,"$1") 
re.Pattern="[GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)](.[^[]*)[/GLOW]"
strContent=re.Replace(strContent,"$4
")
re.Pattern="[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)](.[^[]*)[/SHADOW]"
strContent=re.Replace(strContent,"$4
")

re.Pattern="[i](.[^[]*)[/i]"
strContent=re.Replace(strContent,"$1")
re.Pattern="[u](.[^[]*)([/u])"
strContent=re.Replace(strContent,"$1")
re.Pattern="[b](.[^[]*)([/b])"
strContent=re.Replace(strContent,"$1")
re.Pattern="[size=([1-4])](.[^[]*)[/size]"
strContent=re.Replace(strContent,"$2")
strContent=replace(strContent,"","")
set re=Nothing
UBBCode=strContent
end function

Function FilterJS(v)
if not isnull(v) then
dim t
dim re
dim reContent
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(javascript)"
t=re.Replace(v,"javascript")
re.Pattern="(jscript:)"
t=re.Replace(t,"jscript:")
re.Pattern="(js:)"
t=re.Replace(t,"js:")
re.Pattern="(value)"
t=re.Replace(t,"value")
re.Pattern="(about:)"
t=re.Replace(t,"about:")
re.Pattern="(file:)"
t=re.Replace(t,"file:")
re.Pattern="(document.cookie)"
t=re.Replace(t,"documents.cookie")
re.Pattern="(vbscript:)"
t=re.Replace(t,"vbscript:")
re.Pattern="(vbs:)"
t=re.Replace(t,"vbs:")
re.Pattern="(on(mouse|exit|error|click|key))"
t=re.Replace(t,"on$2")
re.Pattern="(&#)"
t=re.Replace(t,"&#")
FilterJS=t
set re=nothing
end if
End Function

function dvHTMLEncode(fString)
if not isnull(fString) then
    fString = replace(fString, ">", ">")
    fString = replace(fString, "<", "<")

    fString = Replace(fString, CHR(32), " ")
    fString = Replace(fString, CHR(9), " ")
    fString = Replace(fString, CHR(34), """)
    fString = Replace(fString, CHR(39), "'")
    fString = Replace(fString, CHR(13), "")
    fString = Replace(fString, CHR(10) & CHR(10), "

")
    fString = Replace(fString, CHR(10), "
")

    dvHTMLEncode = fString
end if
end function

function nohtml(str)
    dim re
    Set re=new RegExp
    re.IgnoreCase =true
    re.Global=True
    re.Pattern="(<.[^<]*>)"
    str=re.replace(str," ")
    re.Pattern="()"
    str=re.replace(str," ")
    nohtml=str
    set re=nothing
end function

%>