Simple RSS reader for your applications...
Posted: Sun Aug 24, 2008 11:57 pmFriends
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.
Download: Feed Reader
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
