朽木

Function keywords_link(byval str)
Dim rs
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
 
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