新云4.0自动加TAGS

新云4.0采集系统自动分词，自动加上TAGS。在admin_savedata.asp中修改。


复制内容到剪贴板程序代码
<!--#include file="../inc/cls_tags.asp"-->
复制内容到剪贴板程序代码
'***********************************
'        自动TAGS  start
'***********************************
    Dim allhits,showtag,Taglist
    Dim xml, objNodes, myxml
'***********************************
'        自动TAGS  end
'***********************************
复制内容到剪贴板程序代码
'***********************************
'        自动TAGS  start
'***********************************
            showtag = ""
            myxml="http://keyword.discuz.com/related_kw.html?title="&NewAsp.RequestForm(m_strTitle,255)&NewAsp.RequestForm(m_strSubTitle,200)&"&content="&m_strContent&"&ics=utf-8&ocs=utf-8"
            set xml = server.CreateObject("Microsoft.XMLDOM")
            xml.async = "false"
            xml.resolveExternals = "false"
            xml.setProperty "ServerHTTPRequest", true
            xml.load(myxml)
            On Error Resume Next
            If xml.getElementsByTagName("info")(0).selectSingleNode("count").Text > 0 Then
                Set objNodes = xml.getElementsByTagName("item")
                For i = 0 to objNodes.length - 1
                    showtag = showtag & Trim(objNodes(i).selectSingleNode("kw").Text)&" "
                Next

                Tag.ChannelID=ChannelID
                Tag.Modules=2
                Tag.classid=classid
                Tag.Taghits=allhits
                Tag.IsBest=0
                Tag.IsTop=0
                Tag.TagString=showtag
                Tag.tagList=""
                Tag.AddNewTags()
                Taglist=Tag.tagList&"|"&Tag.checkTagString(showtag)
                if len(trim(Taglist))>1 then
                    Rs("Taglist")=Taglist
                end if
            End If
'***********************************
'        自动TAGS  end
'***********************************


该文章转载自鹰立鹤群博客：http://www.leoyung.com/article/8036.htm

文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags: 新云新云
相关日志: