Simple RSS reader for your applications...

[Andrés González]

Enrico, now the program is working perfectly without putting the objet to nil. By the way, I think is important liberate memory when you don't need the object, in my case after I merge de document with the dbf.

[nageswaragunupudi]

Glad the problem I experienced months back is fixed now. Its my mistake that I did not report at that time in the right forums.

Mr Antonio

Are you planning to publish revised builds with this fix ?

[Antonio Linares]

Dear Rao,

yes, we will publish a new xHarbour build with this fix, asap

[Silvio]

sorry,
I want try feedrss but it not run ok

[Silvio]

sorry,
I want try feedrss with my url www.teramoest.it/dblog/feedrss.asp but I try it but it make error when I insert this url into source


iif( !file("feeds.arr") , ;
EK_SAVEARR( { "http://www.teramoest.it/dblog/feedrss.asp", ;
"http://rss.terra.com.br/0,,EI4795,00.xml" }, "feeds.arr" ), "" )

and it make this error
Application
===========
Path and name: C:\work\errori\feedrss\feedrss.Exe (32 bits)
Size: 1,450,496 bytes
Time from start: 0 hours 0 mins 0 secs
Error occurred at: 08/26/08, 18:57:34
Error description: Error BASE/1004 Class: 'NIL' has no exported method: TEXT
Args:
[ 1] = U

Stack Calls
===========
Called from: => TEXT(0)
Called from: feedrss.prg => FEEDLOADERARRAY(136)
Called from: feedrss.prg => FEEDREADER(34)

[Rochinha]

Silvio,

ASP code is not XML code. Put the real XML link.

[Silvio]

http://www.teramoest.it/dblog/feedrss.asp

If you try you can see it a xlm page ...

look the source code of this page

<?xml version="1.0" encoding="windows-1252"?>
<rss version="0.91" xmlns:dc="http://purl.org/dc/elements/1.1/">

[Rochinha]

Silvio,

Again, ASP is a script and XML is a result.

Your ASP page show a result and FeedReader work on a XML code.

View in your ASP code for XML function treatment.

In the code below i pass .XML file link

EK_SAVEARR( { "http://www.teramoest.it/dblog/feedrss.asp", ;
"http://rss.terra.com.br/0,,EI4795,00.xml" }, "feeds.arr" ), "" )

[karinha]

mejoras para entender mejor la lógica.
improvements to better understand the logic.

Code: Select all  Expand view

// \samples\ROCHINHA.PRG - 27/02/2022 Modified by Joao Santos.

#include "FiveWin.ch"
#include "Splitter.ch"

#Define CLR_LGRAY      nRGB( 230, 230, 230 )

/*
 * *********************************************************
 *
 * FEED READER: Modulo leitor de feeds
 * Autor: Jose Carlos da Rocha
 *
 * *********************************************************
*/

MEMVAR aDatos, aBitmaps, oWnd2, aFeeds, oRSSLbx, cRSSLbx, oChildWnd

STATIC lChildWnd := .T., lSuccess := .F.

FUNCTION FeedReader( oWnd, opcao, lHorizontal )
 
   LOCAL cTitle, oFntLBX, fntArial, oBmp, oBtn01, oBtn02
   LOCAL oGet, oSplit, oBar //, oGraph, oTree
   LOCAL oFRTree, oFRHTML, oFRLbx, oVSplit, oHSplit

   aDatos := {}

   cTitle := "Lector de RSS"

   /*
   aBitmaps := { "bmpbtn15",; // Estatistica
                 "bmpbtn81",; // Graficos
                 "bmpbtn25",; // Em curso
                 "bmpbtn14",; // Clientes
                 "bmp_somatoria" } // Gera Estatisticas
   */


   aBitmaps := { "..\bitmaps\alphabmp\facebook.bmp",;
                 "..\bitmaps\alphabmp\windows.bmp",;
                 "..\bitmaps\alphabmp\game.bmp",;
                 "..\bitmaps\alphabmp\viddler.bmp",;
                 "..\bitmaps\alphabmp\mail.bmp",;
                 "..\bitmaps\alphabmp\call.bmp",;
                 "..\bitmaps\alphabmp\settings2.bmp",;
                 "..\bitmaps\alphabmp\exit.bmp" }


   IF FILE( "feeds.arr" ) // Nuevo

      DELETEFILE( "feeds.arr" )

   ENDIF

   /*
   IIF( .NOT. FILE("feeds.arr") , ;
      EK_SAVEARR( { "https://g1.globo.com/Rss2/0,,AS0-5600,00.xml", ;
                    "https://rss.terra.com.br/0,,EI4795,00.xml" }, "feeds.arr" ), "" )
   */
   IIF( .NOT. FILE("feeds.arr"), ;
      EK_SAVEARR( { "https://g1.globo.com/Rss2/0,,AS0-5600,00.xml"}, "feeds.arr" ), "" )

   aFeeds  := EK_RESTARR( "feeds.arr" )
   cRSSLbx := aFeeds[1]
   aDatos  := FeedLoaderArray( cRSSLbx )

   DEFINE FONT oFntLBX  NAME "Courier New"   SIZE  0,-12
   DEFINE FONT fntArial NAME "Arial"         SIZE 10,22

   DEFINE WINDOW oChildWnd FROM 0,0 TO 600,750 PIXEL TITLE cTitle //MDICHILD STYLE nOr(WS_CHILD,DS_SYSMODAL,DS_MODALFRAME)
   DEFINE BUTTONBAR oBar OF oChildWnd SIZE 24,24 //_3D // Button Bar com efeito 3D / Outlook

   @ 0, 25 SAY " "+cTitle FONT fntArial SIZE 900,150 ;
      COLOR RGB(216,208,200),CLR_GRAY PIXEL OF oBar

   @ .5,  5 BITMAP oBmp RESOURCE "bmpbtn00" SIZE 24,24 NOBORDER SCROLL ;
      UPDATE PIXEL OF oBar

   /*
   @ .5,(oChildWnd:nWidth-72*1) BTNBMP oBtn01 PROMPT "Fechar"    ;
      RESOURCE "bmpbtn24" SIZE 70,24 ;
      ACTION ( oChildWnd:End(), lChildWnd := .f. ) NOBORDER PRESSED ;
      OF oBar LEFT FONT oFntLBX
   */

   @ .5,(oChildWnd:nWidth-72*1) BTNBMP oBtn01 PROMPT "Fechar"    ;
      RESOURCE "bmpbtn24" SIZE 70,24 ;
      ACTION ( oChildWnd:End(), lChildWnd := .f. ) NOBORDER         ;
      OF oBar LEFT FONT oFntLBX

   /*
   @ .5,(oChildWnd:nWidth-72*2) BTNBMP oBtn02 PROMPT "Menu..."   ;
      RESOURCE "bmpbtn92" SIZE 70,24 ;
      ACTION fun() NOBORDER PRESSED OF oBar LEFT FONT oFntLBX
   */

   @ .5,(oChildWnd:nWidth-72*2) BTNBMP oBtn02 PROMPT "Menu..."   ;
      RESOURCE "bmpbtn92" SIZE 70,24 ;
      ACTION fun() NOBORDER OF oBar LEFT FONT oFntLBX

   @ 000,000 LISTBOX oRSSLbx VAR cRSSLbx ITEMS aFeeds SIZE 200,200 PIXEL ;
      OF oChildWnd

   oRSSLbx:nStyle        := 1

   oRSSLbx:bLdblClick := { | nRow, nCol | ( ;
      aDatos := FeedLoaderArray( aFeeds[oRSSLbx:GetPos()] ), ;
                oFRLbx:lHitBottom    := .f.              ,   ;
                oFRLbx:blogiclen     := {|| len(aDatos) },   ;
                oFRLbx:GoTop()                           ,   ;
                oFRLbx:Refresh() ) }

   // ListBox by Hernan? NO USO.
   @ 000,205 LISTBOX oFRLbx FIELDS "" ;
      HEADERS "", "Titulo", "Data" ;
      FIELDSIZES 24, 550, 250 ;
      SIZE 300,200 PIXEL OF oChildWnd UPDATE

   oFRLbx:bLdblClick    := { | nRow, nCol | oFRHTML:Do( "Navigate2", aDatos[oFRLbx:nat][4] ) }

   oFRLbx:nat           := 1
   oFRLbx:bline         := { || { aDatos[ oFRLbx:nat ][ 1 ], ;
                                  aDatos[ oFRLbx:nat ][ 2 ], ;
                                  aDatos[ oFRLbx:nat ][ 3 ]} }

   oFRLbx:bgotop        := { || oFRLbx:nat := 1 }
   oFRLbx:bgobottom     := { || oFRLbx:nat := eval( oFRLbx:blogiclen ) }
   oFRLbx:bskip         := { | nwant, nold | nold := oFRLbx:nat, oFRLbx:nat +=nwant,;
   oFRLbx:nat           := max( 1, min( oFRLbx:nat, eval( oFRLbx:blogiclen ) ) ),;
   oFRLbx:nat - nold }

   oFRLbx:blogiclen     := { || len( aDatos[1] ) }

   oFRLbx:nClrBackHead  := CLR_WHITE  // Cor do Fundo do Cabe‡alho
   oFRLbx:nClrText      := {|| nRGB( 000, 000, 000 ) } // Cor do Fundo do Cabe‡alho
   oFRLbx:nClrBackFocus := CLR_WHITE   // Cor do Cursor Em Cima do Ötem
   oFRLbx:nClrForeFocus := CLR_HRED    // Cor da letra da barra ativa
   oFRLbx:nClrForeHead  := CLR_BLACK   // Cor nos Headers - Cabe‡alhos
   oFRLbx:nColAct       := 1           // Onde o Cursor Vai Iniciar na coluna
   oFRLbx:nLineStyle    := 3           // Estilo das linhas nos dados da Browse
   oFRLbx:lCellStyle    := .T.         // Somente pinta a c‚lula em que o cursor esta no momento
   oFRLbx:aJustify := { .F., .F., .F. }
   oFRLbx:lMChange      := .F.         // Desabilita Mousemove - Movimentos do Mouse Congelam.
   oFRLbx:SetFocus()                   // Refocus on The Browse - Ativa o Foco na ListBox(Browse)
   oFRLbx:Refresh()                    // Estabiliza o Browse/Listbox - Refresca os Dados.

   oFRLbx:SetFont( oFntLBX )

   @ 205,205 ACTIVEX oFRHTML PROGID "Shell.Explorer.2" SIZE 300, 150 ;
      OF oChildWnd

   oFRHTML:Silent := .T.  // Nuevo. Soy increible. jajajajajajaja.

   @ 200,205 SPLITTER oHSplit ;
             HORIZONTAL ;
             PREVIOUS CONTROLS oFRLbx ;
             HINDS CONTROLS oFRHTML ;
             TOP MARGIN 80 ;
             BOTTOM MARGIN 80 ;
             SIZE 300, 4  PIXEL ;
             OF oChildWnd ;
             _3DLOOK

   @ 000,200 SPLITTER oVSplit ;
             VERTICAL ;
             PREVIOUS CONTROLS oRSSLbx ;
             HINDS CONTROLS oFRLbx, oHSplit, oFRHTML ;
             LEFT MARGIN 80 ;
             RIGHT MARGIN 80 ;
             SIZE 4, 355  PIXEL ;
             OF oChildWnd ;
             _3DLOOK

   ACTIVATE WINDOW oChildWnd MAXIMIZED                               ;
      ON INIT ( oFRHTML:Do( "Navigate2", "https://www.yahoo.com" ) ) ;
      ON RESIZE ( oVSplit:AdjLeft(), oHSplit:AdjRight() )

   oFntLBX:End()
   fntArial:End()

RETURN NIL

FUNCTION FeedLoaderArray( cURL )
 
   LOCAL oXMLDoc, cChannelTitle, cChannelLink, cChannelDescr, cChannelCopy
   LOCAL RespText, objXMLHTTP, cXMLFeed, aFeedLoaderArray := {}
   LOCAL X, I, Y

   DEFAULT cURL := "https://g1.globo.com/Rss2/0,,AS0-5600,00.xml"

   // Carrega variavel com conteudo do XML do RSS
   MsgRun( "Puxando arquivo...", "Leitor de RSS", {|| cXMLFeed := FeedPuching( cURL ) } )

   // Bloco de leitura e assinalacao do conteudo do RSS
   oXMLDoc := TOLEAUTO():New( "Microsoft.XMLDOM" )
   oXMLDoc:async := .f.

   lSuccess := oXMLDoc:loadXML( cXMLFeed )

   // ? lSuccess, cUrl

   if lSuccess

      x := oXMLDoc:getElementsByTagName( "channel" )

      cChannelTitle := oXMLDoc:selectNodes("//title"):Item(0):Text
      cChannelLink  := oXMLDoc:selectNodes("//link"):Item(0):Text
      cChannelDescr := oXMLDoc:selectNodes("//description"):Item(0):Text
      cChannelCopy  := oXMLDoc:selectNodes("//copyright"):Item(0):Text

      y := oXMLDoc:getElementsByTagName( "item" )

      for i = 1 to y:length
         // cItemTitle, cItemPDate, cItemLink, cItemDescr
         AADD( aFeedLoaderArray, ;
               { "", oXMLDoc:selectNodes("//item/title"):Item(i-1):Text  , ;
                     oXMLDoc:selectNodes("//item/pubDate"):Item(i-1):Text, ;
                     oXMLDoc:selectNodes("//item/link"):Item(i-1):Text   , ;
                     oXMLDoc:selectNodes("//item/description"):Item(i-1):Text } )

      next

   endif

RETURN aFeedLoaderArray

FUNCTION FeedLoader( cURL )

   LOCAL cChannelTitle, cChannelLink, cChannelDescr, cChannelCopy
   LOCAL cItemTitle, cItemPDate, cItemLink, cItemDescr
   LOCAL RespText, objXMLHTTP, cXMLFeed, oXMLDoc, X, I, Y

   DEFAULT cURL := "https://g1.globo.com/Rss2/0,,AS0-5600,00.xml"
        // cURL := "https://rss.terra.com.br/0,,EI4795,00.xml"

   if recco() <= 0

      // Carrega variavel com conteudo do XML do RSS
      MsgRun( "Puxando arquivo...", "Leitor de RSS", {|| cXMLFeed := FeedPuching( cURL ) } )

      //MemoEdit( cXMLFeed )
      MemoWrit( "feeds.xml", ANSITOOEM( cXMLFeed ) )

      IF FILE( "feeds.xml" )

         MemoEdit( MemoRead( "feeds.xml" ) )

      ENDIF

      MsgRun( "Criando..." )

      // Bloco de leitura e assinalacao do conteudo do RSS
      oXMLDoc := TOLEAUTO():New( "Microsoft.XMLDOM" ) //?? NO COMPRENDO.
      oXMLDoc:async := .f.

      //lSuccess := oXMLDoc:load( "feeds.xml" )
      lSuccess := oXMLDoc:loadXML( cXMLFeed )

      if lSuccess

         x := oXMLDoc:getElementsByTagName( "channel" )

         cChannelTitle := oXMLDoc:selectNodes("//title"):Item(0):Text
         cChannelLink  := oXMLDoc:selectNodes("//link"):Item(0):Text
         cChannelDescr := oXMLDoc:selectNodes("//description"):Item(0):Text
         cChannelCopy  := oXMLDoc:selectNodes("//copyright"):Item(0):Text

         y := oXMLDoc:getElementsByTagName( "item" )

         for i = 1 to y:length
             cItemTitle := oXMLDoc:selectNodes("//item/title"):Item(i-1):Text
             cItemPDate := oXMLDoc:selectNodes("//item/pubDate"):Item(i-1):Text
             cItemLink  := oXMLDoc:selectNodes("//item/link"):Item(i-1):Text
             cItemDescr := oXMLDoc:selectNodes("//item/description"):Item(i-1):Text
             dbAppend( 0 )
             feeds->IDCHANNEL   := cURL
             //
             feeds->CHANNEL     := cChannelTitle
             feeds->CHANNELLIN  := cChannelLink
             feeds->CHANNELDES  := cChannelDescr
             feeds->CHANNELCOP  := cChannelCopy
             //
             feeds->ITEMTITLE   := cItemTitle
             feeds->ITEMPDATE   := cItemPDate
             feeds->ITEMLINK    := cItemLink
             feeds->ITEMDESC    := cItemDescr
             dbCommitAll()
         next
   
         // xBrowse()

      endif

   endif

RETURN NIL

FUNCTION FeedPuching( cURL )
 
   LOCAL oServer, cResponseText

   // oHyperlink := TOLEAuto():New( "Microsoft.XmlHttp" ) // error.

   #IFDEF __XHARBOUR__  // xHarbour

      Try

         oServer:= CreateObject( "MSXML2.ServerXMLHTTP.6.0" )

      Catch

         MsgInfo('Erro na Criação do Serviço')

         Return Nil

      End

   #ELSE

      Try

         oServer:= win_OleCreateObject( "MSXML2.ServerXMLHTTP.5.0")

      Catch

         MsgInfo('Erro na Criação do Serviço!', 'Atenção!')

         Return nil

      End

   #ENDIF

   Try

      oServer:Open( "GET", cURL, .F. )

      oServer:SetRequestHeader( "Content-Type", "application/x-www-form-urlencoded" )
      oServer:SetRequestHeader( "Connection", "keep-alive" )

      oServer:Send()
      oServer:WaitForResponse( 10000 )

      cResponseText := oServer:ResponseText

   Catch

      MsgInfo('Erro na conexão com o site!', 'Atenção!')

      Return nil

   End

   // xBrowse( cResponseText )

   lSuccess := .F.  // return to .F.
   oServer  := NIL

RETURN( cResponseText )
/*
 *
 * *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
 * Descricao: Funcoes para tratamento de arrays
 * *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
 *
*/
FUNCTION EK_SAVEARR(Arg1, Arg2, Arg3)        //Arg1=Array, Arg2=archivo, Arg3=doserror
 
   LOCAL Local1:= Fcreate(Arg2), Local2

   Arg3:= Ferror()

   If (Arg3 == 0)

      Local2:= _eksavesub(Arg1, Local1, @Arg3)

      Fclose( Local1 )

      If (Local2 .AND. Ferror() != 0)

         Arg3:= Ferror()
         Local2:= .F.

      EndIf

    Else

      Local2:= .F.

   EndIf


RETURN( Local2 )

STATIC FUNCTION _EKSAVESUB(Arg1, Arg2, Arg3)
 
   LOCAL Local1, Local2, Local3, lRet

   // private lret

   lret:= .T.

   Local1:= ValType(Arg1)

   Fwrite(Arg2, Local1, 1)

   If (Ferror() == 0)

     Do Case
      Case Local1 = "A"
         Local2:= Len(Arg1)
         Fwrite(Arg2, L2Bin(Local2), 4)
         If (Ferror() == 0)
           AeVal(Arg1, {|_1| lret:= _eksavesub(_1, Arg2)})
          Else
           lret:= .F.
         EndIf
      Case Local1 = "B"
         lret:= .F.
      Case Local1 = "C"
         Local2:= Len(Arg1)
         Fwrite(Arg2, L2Bin(Local2), 4)
         Fwrite(Arg2, Arg1)
      Case Local1 = "D"
         Local2:= 8
         Fwrite(Arg2, L2Bin(Local2), 4)
         Fwrite(Arg2, DToC(Arg1))
      Case Local1 = "L"
         Local2:= 1
         Fwrite(Arg2, L2Bin(Local2), 4)
         Fwrite(Arg2, iif(Arg1, "T", "F"))
      Case Local1 = "N"
         Local3:= Str(Arg1)
         Local2:= Len(Local3)
         Fwrite(Arg2, L2Bin(Local2), 4)
         Fwrite(Arg2, Local3)
     Endcase

    Else

      lret:= .F.

   Endif

   Arg3:= ferror()

RETURN lret

FUNCTION EK_RESTARR(Arg1, Arg2)       // Arg1=Archivo, Arg2=doserror
 
   LOCAL Local1 := Fopen(Arg1), Local2

   Arg2:= Ferror()

   If (Arg2 == 0)
      Local2:= _ekrestsub(Local1, @Arg2)
      FClose(Local1)
    Else
      Local2:= {}
   Endif

RETURN Local2

STATIC FUNCTION _EKRESTSUB(Arg1, Arg2)
 
   LOCAL Local1:= " ", Local2, Local3, Local4, Local5, Local6

   Fread(Arg1, @Local1, 1)

   Local3:= Space(4)

   Fread(Arg1, @Local3, 4)

   Local2:= Bin2L(Local3)

   Arg2:= Ferror()

   If (Arg2 == 0)

      Do Case
      Case Local1 = "A"
         Local4:= {}
         For Local6 := 1 To Local2
            AAdd(Local4, _ekrestsub(Arg1))
         Next Local6
      Case Local1 = "C"
         Local4:= Space(Local2)
         Fread(Arg1, @Local4, Local2)
      Case Local1 = "D"
         Local5:= Space(8)
         Fread(Arg1, @Local5, 8)
         Local4:= CToD(Local5)
      Case Local1 = "L"
         Local5:= " "
         Fread(Arg1, @Local5, 1)
         Local4:= Local5 = "T"
      Case Local1 = "N"
         Local5:= Space(Local2)
         Fread(Arg1, @Local5, Local2)
         Local4:= Val(Local5)
      Endcase

      Arg2:= ferror()

   Endif

RETURN( Local4 )

FUNCTION Fun()
 
RETURN( .T. )
// fin / end
 

Regards, saludos.

[Silvio.Falconi]

[karinha]

Continue aqui...

Continue here...

http://forums.fivetechsupport.com/viewtopic.php?f=3&t=41458&start=15&sid=18966bd0d660e4fa9e41262d631ac302

If you want to lock this topic.

Regards, saludos.