#include "fivewin.ch"
REQUEST DBFCDX
static nLastTopic := 33507 // rage of topics
static 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++
enddo
nPage++
if nPage > nPages
EXIT
endif
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 )
endif
return 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
enddo
return 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 ) )
endif
return 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
//----------------------------------------------------------------------------//