ubb代码的简单实现

关于UBB的详细情况，请点这个链接 http://www.chinaasp.com/sqlbbs/help/aboutUBB.asp 查看。
UBB的实现原理无外乎字符串的查找和替换。因此Microosft Script Engine 5.0版本的RegExp(正则表达式对象)是个不错的选择，但我想由于ISP的关系，我现在这个网站(信诺立)就还不支持Microsoft Script Engine 5.0。所以下面这个子程序可能更适合大家一些。
□Convert-实现ubb标记的查找和替换，当前实现了b/url/url1(在一个新窗口中打开链接)/#/hr等多个标记，大家可以自己增加其他标记。
□调用方法
if convert(text,"url")=false then
    ‘’url标记错误处理
end if
□convert函数代码
Function Convert(ByRef intext, UBB)
    ‘’变量定义
    Dim intStart
    Dim intStartPostion
    Dim intEndPostion
    Dim strStartUBB
    Dim strEndUBB
    Dim intStartUBBLen
    Dim intEndUBBLen
    Dim intStrLen
    intStrLen = Len(intext)
    Dim strContent
    Dim strFinish
    ‘’彩色标记
    Dim strColor
    ‘’#号ubb开始标记的结束]位置
    Dim intJHEndPostion
    intStart = 1
    If UBB = "#" Then
        strStartUBB = "[" & "#"
    Else
        strStartUBB = "][" & UBB & "]"
    End If
    If UBB = "hr" Then
        intStartPostion = InStr(intStart, intext, strStartUBB, 1)
        do until intStartPostion=0
            intext = Replace(intext, strStartUBB, "<hr size=1>", 1, -1, 1)
            intStart=intStartPostion+len(strStartUBB)
            intStartPostion = InStr(intStart, intext,strStartUBB, 1)

        Loop
        convert=true
        exit function
    End If
    
    strEndUBB = "[/" & UBB & "]"
    intStartUBBLen = Len(strStartUBB)
    intEndUBBLen = Len(strEndUBB)
    
    intStartPostion = InStr(intStart, intext, strStartUBB, 1)
    Do Until intStartPostion = 0
        ‘’找匹配UBB
        intEndPostion = InStr(intStart, intext, strEndUBB, 1)
        If intEndPostion = 0 Then
            Convert = False
            Exit Function
        Else
            ‘’取中间字符串
            If UBB = "#" Then
                ‘’#号特殊处理
                intJHEndPostion = InStr(intStartPostion, intext, "]")
                If intJHEndPostion = 0 Then
                    Convert = False
                    Exit Function
                End If
                strColor = Mid(intext, intStartPostion + intStartUBBLen, intJHEndPostion - intStartPostion - intStartUBBLen)
                strContent = Mid(intext, intStartPostion + intStartUBBLen + Len(strColor) + 1, intEndPostion - intStartPostion - intStartUBBLen - Len(strColor) - 1)
            Else
                strContent = Mid(intext, intStartPostion + intStartUBBLen, (intEndPostion - intStartPostion - intStartUBBLen))
            End If
            ‘’UBB处理
            Select Case Ucase(UBB)
            ‘’黑体
            Case "B"
                strFinish = "<b>" & strContent & "</b>"
            Case "URL"
                strFinish = "<a href=" & strContent & ">" & strContent & "</a>"
            ‘’你可以增加其他标记
            Case "URL1"
                ‘’在另一个窗口打开
                strFinish = "<a href=" & strContent & " target=_blank>" & strContent & "</a>"
            Case "IMG"
                strFinish = "<img src=" & strContent & ">"
            Case "#"
                strFinish = "<font color=#" & strColor & ">" & strContent & "</font>"
            End Select
            ‘’替换
            If UBB = "#" Then
                intext = Replace(intext, strStartUBB & strColor & "]" & strContent & strEndUBB, strFinish, 1, -1, 1)
            Else
                intext = Replace(intext, strStartUBB & strContent & strEndUBB, strFinish, 1, -1, 1)
            End If
        End If
        intStart = intStartPostion + 1
        intStartPostion = InStr(intStart, intext, strStartUBB, 1)
    Loop
    Convert = True
End Function

//站长:webmaster@chinaasp.com 注：此段代码不是Chinaasp采用的代码，chinaasp的代码是露茜所作， 

原文转自：http://www.ltesting.net