程序代码 <%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%> <% option explicit response.charset = "UTF-8" session.codepage = 65001 session.timeout = 1440 server.scripttimeout = 9999
'---------------------------------------------------- '功能: ASP自动获取匹配文章标签(Tags)、关键字 '参数: strTitle 标题 ' strContent 内容 '返回: 0:无匹配标签 其他:以英文半角逗号分隔的标签列表 '说明:标签关键字调用Discuz标签关键字列表 'From:http://www.dlstu.cn/code/default.asp?id=1781 '---------------------------------------------------- Function ShowTags(ByVal strTitle, ByVal strContent) Dim XML, objNodes, XMLPath, i strTitle = Server.URLEncode(strTitle) strContent = Server.URLEncode(strContent) XMLPath="http://keyword.discuz.com/related_kw.html?title="&strTitle&"&content="&strContent&"&ics=utf-8&ocs=utf-8" 'From:http://www.knowsky.com Set XML = server.CreateObject("Microsoft.XMLDOM") With XML .async = "false" .resolveExternals = "false" .setProperty "ServerHTTPRequest", true .load(XMLPath) If .getElementsByTagName("info")(0).selectSingleNode("count").Text > 0 Then Set objNodes = .getElementsByTagName("item") For i = 0 to objNodes.length - 1 ShowTags = ShowTags & Trim(objNodes(i).selectSingleNode("kw").Text)&"," Next Set objNodes = Nothing ShowTags = Left(ShowTags,Len(ShowTags)-1) Else ShowTags = 0 End If End With Set XML = Nothing End Function
'应用 Response.write ShowTags("逸品天空Web开发代码站ASP及其他Web开发相关经典代码收集博客 - ASP交流QQ群12814238(满) 14725152(开放)http://code.dlstu.cn","逸品天空Web开发代码站ASP及其他Web开发相关经典代码收集博客 - ASP交流QQ群12814238(满) 14725152(开放)http://code.dlstu.cn") %>
|