复制代码 代码如下:
<%
' atom2rss.asp
' Author: Francesco Passantino
' Email: francesco@iteam5.net
' Blog: www.iteam5.net/blog
' Start date: 17 Sep 2004
Sub atom2rss(URL)
Set objXML = Server.CreateObject("msxml2.DOMDocument.3.0")
objXML.async = false
objXML.setProperty "ServerHTTPRequest", True
objXML.validateOnParse = true
objXML.preserveWhiteSpace = false
If Not objXML.Load(URL) Then
Response.write "<P>ERROR<br>code: " & _
objXML.parseError.errorCode & _
"<br>Linea/Col: " & _
objXML.parseError.line & "/" & _
objXML.parseError.linepos & "</P>"
Else
rsstitle="iteam5.net/blog"
rssdescription="Blog sulle novit?del settore Information & Communication Technologies"
rsslink="http://www.iteam5.net/blog"
rsslanguage="it"
xml= "<?xml version=""1.0"" encoding=""UTF-8""?><rss version=""0.91""><channel><title>"&server.htmlencode(rsstitle)&"</title><description>"&server.htmlencode(rssdescription)&"</description><link>"&server.htmlencode(rsslink)&"</link><language>"&server.htmlencode(rsslanguage)&"</language>"
Set objNodeList = objXML.getElementsByTagName("entry")
For Each objNode In objNodeList
For Each objNode2 In objNode.childNodes
Select Case objNode2.nodeName
Case "issued"
strdate= left(objNode2.firstChild.nodevalue,10)
Case "link"
strURL = objNode2.GetAttribute("href")
Case "title"
strTitle = objNode2.firstChild.nodevalue
'instead of Case "content"
Case "summary"
strDescription = objNode2.firstChild.data
For Each objNode3 In objNode2.childNodes
Select Case objNode3.nodeName
Case "div"
StrDescription = objNode3.text
For Each objNode4 In objNode3.childNodes
Select Case objNode4.nodeName
Case "a"
linkable=objNode4.firstChild.text
htmlink=" <a href='"& _
objNode4.GetAttribute("href")&"'>"& _
linkable&"</a>"
StrDescription = replace(StrDescription,linkable,htmlink)
end select
next
end select
next
End Select
Next
xml= xml & "<item>"
xml=xml & "<title><![CDATA[" & server.htmlencode(strTitle) & "]]></title>"
xml=xml & "<description><![CDATA[" & server.htmlencode(strDescription) & "]]></description>"
xml=xml & "<link><![CDATA[" & server.htmlencode(strURL) & "]]></link></item>"
strTitle = ""
strURL = ""
strDescription = ""
Next
xml = xml & "</channel></rss>"
response.ContentType = "text/xml"
response.write xml
set objNodeList = Nothing
End if
End sub
call atom2rss("http://www.iteam5.net/blog/feed.xml")
%>
<%
' atom2rss.asp
' Author: Francesco Passantino
' Email: francesco@iteam5.net
' Blog: www.iteam5.net/blog
' Start date: 17 Sep 2004
Sub atom2rss(URL)
Set objXML = Server.CreateObject("msxml2.DOMDocument.3.0")
objXML.async = false
objXML.setProperty "ServerHTTPRequest", True
objXML.validateOnParse = true
objXML.preserveWhiteSpace = false
If Not objXML.Load(URL) Then
Response.write "<P>ERROR<br>code: " & _
objXML.parseError.errorCode & _
"<br>Linea/Col: " & _
objXML.parseError.line & "/" & _
objXML.parseError.linepos & "</P>"
Else
rsstitle="iteam5.net/blog"
rssdescription="Blog sulle novit?del settore Information & Communication Technologies"
rsslink="http://www.iteam5.net/blog"
rsslanguage="it"
xml= "<?xml version=""1.0"" encoding=""UTF-8""?><rss version=""0.91""><channel><title>"&server.htmlencode(rsstitle)&"</title><description>"&server.htmlencode(rssdescription)&"</description><link>"&server.htmlencode(rsslink)&"</link><language>"&server.htmlencode(rsslanguage)&"</language>"
Set objNodeList = objXML.getElementsByTagName("entry")
For Each objNode In objNodeList
For Each objNode2 In objNode.childNodes
Select Case objNode2.nodeName
Case "issued"
strdate= left(objNode2.firstChild.nodevalue,10)
Case "link"
strURL = objNode2.GetAttribute("href")
Case "title"
strTitle = objNode2.firstChild.nodevalue
'instead of Case "content"
Case "summary"
strDescription = objNode2.firstChild.data
For Each objNode3 In objNode2.childNodes
Select Case objNode3.nodeName
Case "div"
StrDescription = objNode3.text
For Each objNode4 In objNode3.childNodes
Select Case objNode4.nodeName
Case "a"
linkable=objNode4.firstChild.text
htmlink=" <a href='"& _
objNode4.GetAttribute("href")&"'>"& _
linkable&"</a>"
StrDescription = replace(StrDescription,linkable,htmlink)
end select
next
end select
next
End Select
Next
xml= xml & "<item>"
xml=xml & "<title><![CDATA[" & server.htmlencode(strTitle) & "]]></title>"
xml=xml & "<description><![CDATA[" & server.htmlencode(strDescription) & "]]></description>"
xml=xml & "<link><![CDATA[" & server.htmlencode(strURL) & "]]></link></item>"
strTitle = ""
strURL = ""
strDescription = ""
Next
xml = xml & "</channel></rss>"
response.ContentType = "text/xml"
response.write xml
set objNodeList = Nothing
End if
End sub
call atom2rss("http://www.iteam5.net/blog/feed.xml")
%>
标签:
atom2rss.asp
免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件!
如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
桃源资源网 Design By www.nqtax.com
暂无“atom2rss.asp”评论...