Problem With oldest Prg of Rss

[karinha]

Questo è quanto posso ottenere.

Esto es lo más lejos que puedo llegar.

https://imgur.com/bRvRUSv




Regards, saludos.

[karinha]

Ora tocca a te Silvio. Esempi da "giocare".

Ahora te toca a ti Silvio. Ejemplos que tienes para "jugar/trabajar".

Terminó la participación en este tema muy interesante.

Participation ended in this very interesting topic.

Code: Select all  Expand view  RUN

// \samples\RRSSILV2.PRG.PRG - 28/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

   HB_GCALL( .F. )

   IF( .NOT. IsInternet() ) // Asi, es mejor Silvio.

      MsgStop( "Controlla la tua internet", "Attenzione" )

      HB_GCALL( .T. )

      CLEAR MEMORY

      PostQuitMessage( 0 )

      QUIT

      RETURN NIL

   ENDIF

   SetBalloon( .T. ) // Balloon shape required for tooltips

   SkinButtons()

   aDatos := {}

   cTitle := "|| Lettore RSS -  Really Simple Syndication Versione: 3.0 ||"

   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

   // By Silvio: 28/02/2022
   IIF(  .NOT. 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

   // DEFINE BUTTONBAR oBar OF oChildWnd SIZE 24, 24 //_3D // Button Bar com efeito 3D / Outlook
   DEFINE BUTTONBAR oBar BUTTONSIZE 24, 24 _3DLOOK TOP OF oChildWnd 2007

   @ 0, 25 SAY " "+cTitle FONT fntArial SIZE 950, 150 ;
      COLOR RGB(216,208,200), CLR_GRAY PIXEL OF oBar
                                                                // 24
   @ .5,  5 BITMAP oBmp FILENAME "..\bitmaps\16x16\floppy.bmp" SIZE 50, 24 ;
      NOBORDER SCROLL UPDATE PIXEL OF oBar

   //       RESOURCE "bmpbtn24" SIZE 70,24 ;
   @ .5,(oChildWnd:nWidth-72*1) BTNBMP oBtn01 PROMPT "Close"    ;
      FILENAME "..\bitmaps\16x16\Exit.bmp" SIZE 70,24           ;
      ACTION ( oChildWnd:End(), lChildWnd := .f. ) NOBORDER     ;
      OF oBar LEFT FONT oFntLBX

   @ .5,(oChildWnd:nWidth-72*2) BTNBMP oBtn02 PROMPT "Menu..."  ;
      FILENAME "..\bitmaps\16x16\new.bmp" SIZE 70, 24           ;
      ACTION FUN() NOBORDER OF oBar LEFT FONT oFntLBX

   /*
   @ 0, 0 LISTBOX oRSSLbx VAR cRSSLbx ITEMS aFeeds SIZE 200,200 PIXEL ;
      OF oChildWnd
   */
   @ 0, 0 LISTBOX oRSSLbx VAR cRSSLbx OF oChildWnd SIZE 200, 200 PIXEL   ;
      ITEMS aFeeds

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

   @ 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

   // https://abruzzoweb.it/rss-google-news-laquila.xml
   // ON INIT ( oFRHTML:Do( "Navigate2", "http://feeds2.feedburner.com/WikinewsUltimeNotizie" ) ) ;
   ACTIVATE WINDOW oChildWnd MAXIMIZED                                ;
      ON INIT ( oFRHTML:Do( "Navigate2", "https://abruzzoweb.it/rss-google-news-laquila/feed/" ) ) ;
      ON RESIZE ( oVSplit:AdjLeft(), oHSplit:AdjRight() )

   // By Silvio: 28/02/2022
   /*
   ACTIVATE WINDOW oChildWnd MAXIMIZED ;
      ON INIT ( oFRHTML:Do( "Navigate2", "http://forums.fivetechsupport.com/rss.php" ) ) ;
      ON RESIZE ( oVSplit:AdjLeft(), oHSplit:AdjRight() )
   */

   oFntLBX:End()
   fntArial:End()

   HB_GCALL( .T. )

   CLEAR MEMORY

   PostQuitMessage( 0 )

   QUIT

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"
   DEFAULT cURL := "https://abruzzoweb.it/rss-google-news-laquila.xml"

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

   // Bloco de leitura e assinalacao do conteudo do RSS
   #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 )

   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"
   DEFAULT cURL := "https://abruzzoweb.it/rss-google-news-laquila.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
      #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

   #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

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

   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]

Probablemente no pueda explicarme, antes de que esto funcionara sin problemas. Corría con cualquier url obviamente tenía que ser un rss. Ahora noté que solo se necesitan URL que tengan xlm o phpb que conviertan la página a xlm como, por ejemplo, el foro fwh. Seguramente es posible hacer una función que vaya a comprobar si la url es un xlm o un rss porque si no lo es da error. Lo estoy probando con muchos feeds y he encontrado muchos que no funcionan con el prg hecho en fwh mientras que si los cargo desde la web funcionan bien. Entonces mi inquietud es convertir los listboxes de Hernan con el nuevo Xbrowse, me pueden ayudar a hacerlo por favor porque no entiendo porque no funciona.

[Silvio.Falconi]

I didn't do that source, Karinha why insert written?

how
// By Silvio: 28/02/2022

[Silvio.Falconi]

Ora tocca a te Silvio. Esempi da "giocare".

Ahora te toca a ti Silvio. Ejemplos que tienes para "jugar/trabajar".

Terminó la participación en este tema muy interesante.

Participation ended in this very interesting topic.

Code: Select all  Expand view  RUN

// \samples\RRSSILV2.PRG.PRG - 28/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

   HB_GCALL( .F. )

   IF( .NOT. IsInternet() ) // Asi, es mejor Silvio.

      MsgStop( "Controlla la tua internet", "Attenzione" )

      HB_GCALL( .T. )

      CLEAR MEMORY

      PostQuitMessage( 0 )

      QUIT

      RETURN NIL

   ENDIF

   SetBalloon( .T. ) // Balloon shape required for tooltips

   SkinButtons()

   aDatos := {}

   cTitle := "|| Lettore RSS -  Really Simple Syndication Versione: 3.0 ||"

   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

   // By Silvio: 28/02/2022
   IIF(  .NOT. 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

   // DEFINE BUTTONBAR oBar OF oChildWnd SIZE 24, 24 //_3D // Button Bar com efeito 3D / Outlook
   DEFINE BUTTONBAR oBar BUTTONSIZE 24, 24 _3DLOOK TOP OF oChildWnd 2007

   @ 0, 25 SAY " "+cTitle FONT fntArial SIZE 950, 150 ;
      COLOR RGB(216,208,200), CLR_GRAY PIXEL OF oBar
                                                                // 24
   @ .5,  5 BITMAP oBmp FILENAME "..\bitmaps\16x16\floppy.bmp" SIZE 50, 24 ;
      NOBORDER SCROLL UPDATE PIXEL OF oBar

   //       RESOURCE "bmpbtn24" SIZE 70,24 ;
   @ .5,(oChildWnd:nWidth-72*1) BTNBMP oBtn01 PROMPT "Close"    ;
      FILENAME "..\bitmaps\16x16\Exit.bmp" SIZE 70,24           ;
      ACTION ( oChildWnd:End(), lChildWnd := .f. ) NOBORDER     ;
      OF oBar LEFT FONT oFntLBX

   @ .5,(oChildWnd:nWidth-72*2) BTNBMP oBtn02 PROMPT "Menu..."  ;
      FILENAME "..\bitmaps\16x16\new.bmp" SIZE 70, 24           ;
      ACTION FUN() NOBORDER OF oBar LEFT FONT oFntLBX

   /*
   @ 0, 0 LISTBOX oRSSLbx VAR cRSSLbx ITEMS aFeeds SIZE 200,200 PIXEL ;
      OF oChildWnd
   */
   @ 0, 0 LISTBOX oRSSLbx VAR cRSSLbx OF oChildWnd SIZE 200, 200 PIXEL   ;
      ITEMS aFeeds

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

   @ 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

   // https://abruzzoweb.it/rss-google-news-laquila.xml
   // ON INIT ( oFRHTML:Do( "Navigate2", "http://feeds2.feedburner.com/WikinewsUltimeNotizie" ) ) ;
   ACTIVATE WINDOW oChildWnd MAXIMIZED                                ;
      ON INIT ( oFRHTML:Do( "Navigate2", "https://abruzzoweb.it/rss-google-news-laquila/feed/" ) ) ;
      ON RESIZE ( oVSplit:AdjLeft(), oHSplit:AdjRight() )

   // By Silvio: 28/02/2022
   /*
   ACTIVATE WINDOW oChildWnd MAXIMIZED ;
      ON INIT ( oFRHTML:Do( "Navigate2", "http://forums.fivetechsupport.com/rss.php" ) ) ;
      ON RESIZE ( oVSplit:AdjLeft(), oHSplit:AdjRight() )
   */

   oFntLBX:End()
   fntArial:End()

   HB_GCALL( .T. )

   CLEAR MEMORY

   PostQuitMessage( 0 )

   QUIT

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"
   DEFAULT cURL := "https://abruzzoweb.it/rss-google-news-laquila.xml"

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

   // Bloco de leitura e assinalacao do conteudo do RSS
   #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 )

   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"
   DEFAULT cURL := "https://abruzzoweb.it/rss-google-news-laquila.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
      #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

   #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

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

   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.

NOT RUN error
MsgInfo('Erro na Criação do Serviço') ?????????????????????????????????????????????????????????????????????????