Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

xanburzum

[Resolvido] diversos feeds RSS

Por , em ASP Clássico

Recommended Posts

xanburzum    169

xanburzum
Postado

Este script terá diversos feeds RSS e combiná-los em um feed para mostrar. O script abaixo irá ter os feeds, jogue fora as notícias duplicadas e também ordená-los por data fazendo tudo aparecer para o visitante como um feed de notícias único.

Os exemplos abaixo mostram como usar RSS Feeds do Google. No entanto, ele irá trabalhar com feeds RSS de qualquer fonte válida.

 

Ela funciona por agarrar cada um RSS Feed, em seguida, criar uma matriz de cada item de notícia. Como ele percorre as próximas notícias alimentando-o, e, compara cada manchete para ver se ele já foi adicionado na matriz. Após cada alimentação da notícia baixada e filtrado para duplicatas, ele classifica a matriz no novo feed de notícias por data de publicação. Após a triagem acontece temos então a opção de como deseja exibir o novo feed de notícias.

Você pode usar esse script para mostrar vários feeds RSS para o navegador da Web ou para gerar um novo feed RSS.

 

<%

 x = 0 'Declare artigo Count

 dim TitleArr() 'Declare array por títulos feed de notícias

 dim LinkArr() 'Declare array para links feed de notícias

 dim DescArr() 'Declarar array para descrições feed de notícias

 dim DateArr() 'Declare array de datas feed de notícias





 Sub BuildRSS(TheFeed)



    Set objXML = Server.CreateObject("Microsoft.XMLDOM")



       objXML.Async = False

       objXML.SetProperty "ServerHTTPRequest", True

       objXML.ResolveExternals = True

       objXML.ValidateOnParse = True

       objXML.Load(TheFeed) 'Load News Feed



       If (objXML.parseError.errorCode = 0) Then

          Set objRoot = objXML.documentElement

          If IsObject(objRoot) = False Then

             Response.Write "Houve um erro ao recuperar a <i>" & _

                            TheFeed & _

                            "</i> novo feed "

          Else



             Set objItems = objRoot.getElementsByTagName("item")

                If IsObject(objItems) = True Then

                   For Each objItem in objItems

                      On Error Resume Next

                      TheTitle =  objItem.selectSingleNode("title").Text

                      TheLink =  objItem.selectSingleNode("link").Text

                      TheDesc =  objItem.selectSingleNode("description").Text

                      TheDate =  objItem.selectSingleNode("pubDate").Text



                     DoAddToArr = True

                     'Percorrer array título procurando artigos duplicados

                     'Se ele não existir, adicione a matriz

                     If x > 0 Then

                       For y = 0 to UBound(TitleArr)

                          If TheTitle = TitleArr(y) Then

                            DoAddToArr = False

                          End If

                       Next

                     End If



                      ReDim Preserve TitleArr(x)

                      ReDim Preserve LinkArr(x)

                      ReDim Preserve DescArr(x)

                      ReDim Preserve DateArr(x)



                     If DoAddToArr = True Then



                      TitleArr(x) = TheTitle

                      LinkArr(x) = TheLink

                      DescArr(x) = TheDesc

                      DateArr(x) = TheDate



                       x = x + 1

                     End If



                   Next

                End If

             Set objItems = Nothing

          End If

          Set objRoot = Nothing

       Else

          Response.Write "Houve um erro ao recuperar o <i>" & _

                            TheFeed & _

                            "</i> novo feed "

       End If



    Set objXML = Nothing

 End Sub



  TheFeed =  "http://news.google.com/news" & _

             "?output=rss" & _

             "&num=100" & _

             "&q=triumph-motorcycles"

 BuildRSS(TheFeed)



  'Receba as próximas notícias feed

  TheFeed =  "http://news.google.com/news" & _

             "?output=rss" & _

             "&num=100" & _

             "&q=triumph-speedmaster"

 BuildRSS(TheFeed)

 

'Continue repetindo até que você tenha

 'Todos os feeds que você gostaria de combinar



 'Organizar os artigos de notícias por data

 'O novo em cima

 TempLinkVal = ""

 TempTitleVal = ""

 TempDescVal = ""

 TempDateVal = ""

 For r = 0 to UBound(DateArr)

      For s=r+1 to UBound(DateArr)

         If DateArr(r)<DateArr(s) then

            TempLinkVal = LinkArr(r)

            TempTitleVal = TitleArr(r)

            TempDescVal = DescArr(r)

            TempDateVal = DateArr(r)



            LinkArr(r)=LinkArr(s)

            TitleArr(r)=TitleArr(s)

            DescArr(r)=DescArr(s)

            DateArr(r)=DateArr(s)



            LinkArr(s) = TempLinkVal

            TitleArr(s) = TempTitleVal

            DescArr(s) = TempDescVal

            DateArr(s) = TempDateVal

         End If

      Next

 Next



 'Mostrar os resultados

 For x = 0 to UBound(TitleArr)

    Response.Write "<div id=" & chr(34) & "Newsitem" & x & chr(34) & ">" & chr(13)





    Response.Write "<a href=" & chr(34) & LinkArr(x) & chr(34) & " " & _

                       "style=" & chr(34) & "font-weight:bold;" & chr(34) & ">" & chr(13) & _

                       TitleArr(x) & chr(13) & _

                    "</a>" & chr(13) & _

                        

    Response.Write "<div style=" & chr(34) & "padding-left:20px;" & chr(34) & ">" & chr(13) & _

                        DescArr(x) & chr(13) & _

                            "<div style=" & chr(34) & "padding-left:20px;" & chr(34) & ">" & chr(13) & _

                            DateArr(x) & chr(13) & _

                            "</div>" & chr(13) & _

                        "</div>" & chr(13)



    Response.Write "</div>" & chr(13) & chr(13)

 Next

 %>

Aqui está o código para a criação de um novo feed de notícias RSS:

 

<?xml version="1.0" encoding="ISO-8859-1"?>

 <%

   Response.Buffer = true

   Response.ContentType = "text/xml"

 %>

 <rss version="2.0">



 <channel>

 <title>News</title>

 <link>http://www.site.com/News.asp</link>

 <description>

          News and Headlines

 </description>

 <image>

       <url>http://www.seu_link.com/Img/teste/testeCentury.jpg</url>

       <title> news</title>

       <link>http://www.seu_link.com/teste.asp</link>

 </image>

 <language>pt-br</language>

 <%



 x = 0 

 dim TitleArr() 

 dim LinkArr() 

 dim DescArr() 

 dim DateArr() 





 Sub BuildRSS(TheFeed)



    Set objXML = Server.CreateObject("Microsoft.XMLDOM")



       objXML.Async = False

       objXML.SetProperty "ServerHTTPRequest", True

       objXML.ResolveExternals = True

       objXML.ValidateOnParse = True

       objXML.Load(TheFeed) 'Load News Feed



       If (objXML.parseError.errorCode = 0) Then

          Set objRoot = objXML.documentElement

          If IsObject(objRoot) = False Then

             Response.Write "Houve um erro ao recuperar o <i>" & _

                            TheFeed & _

                            "</i> novo feed "

          Else



             Set objItems = objRoot.getElementsByTagName("item")

                If IsObject(objItems) = True Then

                   For Each objItem in objItems

                      On Error Resume Next

                      TheTitle =  objItem.selectSingleNode("title").Text

                      TheLink =  objItem.selectSingleNode("link").Text

                      TheDesc =  objItem.selectSingleNode("description").Text

                      TheDate =  objItem.selectSingleNode("pubDate").Text



                     DoAddToArr = True

            

                     If x > 0 Then

                       For y = 0 to UBound(TitleArr)

                          If TheTitle = TitleArr(y) Then

                            DoAddToArr = False

                          End If

                       Next

                     End If



                      ReDim Preserve TitleArr(x)

                      ReDim Preserve LinkArr(x)

                      ReDim Preserve DescArr(x)

                      ReDim Preserve DateArr(x)



                     If DoAddToArr = True Then



                      TitleArr(x) = TheTitle

                      LinkArr(x) = TheLink

                      DescArr(x) = TheDesc

                      DateArr(x) = TheDate



                       x = x + 1

                     End If



                   Next

                End If

             Set objItems = Nothing

          End If

          Set objRoot = Nothing

       Else

          Response.Write "Houve um erro ao recuperar o<i>" & _

                            TheFeed & _

                            "</i> novo feed "

       End If



    Set objXML = Nothing

 End Sub



  'Get the news feed

  TheFeed =  "http://news.google.com/news" & _

             "?output=rss" & _

             "&num=100" & _

             "&q=triumph-motorcycles"

 BuildRSS(TheFeed)



  'Get the next news feed

  TheFeed =  "http://news.google.com/news" & _

             "?output=rss" & _

             "&num=100" & _

             "&q=triumph-speedmaster"

 BuildRSS(TheFeed)

 

 TempLinkVal = ""

 TempTitleVal = ""

 TempDescVal = ""

 TempDateVal = ""

 For r = 0 to UBound(DateArr)

      For s=r+1 to UBound(DateArr)

         If DateArr(r)<DateArr(s) then

            TempLinkVal = LinkArr(r)

            TempTitleVal = TitleArr(r)

            TempDescVal = DescArr(r)

            TempDateVal = DateArr(r)



            LinkArr(r)=LinkArr(s)

            TitleArr(r)=TitleArr(s)

            DescArr(r)=DescArr(s)

            DateArr(r)=DateArr(s)



            LinkArr(s) = TempLinkVal

            TitleArr(s) = TempTitleVal

            DescArr(s) = TempDescVal

            DateArr(s) = TempDateVal

         End If

      Next

 Next



 For x = 0 to UBound(TitleArr)



    Response.Write "<item>" & chr(13)

    Response.Write "<title>" & TitleArr(x) & "</title>" & chr(13)

    Response.Write "<link>#34; & LinkArr(x) & "</link>" & chr(13)

    Response.Write "<description>" & DescArr(x) & "</description>" & chr(13)

    Response.Write "<pubDate>" & DateArr(x) & "</pubDate>" & chr(13)

    Response.Write "</item>" & chr(13)



 Next

%>



 </channel>

 </rss>

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito