ASP常用函数自动获取匹配文章标签（Tags）、关键字：ShowTags()

程序代码

<%@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)&","

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")