Problem With oldest Prg of Rss

[Silvio.Falconi]

Jose Carlos da Rocha created this function I think in 16 bit, but now I find it difficult to visualize the Rss, probably there is an opening error.
I state I have to use this function in Windows Seven, so I cannot use WevViewer because it is not compatible

is there a new release to use ?

[Antonio Linares]

Dear Silvio,

Is the source code available ?

[Silvio.Falconi]

Dear Silvio,

Is the source code available ?

there is in this forum http://forums.fivetechsupport.com/viewtopic.php?f=3&t=12397&p=62165&hilit=rss&sid=5ab529a76a7d20061181423095dac49f&sid=5ab529a76a7d20061181423095dac49f#p62165

[Antonio Linares]

I get this error when running the EXE:

Time from start: 0 hours 0 mins 0 secs
Error occurred at: 02/26/22, 13:38:17
Error description: (DOS Error -2147352567) WINOLE/1007 Acceso denegado.
(0x80070005): msxml3.dll
Args:
[ 1] = C

Stack Calls
===========
Called from: => TOLEAUTO:SEND( 0 )
Called from: rochina.prg => FEEDPUCHING( 208 )
Called from: rochina.prg => (b)FEEDLOADERARRAY( 123 )

[karinha]

I get this error when running the EXE:

Time from start: 0 hours 0 mins 0 secs
Error occurred at: 02/26/22, 13:38:17
Error description: (DOS Error -2147352567) WINOLE/1007 Acceso denegado.
(0x80070005): msxml3.dll
Args:
[ 1] = C

Stack Calls
===========
Called from: => TOLEAUTO:SEND( 0 )
Called from: rochina.prg => FEEDPUCHING( 208 )
Called from: rochina.prg => (b)FEEDLOADERARRAY( 123 )

Master, intente ahora. Con Harbour ó xHarbour, porfa.

Code: Select all  Expand view

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

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

/*
 * *********************************************************
 *
 * 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

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


   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] ) }
   */

   /*  // ListBox by Hernan?
   // Estilo Flat
   oFRLbx:nStyle        := 1
   oFRLbx:nLineStyle    := 10
   oFRLbx:nHeaderStyle  := 2
   oFRLbx:nHeaderHeight := 20
   oFRLbx:nLineHeight   := 15
   oFRLbx:lMChange      := .f.
   oFRLbx:lOnlyBorder   := .f.
   oFRLbx:lAdjLastCol   := .f.
   oFRLbx:Set3DStyle()
   */
   // -> Cabecalho
   oFRLbx:nClrBackHead  := nRGB(194,218,242)
   // -> Linha divisora

   // oFRLbx:nClrLine      := nRGB(194,218,242)

   // -> Cores das linhas Texto e Fundo
   // -> Cor do cursor com foco
   oFRLbx:nClrForeFocus := CLR_BLACK
   oFRLbx:nClrBackFocus := nRGB(194,218,242)

   // -> Cor do cursor sem foco - by Herna
   // oFRLbx:nClrNFFore    := CLR_BLACK
   // oFRLbx:nClrNFBack    := nRGB(194,218,242)
   // oFRLbx:SetFont( oFntLBX )

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

   @ 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.

[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.

[karinha]

https://feedly.com/i/discover

RSS := Rich Summary Text .or. Really Simple Syndication

Regards, saludos.

[Silvio.Falconi]

I tried with the major Italian feeds and only some work, many run if they are with the xlm extension, the fivetech site runs well calling rss.php probably because rss.php converts to xlm automatically. I would like to use these functions to display school news from major school news sites in a main window, once this script worked, I don't know if it's the fault of the Tole class or the protocols no longer work.

[karinha]

Silvio, que tal?

https://imgur.com/uxHOEnu

[karinha]

Silvio, prueba este porfa.

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 -  Really Simple Syndication ||"

   /*
   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

   /*  // Original Rochinha...
   @ .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 "Close"    ;
      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

   // Teste for Silvio. 27/02/2022
   ACTIVATE WINDOW oChildWnd MAXIMIZED                                ;
      ON INIT ( oFRHTML:Do( "Navigate2", "http://forums.fivetechsupport.com/index.php?sid=922c7bc57c20959ba5267bfd6708bec8" ) ) ;
      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" )

   #IFDEF __XHARBOUR__

       TRY

          oXmlDoc := GetActiveObject( "Microsoft.XMLDOM" )

       CATCH

         TRY
            oXmlDoc := CreateObject( "Microsoft.XMLDOM" )
         CATCH

            Alert( "ERROR! in xHarbour" )

         END

      END

   #ELSE

      oXmlDoc := TOleAuto():New( "Microsoft.XMLDOM" )

   #ENDIF

   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.

      // teste for Silvio: 27/02/2022
      #IFDEF __XHARBOUR__

          TRY

             oXmlDoc := GetActiveObject( "Microsoft.XMLDOM" )

          CATCH

            TRY
               oXmlDoc := CreateObject( "Microsoft.XMLDOM" )
            CATCH

               Alert( "ERROR! in xHarbour" )

            END

         END

      #ELSE

         oXmlDoc := TOleAuto():New( "Microsoft.XMLDOM" )

      #ENDIF

      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()  // teste

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

         // Silvio
         // oServer := TOLEAuto():New( "Microsoft.XmlHttp" ) // error;

         // teste for Silvio.
         oServer := TOLEAuto():New( "MSXML2.ServerXMLHTTP.5.0" ) // funciona

      Catch

         MsgInfo('Erro na Criação do Serviço! harbour', '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]

then Try with these Italian feeds

Code: Select all  Expand view

http://feeds2.feedburner.com/WikinewsUltimeNotizie
https://www.italpress.com/
https://www.agi.it/
https://www.corriere.it/cultura/
https://www.corriere.it/
http://www.famigliacristiana.it/_rss/di-cosa-parliamo—articoli.aspx
https://www.ilfattoquotidiano.it/
https://www.ilfattoquotidiano.it/societa/
https://www.ilmattino.it/
http://www.ilsole24ore.com/
https://www.huffingtonpost.it/
http://www.pianetablunews.it/
http://www.repubblica.it/rss/homepage/rss2.0.xml?ref=RHFT
http://www.repubblica.it/
http://www.ansa.it/
https://www.ilsole24ore.com/rss/
https://www.ilsole24ore.com/rss/cultura.xml
http://www.ansa.it/sito/ansait_rss.xml
http://www.ansa.it/sito/notizie/cultura/cultura_rss.xml
http://www.ansa.it/sito/notizie/topnews/topnews_rss.xml
http://www.tgcom24.mediaset.it/
http://www.today.it/
https://it.notizie.yahoo.com/
https://internetto.it/feed/
http://feeds.feedburner.com/Androidiani
https://www.androidworld.it/
https://www.everyeye.it/
https://it.emcelettronica.com/
http://www.gamesblog.it/
https://www.gbarl.it/index.php
https://www.geekissimo.com/
https://www.hdblog.it/
http://it.ign.com/
https://blog.it.playstation.com
https://www.ilsoftware.it/
https://www.iphoneitalia.com/
https://www.ispazio.net/
https://www.macitynet.it/
https://www.linuxjournal.com/node/feed
https://www.marcosbox.org/
http://www.melablog.it
http://www.nintendolife.com/feeds/latest
https://www.omgubuntu.co.uk/
https://planet.ubuntu-it.org/
https://www.reboot.ms/forum/
http://www.ansa.it/sito/notizie/tecnologia/tecnologia.shtml
https://www.spaziogames.it/docs/feed/news.xml
http://www.tomshw.it/
http://www.wired.it/
https://www.windowsblogitalia.com/
https://www.ilsole24ore.com/rss/tecnologia.xml
https://whatstech.it/feed/
https://www.fsf.org/static/fsforg/rss/news.xml
https://www.ilsole24ore.com/rss/mondo.xml
http://www.ilgiornale.it/sezioni/esteri.html
https://www.ilfattoquotidiano.it/mondo/
http://www.repubblica.it/esteri
http://www.ansa.it/sito/notizie/mondo/mondo.shtml
https://www.ilfattoquotidiano.it/lavoro-precari/
https://www.ilfattoquotidiano.it/tag/marco-travaglio/
https://www.ilfattoquotidiano.it/politica-palazzo/
http://www.repubblica.it/politica
http://www.ansa.it/sito/notizie/politica/politica.shtml
https://www.ansa.it/europa/notizie/rss.xml
https://www.ansa.it/europa/notizie/europarlamento/news/europarlamento_rss.xml
http://www.educanews.it/
http://www.repubblica.it/scuola/
http://www.orizzontescuola.it/rss-feeds
http://www.filosofiablog.it/
http://ilrasoiodioccam-micromega.blogautore.espresso.repubblica.it/
https://www.riflessioni.it/
https://plato.stanford.edu/
http://www.radio24.ilsole24ore.com/programma/la-storia-e-la-memoria
https://ilfattostorico.com/
http://lanostrastoria.corriere.it/
https://www.ilsole24ore.com/rss/salute.xml
https://www.ilfattoquotidiano.it/ambiente-veleni/
http://www.benessereblog.it/
https://www.corriere.it/scienze/
http://www.ecoblog.it
https://www.focus.it/
http://www.galileonet.it/
http://www.ilblogdellapesca.it/
https://attivissimo.blogspot.com/
http://www.lescienze.it/
http://www.nationalgeographic.it/
https://oggiscienza.it/feed/
http://sesso.blogautore.espresso.repubblica.it/
https://it.notizie.yahoo.com/salute
http://www.saperescienza.it/rss-saperescienza
http://www.indieforbunnies.com/
https://www.musicoff.com/feeds
http://news.mtv.it/
http://www.ondarock.it/
https://www.rockit.it/web/index.php
https://www.rockol.it/
https://www.rollingstone.it/
http://www.soundsblog.it
http://www.cineblog.it
Badtaste.it
http://www.mymovies.it/cinema/
https://www.comingsoon.it/cinema/news/
https://www.ilcineocchio.it
http://www.ansa.it/sito/notizie/cultura/cultura.shtml
http://news.mtv.it/
https://sport.ilmessaggero.it/
http://www.repubblica.it/sport/
http://www.ansa.it/sito/notizie/sport/sport.shtml
https://sport.sky.it/
https://www.gazzetta.it/rss/
https://www.gazzetta.it/rss/home.xml
https://www.ilsole24ore.com/rss/sport24.xml
http://www.arte.it/
http://www.fashionblog.it
https://www.gqitalia.it/
https://www.ilsole24ore.com/rss/moda.xml
https://www.ilsole24ore.com/rss/arteconomy.xml
https://www.corriere.it/economia/
http://www.repubblica.it/economia/
http://www.ansa.it/sito/notizie/economia/economia.shtml
https://www.ilsole24ore.com/rss/finanza.xml
https://www.ilsole24ore.com/rss/norme-e-tributi.xml
https://www.ilsole24ore.com/rss/risparmio.xml
https://www.dissapore.com/
http://www.gustoblog.it/
https://www.giallozafferano.it/ricerca-ricette/rss/
http://www.scattidigusto.it/
https://www.ilsole24ore.com/rss/food.xml
http://www.gossipblog.it
http://www.ansa.it/sito/notizie/cronaca/cronaca.shtml
Vanityfair.it
https://www.liligo.it/magazine-viaggiatore/
https://www.piratinviaggio.it/
http://www.travelblog.it
https://www.ilsole24ore.com/rss/viaggi.xml
http://magister.blogautore.espresso.repubblica.it/
http://w2.vatican.va/content/vatican/it.html
https://www.vaticannews.va/it.html
https://www.ansa.it/canale_ambiente/notizie/ambiente_rss.xml
https://www.ansa.it/canale_terraegusto/notizie/terraegusto_rss.xml
https://www.ilsole24ore.com/rss/management.xml
https://www.ilsole24ore.com/rss/economia–energia-e-ambiente.xml
https://www.ilsole24ore.com/rss/commenti.xml
https://www.ansa.it/abruzzo/notizie/abruzzo_rss.xml
https://www.ilcentro.it/cmlink/pescara-1.187
https://www.ilcentro.it/cmlink/chieti-1.184
https://www.ilcentro.it/cmlink/l-aquila-1.186
https://www.ilcentro.it/cmlink/teramo-1.189
http://www.chietitoday.it/
https://www.abruzzoweb.it/province/chieti.html
https://www.abruzzoweb.it/province/laquila.html
https://www.abruzzoweb.it/province/pescara.html
https://www.abruzzoweb.it/province/teramo.html
https://www.pescarapost.it/cronaca/feed/
http://www.ilpescara.it/
http://www.rete8.it/news/cronaca/pescara/
https://www.emmelle.it/Rss/Notizie/
 

[Silvio.Falconi]

however perhaps it is better to convert all the listboxes to Xbrowse because it was certainly done with the Hernan listbox that I no longer have so I prefer to convert everything to xbrowse


second thing I created a dbf archive with three simple fields to better manage the rss addresses

Code: Select all  Expand view

local aFields := { { "NAME", "C", 30, 0 },;
                                  { "URL", "C", 75, 0 },;
                                  { "TOPIC", "C", 20, 0 } }

DbCreate( "Rss.dbf", aFields, "DBFCDX" )

 

[Silvio.Falconi]

Antonio, Karinha
this run ok

Code: Select all  Expand view

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

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





Function FeedReader( oWnd, opcao, lHorizontal )
   local cTitle
   local oGet, oSplit, oBar //, oGraph, oTree
   local oFRTree, oFRHTML, oFRLbx, oVSplit, oHSplit

   public oWnd2, aBitmaps, aFeeds, oRSSLbx, cRSSLbx
   public oChildWnd, aDatos := {}

   cTitle := "Lettore di RSS"
   SysRefresh()

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

                 
If IsInternet()


    iif( !file("feeds.arr"),;
    EK_SAVEARR( { "http://forums.fivetechsupport.com/rss.php" }, "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 2007 //_3D // Button Bar com efeito 3D / Outlook
         * @   0, 25 SAY " "+cTitle FONT fntArial SIZE 100,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 "Uscita"    RESOURCE "bmpbtn24" SIZE 70,24 ACTION ( oChildWnd:End(), lChildWnd := .f. ) NOBORDER PRESSED 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

   @ 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() ) }

   @ 000,205 LISTBOX oFRLbx FIELDS "" ;
             HEADERS "", "Titolo", "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] ) }
     // Estilo Flat
  *   oFRLbx:nStyle        := 1
   *  oFRLbx:nLineStyle    := 10
*     oFRLbx:nHeaderStyle  := 2
  *   oFRLbx:nHeaderHeight := 20
 *    oFRLbx:nLineHeight   := 15
     oFRLbx:lMChange      := .f.
   *  oFRLbx:lOnlyBorder   := .f.
  *   oFRLbx:lAdjLastCol   := .f.
  *   oFRLbx:Set3DStyle()
     // -> Cabecalho
     oFRLbx:nClrBackHead  := nRGB(194,218,242)
     // -> Linha divisora
  *   oFRLbx:nClrLine      := nRGB(194,218,242)
     // -> Cores das linhas Texto e Fundo
     // -> Cor do cursor com foco
     oFRLbx:nClrForeFocus := CLR_BLACK
     oFRLbx:nClrBackFocus := nRGB(194,218,242)
     // -> Cor do cursor sem foco
 *    oFRLbx:nClrNFFore    := CLR_BLACK
 *    oFRLbx:nClrNFBack    := nRGB(194,218,242)
     oFRLbx:SetFont( oFntLBX )

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

   @ 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", "http://forums.fivetechsupport.com/rss.php" ) ) ;
            ON RESIZE ( oVSplit:AdjLeft(), oHSplit:AdjRight() )

Endif //IsInternet()

   return nil
//-------------------------------------------------------------------------//
Function FeedLoaderArray( cURL )
   LOCAL RespText, objXMLHTTP, cXMLFeed, aFeedLoaderArray := {}
   DEFAULT cURL := "http://forums.fivetechsupport.com/rss.php"

   // Carrega variavel com conteudo do XML do RSS
      MsgRun( "Connessione...", "Sto leggendo",;
      {|| cXMLFeed := FeedPuching( cURL ) } )

   // Bloco de leitura e assinalacao do conteudo do RSS
   oXMLDoc := TOLEAUTO():New( "Microsoft.XMLDOM" )
   oXMLDoc:async := .f.
   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, 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 RespText, objXMLHTTP, cXMLFeed
   DEFAULT cURL := "http://forums.fivetechsupport.com/rss.php"


   if recco() <= 0
      // Carrega variavel com conteudo do XML do RSS
      MsgRun( "Connessione...", "Sto leggendo", {|| cXMLFeed := FeedPuching( cURL ) } )

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

      //MemoEdit( MemoRead( "feeds.xml" ) )

      MsgRun( "Sto cercando" )
      // Bloco de leitura e assinalacao do conteudo do RSS
      oXMLDoc := TOLEAUTO():New( "Microsoft.XMLDOM" )
      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

         //browse()
      endif
   endif
   return nil
//-------------------------------------------------------------------------//
Function FeedPuching( cURL )
   local oHyperlink
   *oHyperlink := TOLEAuto():New( "Microsoft.XmlHttp" )
               oHyperlink := TOLEAuto():New("MSXML2.ServerXMLHTTP.6.0")

   oHyperlink:Open( "GET", cURL, .F. )
   oHyperlink:Send( "" )
   cResponseText := oHyperlink:ResponseText
*   oHyperlink:end()
   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
   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.
 

[Silvio.Falconi]

for first listbox I converte in this mode

Code: Select all  Expand view

@ 0, 0 XBROWSE oRSSLbx OF oChildWnd ;
                  SIZE 200,200 PIXEL  DATASOURCE aFeeds

                   oRSSLbx:nMarqueeStyle       := MARQSTYLE_HIGHLWIN7 //MARQSTYLE_HIGHLROW
                   oRSSLbx:nColDividerStyle    := LINESTYLE_LIGHTGRAY
                   oRSSLbx:lColDividerComplete := .t.
                   oRSSLbx:lRecordSelector     := .f.
                   oRSSLbx:lHScroll            := .f.
                   oRSSLbx:nHeaderHeight       := 20
                   oRSSLbx:nRowHeight          := 20
                   oRSSLbx:lTransparent        := .T.
                   oRSSLbx:l2007               := .t.
                   oRSSLbx:nDataType           := 1 // array
                   oRSSLbx:nStretchCol         := -1


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

 

But make error I not KNow why

[Silvio.Falconi]

If you try

https://abruzzoweb.it/localita/teramo/feed/


Not run while on the browser ( chrome or ie) run ok