<% rem ------------ubb代码 function doCode(fString, fOTag, fCTag, fROTag, fRCTag) fOTagPos = Instr(1, fString, fOTag, 1) fCTagPos = Instr(1, fString, fCTag, 1) while (fCTagPos > 0 and fOTagPos > 0) fString = replace(fString, fOTag, fROTag, 1, 1, 1) fString = replace(fString, fCTag, fRCTag, 1, 1, 1) fOTagPos = Instr(1, fString, fOTag, 1) fCTagPos = Instr(1, fString, fCTag, 1) wend doCode = fString end function function HTMLEncode(fString) fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") fString = Replace(fString, CHR(13), "") fString = Replace(fString, CHR(10) & CHR(10), "

") fString = Replace(fString, CHR(10), "
") HTMLEncode = fString end function function HTMLDecode(fString) fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") fString = Replace(fString, "", CHR(13)) fString = Replace(fString, "

", CHR(10) & CHR(10)) fString = Replace(fString, "
", CHR(10)) HTMLDecode = fString end function function HTMLDecode1(fString) fString = replace(fString, ">", ">") fString = replace(fString, "<", "<") fString = Replace(fString, "", CHR(13)) fString = Replace(fString, "

", CHR(10) & CHR(10)) fString = Replace(fString, "
", CHR(10)) HTMLDecode1 = fString end function function UBBCode(strContent) if strAllowHTML <> "1" then strContent = HTMLEncode(strContent) end if dim re set re = New RegExp re.Global = True re.IgnoreCase = True ' re.MultiLine = True re.Pattern = "\[url=(.[^\]]*)\](.[^\[]*)\[\/url]" strContent = re.Replace(strContent,"$2") re.Pattern = "\[url](.[^\[]*)\[\/url]" strContent = re.Replace(strContent,"$1") re.Pattern = "\[email=(.[^\]]*)\](.[^\[]*)\[\/email]" strContent = re.Replace(strContent,"$2") re.Pattern = "\[email](.[^\[]*)\[\/email]" strContent = re.Replace(strContent,"$1") if strAllowflash="1" then re.Pattern = "\[FLASH](.[^\[]*)\[\/FLASH]" strContent = re.Replace(strContent,"$1") end if re.Pattern="\[HTML](.[^\[]*)\[\/HTML]" strContent=re.Replace(strContent," HTML 代码片段如下:

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

") re.Pattern="\[COLOR=(.[^\]]*)\](.[^\[]*)\[\/COLOR]" strContent=re.Replace(strContent,"$2") re.Pattern="\[FACE=(.[^\]]*)\](.[^\[]*)\[\/FACE]" strContent=re.Replace(strContent,"$2") re.Pattern="\[ALIGN=(.[^\]]*)\](.[^\[]*)\[\/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=(.[^\]]*),(.[^\]]*),(.[^\]]*)\](.[^\[]*)\[\/GLOW]" strContent=re.Replace(strContent,"$4
") re.Pattern="\[SHADOW=(.[^\]]*),(.[^\]]*),(.[^\]]*)\](.[^\[]*)\[\/SHADOW]" strContent=re.Replace(strContent,"$4
") re.Pattern = "\[b](.[^\[]*)\[\/b]" strContent = re.Replace(strContent,"$1") re.Pattern = "\[I](.[^\[]*)\[\/I]" strContent = re.Replace(strContent,"$1") re.Pattern = "\[u](.[^\[]*)\[\/u]" strContent = re.Replace(strContent,"$1") re.Pattern ="\[size=1](.[^\[]*)\[\/size]" strContent = re.Replace(strContent,"$1") re.Pattern ="\[size=2](.[^\[]*)\[\/size]" strContent = re.Replace(strContent,"$1") re.Pattern ="\[size=3](.[^\[]*)\[\/size]" strContent = re.Replace(strContent,"$1") re.Pattern ="\[size=4](.[^\[]*)\[\/size]" strContent = re.Replace(strContent,"$1") strContent = doCode(strContent, "[list]", "[/list]", "") strContent = doCode(strContent, "[list=1]", "[/list]", "
    ", "
") strContent = doCode(strContent, "[list=a]", "[/list]", "
    ", "
") strContent = doCode(strContent, "[*]", "[/*]", "
  • ", "
  • ") strContent = doCode(strContent, "[code]", "[/code]", "
    ", "
    ") UBBCode = strContent end function public function translate(sourceStr,fieldStr) rem 处理逻辑表达式的转化问题 dim sourceList dim resultStr dim i,j if instr(sourceStr," ")>0 then dim isOperator isOperator = true sourceList=split(sourceStr) '-------------------------------------------------------- rem Response.Write "num:" & cstr(ubound(sourceList)) & "
    " for i = 0 to ubound(sourceList) rem Response.Write i Select Case ucase(sourceList(i)) Case "AND","&","和","与" resultStr=resultStr & " and " isOperator = true Case "OR","|","或" resultStr=resultStr & " or " isOperator = true Case "NOT","!","非","!","!" resultStr=resultStr & " not " isOperator = true Case "(","(","(" resultStr=resultStr & " ( " isOperator = true Case ")",")",")" resultStr=resultStr & " ) " isOperator = true Case Else if sourceList(i)<>"" then if not isOperator then resultStr=resultStr & " and " if inStr(sourceList(i),"%") > 0 then resultStr=resultStr&" "&fieldStr& " like '" & replace(sourceList(i),"'","''") & "' " else resultStr=resultStr&" "&fieldStr& " like '%" & replace(sourceList(i),"'","''") & "%' " end if isOperator=false End if End Select rem Response.write resultStr+"
    " next translate=resultStr else '单条件 if inStr(sourcestr,"%") > 0 then translate=" " & fieldStr & " like '" & replace(sourceStr,"'","''") &"' " else translate=" " & fieldStr & " like '%" & replace(sourceStr,"'","''") &"%' " End if rem 前后各加一个空格,免得连sql时忘了加,而出错。 end if end function function IsValidEmail(email) dim names, name, i, c 'Check for valid syntax in an email address. IsValidEmail = true names = Split(email, "@") if UBound(names) <> 1 then IsValidEmail = false exit function end if for each name in names if Len(name) <= 0 then IsValidEmail = false exit function end if for i = 1 to Len(name) c = Lcase(Mid(name, i, 1)) if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then IsValidEmail = false exit function end if next if Left(name, 1) = "." or Right(name, 1) = "." then IsValidEmail = false exit function end if next if InStr(names(1), ".") <= 0 then IsValidEmail = false exit function end if i = Len(names(1)) - InStrRev(names(1), ".") if i <> 2 and i <> 3 then IsValidEmail = false exit function end if if InStr(email, "..") > 0 then IsValidEmail = false end if end function %>