程式碼
< %@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.downcodes.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")
%>