ASP实现关键词自动添加超链接代码与使用方法

网站内链模块是SEO常提到的一个优化模块,给关键词锚文本添加链接,如果手动添加,既不好维护也浪费人力,下面编程之家跟大家分享:ASP实现关键词自动添加链接代码与使用方法

ASP关键词自动替换函数代码如下

function key_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 keywords_link(byval str)

dim rs

set rs=conn.execute("select * from [tag] 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

相关文章

数组的定义 Dim MyArray MyArray = Array(1‚5‚123‚12‚98...
\'参数: \'code:要检测的代码 \'leixing:html或者ubb \'n...
演示效果: 代码下载: 点击下载
环境:winxp sp2 ,mysql5.0.18,mysql odbc 3.51 driver 表采...
其实说起AJAX的初级应用是非常简单的,通俗的说就是客户端(j...
<% ’判断文件名是否合法 Function isFilename(aFilename...