www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\ask\inc\ubbcode.asp
<% '禁用UBB标签 Const UBB_ENABLE_AUTO_URL = True Const UBB_ENABLE_IMG = True Const UBB_ENABLE_URL = True Const UBB_ENABLE_FONT = True Function UBBCode(ByVal strContent) If IsNull(strContent) Or strContent = "" Then UBBCode = "" Exit Function End If Dim re Set re=New RegExp re.IgnoreCase=True re.Global=True If UBB_ENABLE_IMG Then If InStr(Lcase(strContent),"[/img]")>0 Then re.Pattern="(\[img\])(.[^\[]*)(\[\/img\])" strContent=re.Replace(strContent,"<img src=""$2""/>") End If End If If UBB_ENABLE_URL Then re.Pattern = "\[url=(.[^\]]*)\](.[^\[]*)\[\/url]" strContent=re.Replace(strContent,"<a target=""_blank"" href=""$1"">$2</a>") re.Pattern = "\[url](.[^\[]*)\[\/url]" strContent=re.Replace(strContent,"<a target=""_blank"" href=""$1"">$1</a>") End If If UBB_ENABLE_FONT Then If InStr(Lcase(strContent),"[/align]")>0 Then re.Pattern="\[align=(\w{4,6})\]([^\r]*?)\[\/align\]" strContent=re.Replace(strContent,"<div align=""$1"">$2</div>") End If re.Pattern="\[color=(#\w{3,10}|\w{3,10})\]([^\r]*?)\[\/color\]" strContent=re.Replace(strContent,"<span style=""color:$1"">$2</span>") re.Pattern="\[size=(\d{1,2})\]([^\r]*?)\[\/size\]" strContent=re.Replace(strContent,"<span style=""font-size:$1pt"">$2</span>") re.Pattern="\[font=([^\r]*?)\]([^\r]*?)\[\/font\]" strContent=re.Replace(strContent,"<span style=""font-family:$1"">$2</span>") re.Pattern="\[b\]([^\r]*?)\[\/b\]" strContent=re.Replace(strContent,"<strong>$1</strong>") re.Pattern="\[i\]([^\r]*?)\[\/i\]" strContent=re.Replace(strContent,"<i>$1</i>") re.Pattern="\[u\]([^\r]*?)\[\/u\]" strContent=re.Replace(strContent,"<u>$1</u>") re.Pattern="\[s\]([^\r]*?)\[\/s\]" End If re.Pattern="(<s+cript[^>]*?>([\w\W]*?)<\/s+cript>)":strContent=re.Replace(strContent, "") re.Pattern="(<iframe[^>]*?>([\w\W]*?)<\/iframe>)":strContent=re.Replace(strContent, "") re.Pattern="(on(load|click|dbclick|mouseover|mouseout|mousedown|mouseup|mousewheel|keydown|submit|change|focus)=""[^""]+"")" strContent=re.Replace(strContent, "") re.Pattern="(on(load|click|dbclick|mouseover|mouseout|mousedown|mouseup|mousewheel|keydown|submit|change|focus)='[^""]+')" strContent=re.Replace(strContent,"") re.Pattern="<img(\w*) style\s*=""*([^>|""]*)""([^>]*)>" strContent=re.Replace(strContent,"<img$1$3>") re.Pattern="<img(.[^>]*)>" strContent=re.Replace(strContent, "<img$1/>") re.Pattern="(\/\/>)" strContent=re.Replace(strContent, "/>") re.Pattern="<img(.[^>]*)([/| ])>" strContent=re.Replace(strContent,"<img$1/>") re.Pattern="<img(.[^>]*)/>" strContent=re.Replace(strContent,"<img$1 onload=""resizeme(this)"" onclick=""javascript:window.open(this.src);"" style=""cursor:pointer;""/>") If UBB_ENABLE_AUTO_URL Then '自动识别网址 re.Pattern="(^|[^<>=""'\]])((http|https|ftp|rtsp|mms|ed2k):(\/\/|\\\\)(([\w\/\\\+\-~`@:%\/\|])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#\/\|]|(&))+)" strContent=re.Replace(strContent,"$1<a target=""_blank"" href=""$2"">$2</a>") '自动识别www等开头的网址 're.Pattern="(^|[^\/\\\w\=])((www|bbs)\.(\w)+\.([\w\/\\\.\=\?\+\-~`@\'!%#]|(&))+)" 'strContent=re.Replace(strContent,"$1<a target=""_blank"" href=""http://$2"">$2</a>") End If Set re=Nothing UBBCode=strContent End Function Function UBB2Html(ByVal strContent) If IsNull(strContent) Or strContent = "" Then UBB2Html = "" Exit Function End If strContent = TrimNewline(strContent) strContent = Replace(strContent, Chr(0), "") strContent = Replace(strContent, "&", "&") strContent = Replace(strContent, ">", ">") strContent = Replace(strContent, "<", "<") strContent = Replace(strContent, Chr(32), " ") strContent = Replace(strContent, Chr(9), " ") strContent = Replace(strContent, " ", " ") strContent = Replace(strContent, Chr(34), """) strContent = Replace(strContent, Chr(39), "'") strContent = Replace(strContent, Chr(13), "") 'strContent = Replace(strContent, Chr(10) & Chr(10), "</p><p>") strContent = Replace(strContent, Chr(10), "<br/>") strContent = Replace(strContent, "</p><p>", "</p>" & vbCrLf & "<p>") UBB2Html = "<p>" & strContent & "</p>" End Function Function Html2UBB(ByVal strContent) If IsNull(strContent) Or strContent = "" Then Html2UBB = "" Exit Function End If strContent = Replace(strContent, Chr(0), "") Dim re Set re = New RegExp re.IgnoreCase = True re.Global = True re.Pattern = "([\f\n\r\t\v])" strContent = re.Replace(strContent,"") re.Pattern = "(on(load|click|dbclick|mouseover|mousedown|mouseup|mousewheel|keydown)=""[^""]+"")":strContent = re.Replace(strContent, "") re.Pattern = "(on(load|click|dbclick|mouseover|mousedown|mouseup|mousewheel|keydown)=\'[^""]+\')":strContent = re.Replace(strContent, "") re.Pattern = "(<s+cript[^>]*?>([\w\W]*?)<\/s+cript>)":strContent = re.Replace(strContent, "") re.Pattern = "(<a[^>]+href=""([^""]+)""[^>]*>(.*?)<\/a>)":strContent = re.Replace(strContent, Chr(10)&"[url=$2]$3[/url]"&Chr(10)) re.Pattern = "(<font[^>]+color=""([^"">]+)""[^>]*>(.*?)<\/font>)":strContent = re.Replace(strContent, Chr(10)&"[color=$2]$3[/color]"&Chr(10)) re.Pattern = "(<font[^>]+color=([^ >]+)[^>]*>(.*?)<\/font>)":strContent = re.Replace(strContent, Chr(10)&"[color=$2]$3[/color]"&Chr(10)) re.Pattern = "(<p[^>]+align=""([^"">]+)""[^>]*>(.*?)<\/p>)":strContent = re.Replace(strContent, "[align=$2]$3[/align]") re.Pattern = "(<p[^>]+align=([^"">]+)[^>]*>(.*?)<\/p>)":strContent = re.Replace(strContent, "[align=$2]$3[/align]") re.Pattern = "(<img[^>]+src=""([^""]+)""[^>]*>)":strContent = re.Replace(strContent, Chr(10)&"[img]$2[/img]"&Chr(10)) re.Pattern = "(<img[^>]+src='([^""]+)'[^>]*>)":strContent = re.Replace(strContent, Chr(10)&"[img]$2[/img]"&Chr(10)) re.Pattern = "(<img[^>]+src=([^""]+)[^>]*>)":strContent = re.Replace(strContent, Chr(10)&"[img]$2[/img]"&Chr(10)) re.Pattern = "(<([\/]?)strong>)":strContent = re.Replace(strContent, "[$2b]") re.Pattern = "(<([\/]?)b>)":strContent = re.Replace(strContent, "[$2b]") re.Pattern = "(<([\/]?)u>)":strContent = re.Replace(strContent, "[$2u]") re.Pattern = "(<([\/]?)i>)":strContent = re.Replace(strContent, "[$2i]") re.Pattern = "(<([\/]?)p>)":strContent = re.Replace(strContent, Chr(10)&"$1"&Chr(10)) re.Pattern = "(<br[^>]*?>)":strContent = re.Replace(strContent, Chr(10)) re.Pattern = "((<p> </p>)|(<p></p>))":strContent = re.Replace(strContent, Chr(10)) re.Pattern = "((<p[^>]*?>)|(</p>))":strContent = re.Replace(strContent, Chr(10)) re.Pattern = "(<[^>]*?>)":strContent = re.Replace(strContent, "") Set re = Nothing Html2UBB = TrimNewline(strContent) End Function Function TrimNewline(ByVal strContent) If IsNull(strContent) Then TrimNewline = "" Exit Function End If strContent = Replace(strContent, Chr(13), "") If strContent = "" Then TrimNewline = "" Exit Function End If If Left(strContent,1) = Chr(10) Then strContent = Replace(strContent, Chr(10), vbNullString, 1, 1) strContent = TrimNewline(strContent) End If If Right(strContent,1) = Chr(10) Then strContent = Left(strContent,Len(strContent)-1) strContent = TrimNewline(strContent) End If TrimNewline = strContent 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 %>