// Siempre ponga el código y el .RC para testes, porfa.
Code: Select all | Expand
/*
viewtopic.php?f=3&t=33496&p=197679#p197636
G. N. Rao.
Hyderabad, India
nageswaragunupudi
*/#include "fivewin.ch"REQUEST DBFCDX
static nLastTopic :=
33507 // rage of topicsstatic nFirstopic :=
33400//----------------------------------------------------------------------------//function Main
() SET DATE BRITISH
SET CENTURY
ON SET DELETED
ON RDDSETDEFAULT
( "DBFCDX" ) DBCREATE
( "SAMPLES.DBF",
{ ;
{ "TOPICNO",
'N',
6,
0 }, ;
{ "TOPIC",
'C',
60,
0 }, ;
{ "AUTHOR",
'C',
40,
0 }, ;
{ "DATE",
'D',
8,
0 }, ;
{ "CODE",
'M',
10,
0 } }, ;
"DBFCDX", .T.,
"DB" ) FW_CdxCreate
() CLOSE DB
USE SAMPLES EXCLUSIVE VIA
"DBFCDX" ForumSamples
( nLastTopic, nFirsTopic
) BrowseSamples
()return nil//----------------------------------------------------------------------------//function BrowseSamples
() local oDlg, oFont, oBold, oMono, oGet, oBrw
SET ORDER
TO TAG TOPICNO
GO TOP
DEFINE FONT oFont
NAME "Segoe UI" SIZE 0,
-14 DEFINE FONT oBold
NAME "TAHOMA" SIZE 0,
-18 BOLD
DEFINE FONT oMono
NAME "Lucida Console" SIZE 0,
-12 DEFINE DIALOG oDlg
SIZE 900,
700 PIXEL TRUEPIXEL
FONT oFont ;
TITLE "SAMPLES IN FWH FORUMS" @
90,
20 XBROWSE oBrw
SIZE 400,
-20 PIXEL OF oDlg ;
DATASOURCE
"SAMPLES" ;
COLUMNS
"TOPICNO",
"DATE",
"AUTHOR" ;
AUTOSORT ;
LINES NOBORDER
WITH OBJECT oBrw
:
nMarqueeStyle := MARQSTYLE_HIGHLROWRC
:
bChange :=
{ || oDlg:
Update() } :
lIncrFilter := .t.
:
bSeek :=
{ |c|
( oBrw:
cAlias )->
( BrwFilter
( c
) ) } :
CreateFromCode() END
@
20,
20 SAY TRIM
( SAMPLES->TOPIC
) SIZE 860,
30 PIXEL OF oDlg
CENTER ;
FONT oBold
UPDATE @
60,
20 SAY "Filter containing all words any where" SIZE 300,
20 PIXEL OF oDlg
@
60,
340 SAY oBrw:
oSeek PROMPT oBrw:
cSeek SIZE 540,
20 PIXEL OF oDlg ;
COLOR CLR_HRED,CLR_YELLOW
@
90,
420 SAY "CODE" SIZE 460,
30 PIXEL OF oDlg
CENTER ;
COLOR CLR_BLACK, nRGB
( 231,
242,
255 ) @
120,
420 GET oGet
VAR SAMPLES->CODE
SIZE 460,
540 PIXEL OF oDlg ;
MEMO READONLY
FONT oMono
UPDATE oDlg:
bPainted :=
{ || oDlg:
Box( 59,
339,
81,
881 ) } ACTIVATE DIALOG oDlg
CENTERED RELEASE FONT oFont, oMono, oBold
return nil//----------------------------------------------------------------------------//function BrwFilter
( c
) local lFound := .t.
local aTokens
local cSaveFilter := DBFILTER
() local nSaveRec := RECNO
() local cFilter :=
{} if Empty
( c
) return .t.
endif c := UPPER
( c
) aTokens := HB_ATokens
( c
) for each c in aTokens
AAdd
( cFilter,
"'" + c +
"' $ UPPER( DBRECORDINFO( 9 ) )" ) next cFilter := FW_ArrayAsList
( cFilter,
" .AND. " ) SET FILTER
TO &cFilter
GO TOP
lFound :=
( OrdKeyCount
() >
0 )return lFound
//----------------------------------------------------------------------------//function ForumSamples
( nTopic, nLast
) local cTopic, cUrl, cPageURL, cUser, cText, cCode, nPage, nPages, n, cLeft, dDate
DEFAULT nTopic :=
33507, nLast := nTopic -
50 for nTopic := nTopic
to nLast step
-1 nPage :=
1 cUrl := TopicNoToURL
( nTopic
) do while .t.
cPageURL := cUrl +
If( nPage >
1,
"&start=" + LTrim
( Str
( nPage *
15 ) ),
"" ) MsgRun
( cPageURL,
"READING FORUM PAGE",
{ || ;
cText := WebPageContents
( cPageUrl, .t.
) ;
} ) if nPage ==
1 nPages := PageCount
( cText
) cTopic := textbetween
( ctext,
"<h2>",
"</h2>",
1 ) cTopic := textbetween
( cTopic,
">",
"</a>",
1 ) endif n :=
1 do while !Empty
( cCode := TextBetween
( cText,
"<code>",
"</code>", n, @cLeft
) ) cUser := GetUserName
( cLeft, @dDate
) if Empty
( dDate
) dDate := CTOD
( "" ) endif cCode := ExtractPrgCode
( cCode
) // DBAPPEND
() FIELD->TOPICNO := nTopic
FIELD->TOPIC := cTopic
FIELD->AUTHOR := cUser
FIELD->DATE := dDate
FIELD->CODE := cCode
n++
SYSREFRESH
() enddo nPage++
if nPage > nPages
EXIT
endif SYSREFRESH
() enddo next nTopic
return nil//----------------------------------------------------------------------------//function TopicNoToURL
( nTopic
)return "http://forums.fivetechsupport.com/viewtopic.php?f=3&t=" + cValToChar
( nTopic
)//----------------------------------------------------------------------------//function TextBetween
( cText, cStartTag, cCloseTag, nPos, cLeft, cRight
) local cRet :=
"" if !
( cStartTag $ cText
) cLeft := cText
cRight :=
"" return "" endif cRight := AfterAtNum
( cStartTag, cText, nPos
) cRet := BeforAtNum
( cCloseTag, cRight,
1 ) if PCount
() >
4 cLeft := BeforAtNum
( cStartTag, cText, nPos
) cRight := AfterAtNum
( cCloseTag, cRight,
1 ) endifreturn cRet
//----------------------------------------------------------------------------//function ExtractPrgCode
( cCode
) local nFrom, nUpto, cLeft, cRight, cToken
local nFor
local aSubs :=
{ ;
{ '<br />',CRLF
}, ;
{ ' ',
" " }, ;
{ 'ÿ',
" " }, ;
{ '"',
'"' } } for nFor :=
1 to Len
( aSubs
) cCode := StrTran
( cCode, aSubs
[ nFor,
1 ], aSubs
[ nFor,
2 ] ) next do while !Empty
( cToken := TextBetween
( cCode,
"<",
">",
1, @cLeft, @cRight
) ) cCode := cLeft + cRight
enddo aSubs :=
{ ;
{ '>',
">" }, ;
{ '<',
"<" } } for nFor :=
1 to Len
( aSubs
) cCode := StrTran
( cCode, aSubs
[ nFor,
1 ], aSubs
[ nFor,
2 ] ) next do while !Empty
( cToken := TextBetween
( cCode,
"&#",
";",
1, @cLeft, @cRight
) ) cToken := Chr
( Val
( cToken
) ) cCode := cLeft + cToken + cRight
enddoreturn cCode
//----------------------------------------------------------------------------//function PageCount
( cText
) local nAt
local nPages :=
1 if ( nAt :=
AT( "Page <strong>", cText
) ) >
0 cText :=
SubStr( cText, nAt +
14,
50 ) nPages := Val
( AfterAtNum
( "<strong>", cText,
1 ) ) endifreturn nPages
//----------------------------------------------------------------------------//function GetUserName
( cText, dDate
) local c1 :=
"/memberlist.php?mode=viewprofile&u=" //2342">cnavarro</a></strong> » Tue Jan 17 local c2 :=
["username]
local nAt := RAT( c1, cText )
local n2 := RAT( c2, cText )
local cUser := ""
local cDate
nAt := Max( nAt, n2 )
if nAt > 0
cText := SubStr( cText, nAt, 200 )
cUser := TextBetween( cText, ">
", "<
", 1 )
cDate := AllTrim( TextBetween( cText, "»
", "</p>
" ) )
cDate := Upper( AfterAtNum( " ", cDate, 1 ) )
dDate := uCharToVal( cDate, 'D' )
endif
return cUser
//----------------------------------------------------------------------------//
Saludos.
