高分寻求专家: asp代码实现文章内容关键字链接替换

[goldtogo]

高分寻求专家: asp代码实现文章内容关键字链接替换

数据库 表 keylink

字段 ID 关键字名称 链接 优选级别
ID KEYNAME LINK YX
1 网络 /wangluo.asp 1
2 网络技术 /wangluojishu.asp 100




文章内容: 网络技术网络;网络应用 网络基本知识<img src='/sss.jpg' alt='网络技术网络;网络应用 '><a href="http://www.stobar.cn">网络技术网络;网络应用 网络基本知识</a>

要求 :把文章内容中含有表中关键字的地方加上链接 ,注意优先级别高的先替换;文章中含有图片Alt提示的地方跳过,不然添加链接后图片显示出错;已经有链接的也跳过,不替换;

请给位专家帮忙写个ASP的函数

[lyp464686109]

up

[抱抱我的小猫]

把替换量读入数组让后处理

dim str
dim rstr(100)
rstr(0) = "网络:<a href='/wangluo.asp'>网络</a>"

str = "..."
response.write replace(str,split(rstr(0),":")(0),split(rstr(0),":")(1))

[yangtzeu]

这样恐怕对服务器造成负担

[草原可可]

这个对服务器有负担 其实用replace就可以了

[斯洛文尼亚旅游]

参考下面的代码,把含关键字的已经不需要替换的标签加入Scripting.Dictionary中

'把含有关键字和新生成的a标签加入字典中
function AddToDic(key)
  pattern="<[^>]*"&key&"[^>]*>|<a[^>]*>[^<]*"&key&"[^<]*<\/a>"
  reg.Pattern=pattern
  set matches=reg.Execute(str)
  for each m in matches
    dic.Add "key"&Index,m.value    
    str=replace(str,m.value,"$key"&Index&"$")
    Index=Index+1
  next
  set matches=nothing
end function
'把原来设置标签替换回字典中的值
sub getBackStr
 for i=0 to Index-1 
   str=replace(str,"$key"&i&"$",dic.Item("key"&i))
 next
end sub

dim str
str="网络技术网络;网络应用 网络基本知识 <img src='/sss.jpg' alt='网络技术网络;网络应用'><a  href=""http://www.stobar.cn"">"&_
   "网络技术网络;网络应用 网络基本知识</a>"
dim dic'字典
set dic=server.CreateObject("scripting.dictionary")
dim Index:Index=0
dim rs,cn,cnstr
set cn=server.CreateObject("adodb.connection")
cnstr="provider=microsoft.jet.oledb.4.0;data source="&server.MapPath("t.mdb")
cn.Open cnstr
set rs=cn.Execute("select keyname,link from keylink order by YX desc")
dim reg
set reg=new RegExp
reg.Global=true
reg.IgnoreCase=true
dim pattern,matches,m,ky
do while not rs.eof
  ky=trim(rs(0))
  AddToDic(ky)
  reg.Pattern=ky'=======把含有关键字的非要替换的标签加入字典
  str=replace(str,ky,"<a href='"&rs(1)&"'>"&ky&"</a>")
  AddToDic(ky)'=======把替换好后的标签加入字典
  rs.movenext
loop
rs.close
set rs=nothing
cn.Close
set cn=nothing
set reg=nothing

call getBackStr

set dic=nothing
response.Write str

[yeyuxuan2006]

不错,顶一下

[jspadmin]

正则表达式实现。

[gingerkang]

思路=>
步骤,1.根据优先级读出keylink数据到数组,2循环数组正则替换所有含有的LINK超链接,3循环数组替换alt,title,超链接中的KEYNAME为特殊标记a,4循环数组替换文字内容为特殊标记b,5循环数组还原特殊标记为自己想要的结果.

目前我维护的网站做seo优化也正要搞这个,按照这个思路比较麻烦,不知道大家谁有更好的方法.

[goldtogo]

谢谢各位!;我测试下后马上散分!

[斯洛文尼亚旅游]

function AddToDic(reg,key,Index,str,dic)
  pattern="<[^>]*"&key&"[^>]*>|<a[^>]*>[^<]*"&key&"[^<]*<\/a>"
  reg.Pattern=pattern
  set matches=reg.Execute(str)
  for each m in matches
    dic.Add "key"&Index,m.value    
    str=replace(str,m.value,"$key"&Index&"$")
    Index=Index+1
  next
  set matches=nothing
end function

function startReplace(str)
 dim TempStr:TempStr=str
 dim dic'字典
 set dic=server.CreateObject("scripting.dictionary")
 dim Index:Index=0
 dim rs,cn,cnstr
 set cn=server.CreateObject("adodb.connection")
 cnstr="provider=microsoft.jet.oledb.4.0;data source="&server.MapPath("t.mdb")
 cn.Open cnstr
 set rs=cn.Execute("select keyname,link from keylink order by YX desc")
 dim reg
 set reg=new RegExp
 reg.Global=true
 reg.IgnoreCase=true
 dim pattern,matches,m,ky
 do while not rs.eof
   ky=trim(rs(0))
   AddToDic reg,ky,Index,TempStr,dic
   TempStr=replace(TempStr,ky,"<a href='"&rs(1)&"'>"&ky&"</a>")
   AddToDic reg,ky,Index,TempStr,dic
   rs.movenext
 loop
 rs.close
 set rs=nothing
 cn.Close
 set cn=nothing
 set reg=nothing

 for i=0 to Index-1 
   TempStr=replace(TempStr,"$key"&i&"$",dic.Item("key"&i))
 next
 set dic=nothing
 startReplace=TempStr
end function



dim str
str="网络技术网络;网络应用 网络基本知识 <img src='/sss.jpg' alt='网络技术网络;网络应用'><a  href=""http://www.stobar.cn"">"&_
   "网络技术网络;网络应用 网络基本知识</a>"
str=startReplace(str)
response.Write str

[goldtogo]

您正在与showbo 交谈！ 添加 showbo 为您的好友 | 将 showbo 加入黑名单
goldtogo 2008年01月10日 12点43分59秒 说：
http://topic.csdn.net/u/20080108/10/956a6f78-613d-41d9-840b-12312db156d3.html
goldtogo 2008年01月10日 12点44分12秒 说：
您好;打扰你一下
goldtogo 2008年01月10日 12点46分00秒 说：
把这个写个函数吧; function innerlink(str)
innerlink=str
end function
goldtogo 2008年01月10日 12点46分17秒 说：
谢谢;

[moyankang]

支持一下！谢谢分享1

[flyingsnowy]

这个要收藏一下，一会看。

[longtramp]

标记一下

[jiangjinsong]

支持一下