网站内链模块是SEO常提到的一个优化模块,给关键词锚文本添加超链接,如果手动添加,既不好维护也浪费人力,下面青岛星网跟大家分享: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