Esto es lo más lejos que puedo llegar.
https://imgur.com/bRvRUSv
Regards, saludos.
FiveTech Software tech support forums
www.FiveTechSoft.com
Problem With oldest Prg of Rss
20 posts • Page 2 of 2 • 1, 2
Re: Problem With oldest Prg of Rss
by karinha » Mon Feb 28, 2022 2:27 pm
Questo è quanto posso ottenere.
Esto es lo más lejos que puedo llegar.
https://imgur.com/bRvRUSv
Regards, saludos.
Esto es lo más lejos que puedo llegar.
https://imgur.com/bRvRUSv
Regards, saludos.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
-
karinha - Posts: 7794
- Joined: Tue Dec 20, 2005 7:36 pm
- Location: São Paulo - Brasil
Re: Problem With oldest Prg of Rss
by karinha » Mon Feb 28, 2022 2:32 pm
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.
Regards, saludos.
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
// \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.
João Santos - São Paulo - Brasil - Phone: +55(11)95150-7341
-
karinha - Posts: 7794
- Joined: Tue Dec 20, 2005 7:36 pm
- Location: São Paulo - Brasil
Re: Problem With oldest Prg of Rss
by Silvio.Falconi » Mon Feb 28, 2022 4:25 pm
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.
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
-
Silvio.Falconi - Posts: 7034
- Joined: Thu Oct 18, 2012 7:17 pm
Re: Problem With oldest Prg of Rss
by Silvio.Falconi » Tue Mar 01, 2022 8:26 am
I didn't do that source, Karinha why insert written?
how
// By Silvio: 28/02/2022
how
// By Silvio: 28/02/2022
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
-
Silvio.Falconi - Posts: 7034
- Joined: Thu Oct 18, 2012 7:17 pm
Re: Problem With oldest Prg of Rss
by Silvio.Falconi » Tue Mar 01, 2022 8:30 am
karinha wrote: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
// \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') ?????????????????????????????????????????????????????????????????????????
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
-
Silvio.Falconi - Posts: 7034
- Joined: Thu Oct 18, 2012 7:17 pm
20 posts • Page 2 of 2 • 1, 2
Return to FiveWin for Harbour/xHarbour
Who is online
Users browsing this forum: karinha and 87 guests