编程开发 > ASP > 文章内容

实现搜索结果的关键词变色标注的程序(使用正则表达式)

2011-3-18编辑:lily
<%
' 以前写全文检索程序的时候写的.
' 原创 by 飞鸟@dev-club.com
' Email: flybird@dev-club.com
' ie5.5 脚本引擎 required

    dim patern
    dim found
    
    dim str
    dim result
    
    patern="(a)|(b)"
    str=" A dog fall in love with a cat. Can you believe?"
    result=""    
    call getMatchText(str,result,false)
    Response.Write result

    sub getMatchText(byref str,byref result,isNeedTrunc)
        'on error resume next
        Dim regEx, Match, Matches
        dim tStr
        Set regEx = New RegExp         ' 建立正则表达式。  考试用书      
        regEx.Pattern = (patern)    ' 设置模式。
        regEx.IgnoreCase = True         ' 设置是否区分字符大小写。
        regEx.Global = True         ' 设置全局可用性。
        Set Matches = regEx.Execute(str)   ' 执行搜索。    
        if err.number<>0 then
            response.write "错误1:" & err.description
            err.clear
            exit sub
        end if

        if matches.count <>0 then
            dim startIndex            
            dim myMatchValue
            startIndex=1
            for each match in matches
                if (instr(str,match.value)>0) then
                    if instr(str,match.value)-50 >0 then
                        startIndex=instr(str,match.value)-50
                    else
                        startIndex=1
                    end if
                    myMatchValue=match.value
                    exit for
                end if
            next
            if isNeedTrunc then
                result= (mid(str,startIndex,strLength(myMatchValue)+100))
            else
                result= (str)    
            end if
            for each match in matches
                if not(instr(result,"<font color=red>" & match.value & "</font>")>0) then
                    result=replace(result,match.value,"<font color=red>" & match.value & "</font>" )
                end if
            next
            found=true
        else
            found=false
        end if    
        set regEx=nothing
    end sub
    
%>
三种禁用FileSystemObject组件的方法

热点推荐

登录注册
触屏版电脑版网站地图