tuzi15 - 2005-10-17 21:01:00
 好文 |
我是先做抓取新闻时自动添加关键字后，想到手工添加新闻时也可以把这个功能用上去。所以两段程序可以说是完全一样的，只是应用的场所不同～
请先备份：
Admin/Info/NewsWords.asp
下面开始修改：
1、打开Admin/Info/NewsWords.asp，拉到倒数第二行（也就是%>的前面），把下面的代码贴上去。
'************************************
'author:lino
'把标题与关键字表中的记录匹配
'Start
'*************************
Function replaceKeywordByTitle(title)
Dim whereisKeyword,i,theKeywordOnNews
Dim keyword,rsRuleObj,theKeywordS
'**********如果3.1版，请把下行Routine改成FS_Routine
Set RsRuleObj = Conn.Execute("Select * from Routine")
do while Not RsRuleObj.Eof
keyword = RsRuleObj("name")
whereisKeyword = InStr(Lcase(title),Lcase(keyword))
if(whereisKeyword>0) then
if(theKeywordOnNews="") then
theKeywordOnNews=keyword
else
theKeywordOnNews=theKeywordOnNews&","&keyword
end if
end if
RsRuleObj.MoveNext
loop
'如果keyword的长度大于100,截去过长的
if(len(theKeywordOnNews)>99) then
theKeywordOnNews=left(theKeywordOnNews,99)
end if
replaceKeywordByTitle = theKeywordOnNews
End function
'**********************
'End
在同一页面（即Admin/Info/NewsWords.asp)中找到
INewsAddObj("KeyWords") = Replace(Replace(Requst("KeywordText"),"""",""),"'","")
或约637行，把
INewsAddObj("KeyWords") = Replace(Replace(Requst("KeywordText"),"""",""),"'","")
换成
'************************************
'author:lino
'把调用replaceKeywordByTitle方法，过滤关键字
'如果用户自定义了关键字，自动设置关键字不起作用
'Start
'*************************
Dim KeywordText
if (Request("KeywordText")="" or isempty(Request("KeywordText"))) then
KeywordText = replaceKeywordByTitle(ITitle)
else
KeywordText = Request("KeywordText")
end if
if KeywordText <> "" then
INewsAddObj("KeyWords") = Replace(Replace(KeywordText,"""",""),"'","")
end if
'End
'***********************************
OK!马上就能用了。
附：[源码分享]---采集新闻时,自动添加关键字---
http://bbs.foosun.net/dispbbs.asp?boardID=24&ID=12277&page=1
这个贴子里有关于这段程序的详细说明～
[此贴子已经被作者于2005-10-28 11:33:46编辑过]
| 好文 |
收藏，非常谢谢!!
'************************************
'author:lino
'把标题与关键字表中的记录匹配
'Start
'*************************
Function replaceKeywordByTitle(title)
Dim whereisKeyword,i,theKeywordOnNews
Dim keyword,rsRuleObj,theKeywordS
Set RsRuleObj = Conn.Execute("Select * from Routine")
do while Not RsRuleObj.Eof
keyword = RsRuleObj("name")
whereisKeyword = InStr(Lcase(title),Lcase(keyword))
if(whereisKeyword>0) then
if(theKeywordOnNews="") then
theKeywordOnNews=keyword
else
theKeywordOnNews=theKeywordOnNews&","&keyword
end if
end if
RsRuleObj.MoveNext
loop
'如果keyword的长度大于100,截去过长的
if(len(theKeywordOnNews)>99) then
theKeywordOnNews=left(theKeywordOnNews,99)
end if
replaceKeywordByTitle = theKeywordOnNews
End function
'**********************
'End
这一段加到Function.asp的倒数第二行里，把NewsPic.asp的
INewsAddObj("KeyWords") = Replace(Replace(Requst("KeywordText"),"""",""),"'","")
换成
'************************************
'author:lino
'把调用replaceKeywordByTitle方法，过滤关键字
'如果用户自定义了关键字，自动设置关键字不起作用
'Start
'*************************
Dim KeywordText
if (Request("KeywordText")="" or isempty(Request("KeywordText"))) then
KeywordText = replaceKeywordByTitle(ITitle)
else
KeywordText = Request("KeywordText")
end if
if KeywordText <> "" then
INewsAddObj("KeyWords") = Replace(Replace(KeywordText,"""",""),"'","")
end if
'End
'***********************************
就行了
[此贴子已经被作者于2005-10-18 8:08:27编辑过]
用了,很爽
能不能把原来生成的数据也都自动加上关键字
想过，但没做～因为原先的数据有可能是手工指定的关键字，精确度要比自动生成的高。这种情况下自动生成关键字会带来一些问题～
[此贴子已经被作者于2005-10-18 11:04:01编辑过]
为何我修改的却不能自动添加关键字呢?!
郁闷.
另:大哥有一个单词书写错误
INewsAddObj("KeyWords") = Replace(Replace(Requst("KeywordText"),"""",""),"'","")
Request
----------
能否将你整理的文件打外包呢?!我严格按照你书写的方法,却能自动添加.关于采集那篇贴子.我也看了...对照着做完后.还在采集的数据库的NEWS表里加上了keywords字段也没OK...不解.
[em49][em49][em49]用不着