www.FiveTechSoft.com
by Silvio.Falconi » Sat Feb 26, 2022 9:07 am
by Antonio Linares » Sat Feb 26, 2022 11:36 am
by Silvio.Falconi » Sat Feb 26, 2022 12:03 pm
Antonio Linares wrote:Dear Silvio,
Is the source code available ?
by Antonio Linares » Sat Feb 26, 2022 12:39 pm
by karinha » Sun Feb 27, 2022 2:00 pm
Antonio Linares wrote: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 )
// \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
by karinha » Sun Feb 27, 2022 3:35 pm
// \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
by karinha » Sun Feb 27, 2022 3:49 pm
by Silvio.Falconi » Sun Feb 27, 2022 5:01 pm
by karinha » Sun Feb 27, 2022 11:34 pm
by karinha » Sun Feb 27, 2022 11:38 pm
// \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
by Silvio.Falconi » Mon Feb 28, 2022 8:26 am
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/
by Silvio.Falconi » Mon Feb 28, 2022 8:41 am
local aFields := { { "NAME", "C", 30, 0 },;
{ "URL", "C", 75, 0 },;
{ "TOPIC", "C", 20, 0 } }
DbCreate( "Rss.dbf", aFields, "DBFCDX" )
by Silvio.Falconi » Mon Feb 28, 2022 9:20 am
#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.
by Silvio.Falconi » Mon Feb 28, 2022 9:31 am
@ 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()
by Silvio.Falconi » Mon Feb 28, 2022 9:55 am
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: Google [Bot] and 84 guests