Simple RSS reader for your applications...

[Rochinha]

Friends

This is a simple sample and need some modifications.

Double click on left browse load a feed.
Double click on right browse show a news.

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 := "Leitor de RSS"
   SysRefresh()
   aBitmaps := { "bmpbtn15",; // Estatistica
                 "bmpbtn81",; // Graficos
                 "bmpbtn25",; // Em curso
                 "bmpbtn14",; // Clientes
                 "bmp_somatoria" } // Gera Estatisticas

   iif( !file("feeds.arr") , ;
        EK_SAVEARR( { "http://g1.globo.com/Rss2/0,,AS0-5600,00.xml", ;
                      "http://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*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 "", "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] ) }
     // 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://www.yahoo.com" ) ) ;
            ON RESIZE ( oVSplit:AdjLeft(), oHSplit:AdjRight() )
   return nil

Function FeedLoaderArray( cURL )
   LOCAL RespText, objXMLHTTP, cXMLFeed, aFeedLoaderArray := {}
   DEFAULT cURL := "http://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 )

   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://g1.globo.com/Rss2/0,,AS0-5600,00.xml"
        // cURL := "http://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 ) )

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

      MsgRun( "Criando..." )
      // 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: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.


Download: Feed Reader

[Antonio Linares]

Rochinha,

Thanks!

[Patrick Mast]

Hey, Nice job!

Running your sample, I got this error:

Code: Select all  Expand view

Application
===========
   Path and name: D:\Test\fwh\Test - FWH - Feedreader Sample\test.exe (32 bits)
   Size: 1,651,200 bytes
   Time from start: 0 hours 0 mins 1 secs
   Error occurred at: 08/25/08, 11:33:40
   Error description: Error Microsoft.XmlHttp/3  DISP_E_MEMBERNOTFOUND: END
   Args:

Stack Calls
===========
   Called from: D:\xHarbour\source\rtl\win32ole.prg => TOLEAUTO:END(0)
   Called from: Test.prg => FEEDPUCHING(211)
   Called from: Test.prg => (b)FEEDLOADERARRAY(121)
   Called from: .\source\function\MSGRUN.PRG => (b)MSGRUN(0)
   Called from: .\source\classes\DIALOG.PRG => (b)TDIALOG:TDIALOG(0)
   Called from:  => TDIALOG:DISPLAY(0)
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:HANDLEEVENT(0)
   Called from:  => DIALOGBOXINDIRECT(0)
   Called from: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE(0)
   Called from: .\source\function\MSGRUN.PRG => MSGRUN(0)
   Called from: Test.prg => FEEDLOADERARRAY(121)
   Called from: Test.prg => FEEDREADER(34)

Patrick

[Rochinha]

Thanks for all,

Patrick, change TOleAuto() to CreateObecjt() of xHarbour() or:

Code: Select all  Expand view

...
Function FeedPuching( cURL )
   local oHyperlink
   oHyperlink := TOLEAuto():New( "Microsoft.XmlHttp" )
   oHyperlink:Open( "GET", cURL, .F. )
   oHyperlink:Send( "" )
   cResponseText := oHyperlink:ResponseText
   /* **** Disable this
   oHyperlink:end()
   **** */
   return cResponseText
...


[James Bott]

Wouldn't it be nice if xHarbour had a preprocessor directive to automatically convert TOLEAuto() to CreateObject(), then we wouldn't have to deal with this problem. Or, they could add a new class:

class TOleAuto from CreateObject
endclass

Then the new class would be indentical to the CreateObject class.

Maybe there is a problem in doing this that I am not seeing?

James

[nageswaragunupudi]

>
class TOleAuto from CreateObject
endclass
>

This is the source of CreateObject function in Win32Ole.Prg of xHarbour

Code: Select all  Expand view

FUNCTION CreateObject( cString )
RETURN TOleAuto():New( cString )


CreateObject is a function which creates TOleAuto object by calling TOleAuto():New( )

[James Bott]

NageswaraRao,

FUNCTION CreateObject( cString )
RETURN TOleAuto():New( cString )

Hmm, then why does TOleAuto():new( cString ) error out in xHarbour?

James

[nageswaragunupudi]

Mr James

>
then why does TOleAuto():new( cString ) error out in xHarbour?
>

If I understood the above postings correctly, ther error was not with the method New(..), but with method End().
That is because TOleAuto class does NOT have any method with the name "End".

We should never use :End() for any Ole object created in xharbour ( unless the contained object itself has a method End ).

[James Bott]

>That is because TOleAuto class does NOT have any method with the name "End".

OK, then wouldn't it easy to just add a virtual End method to the TOleAuto class? Then the same code would work with both Harbour and xHarbour?

Regards,
James

[nageswaragunupudi]

I doubt if End is working now in Harbour too. I dont normally use Harbour. Just now I tested with recent Harbour and call to End method is giving an error. I remember using End method in Harbour long long time back.

[James Bott]

> Just now I tested with recent Harbour and call to End method is giving an error.

OK, then that would solve it.

Thanks for the input.

James

[Antonio Linares]

Instead of calling :End(), it has to be asigned to nil:

oOleAutoObject := nil

and the class TOleAuto frees the contained OleAuto handle.

[James Bott]

Antonio,

Are you saying we have to set any OLE object that we create to nil, or that the TOleAuto class automatically does it?

James

[Enrico Maria Giordano]

OLE class has automatic destructor.

EMG

[James Bott]

Thanks Enrico.

James