第一步一般是建立一个关键字替换表 如 id keyword url 等字段

第二步是文章显示时把【文章】内容和【关键字替换表】对应的关键字替换成“<a href="[url字段]" target="_blank">[keyword字段]</a>”

如【关键字替换表】
核桃 http://www.todocn.com
核桃博客 http://www.todocn.com/blog/

替换内容： 核桃博客

1、替换结果为 <a href="http://www.todocn.com" target="_blank">核桃</a>博客

这个显然不是我们想得到的结果

解决方法：替换顺序需要调整为，先长后短。即先替换“核桃博客”再替换“核桃”

2、替换结果为 <a href="http://www.todocn.com/blog/" target="_blank"><a href="http://www.todocn.com" target="_blank">核桃</a>博客<a>

这个乱套了！第二次把a标签之间的文字替换掉了。

解决方法：替换时不替换a标签之间的文字,避免重复替换。

现在把我写的代码复制出来供大家参考

调用代码：
 

文章内容=keywords_link(文章内容)

替换函数：
 

'关键字
function keywords_link(byval str)
 dim rs
 '问题1解决办法
 set rs=conn.execute("select * from [关键字替换表] order by len(keyword字段) desc")
 while not rs.eof
 str=p_replace(str,rs("keyword字段"),"<a href="""&rs("url字段")&""" target=""_blank"" >"&rs("keyword字段")&"</a>")
 rs.movenext
 wend
 rs.close
 set rs=nothing
 keywords_link=str
end function
 '问题2解决函数 避免重复替换
function p_replace(byval content,byval asp,byval htm)
dim Matches,objRegExp,strs,i
strs=content
Set objRegExp = New Regexp'设置配置对象
objRegExp.Global = True'设置为全文搜索
objRegExp.IgnoreCase = True
objRegExp.Pattern = "(\<a[^<>]+\>.+?\<\/a\>)|(\<img[^<>]+\>)"'
Set Matches =objRegExp.Execute(strs)'开始执行配置
'替换正则表达式
i=0
Dim MyArray()
For Each Match in Matches
ReDim Preserve MyArray(i)
MyArray(i)=Mid(Match.Value,1,len(Match.Value))
strs=replace(strs,Match.Value,"<"&i&">")
i=i+1
Next
'没有正则时候
if i=0 then
 content=replace(content,asp,htm)
 p_replace=content
 exit function
end if
'特殊字符替换
strs=replace(strs,asp,htm)
'替换回去
for i=0 to ubound(MyArray)
strs=replace(strs,"<"&i&">",MyArray(i))
next
p_replace=strs
end function

-------------------------------------------------------------------------------

<%
Function Takeout(patrn,string1,colors)
'提取搜索關鍵字匹配文字
   Dim regEx, Match, Matches, tt        ' 建立變數。
   Set regEx = New RegExp         ' 建立正則運算式。
   regEx.Pattern = patrn         ' 設置模式。
   regEx.IgnoreCase = True         ' 設置是否區分大小寫。
   regEx.Global = True            ' 設置全局可用性。
   Set Matches = regEx.Execute(string1)      ' 執行搜索。
   For Each Match in Matches         ' 遍曆 Matches 集合。
     RetStr = RetStr & Match.Value & " "
   Next
  
   RetStr = trim(RetStr)
   if instr(RetStr," ")>0 then
    for tt = 0 to ubound(split(RetStr," "))
      string1 = replace(string1,split(RetStr," ")(tt),"<font color="""&colors&""">"&split(RetStr,"")(tt)&"</font>")
next
   else
   string1 = replace(string1,RetStr,"<font color="""&colors&""">"&RetStr&"</font>")
   end if
   Takeout = string1
End Function
response.write Takeout("KOe喬客雙", "Joekoe喬客雙語版","red")
Function Highlight(strContent,keyword)'標記高亮關鍵字
     Dim RegEx
     Set RegEx=new RegExp
     RegEx.IgnoreCase =True'不區分大小寫
     RegEx.Global=True
     Dim ArrayKeyword,i
     ArrayKeyword = Split(keyword," ")'用空格隔開的多關鍵字
     For i=0 To Ubound(ArrayKeyword)
         RegEx.Pattern="("&ArrayKeyword(i)&")"
         strContent=RegEx.Replace(strContent,"<font color=red>$1</font>" )
     Next
     Set RegEx=Nothing
     Highlight=strContent
End Function
response.write Highlight("Joekoe喬客雙語版","jOeKOe")

%>

--------------------------------------------------
其它资料：
http://zhidao.baidu.com/question/42187520.html