FiveTech Support Forums

/*
<!-- l --><a class="postlink-local" href="http://forums.fivetechsupport.com/viewtopic.php?f=3&t=33496&p=197679#p197636">viewtopic.php?f=3&t=33496&p=197679#p197636</a><!-- l -->

G. N. Rao.
Hyderabad, India

nageswaragunupudi 
*/

#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++

            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    )
   endif

return cRet

//----------------------------------------------------------------------------//

function ExtractPrgCode( cCode )

   local nFrom, nUpto, cLeft, cRight, cToken
   local nFor
   local aSubs := { ;
      { '<br />',CRLF }, ;
      { '&nbsp;'," " }, ;
      { 'ÿ'," " }, ;
      { '&quot;','"' } }

   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&amp;u=" //2342">cnavarro</a></strong> &raquo; 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, "&raquo;", "</p>" ) )
      cDate    := Upper( AfterAtNum( " ", cDate, 1 ) )
      dDate    := uCharToVal( cDate, 'D' )
   endif

return cUser

//----------------------------------------------------------------------------//

@ 120,420 SAY oSay PROMPT  SAMPLES->CODE SIZE 460,540 PIXEL OF oDlg ;
       FONT oMono UPDATE

#include "fivewin.ch"

function Main()

   local oDlg, oFont, oGet, oBtn
   local cText, cName := "Dummy"

   cText := MEMOREAD( "c:\fwh\samples\testxbr3.prg" )

   DEFINE FONT oFont NAME "LUCIDA CONSOLE" SIZE 0,-12
   DEFINE DIALOG oDlg SIZE 500,500 PIXEL TRUEPIXEL FONT oFont

   @  20,380 BUTTON "CLOSE" SIZE 100,40 PIXEL OF oDlg ACTION oDlg:End()

   @  80, 20 GET oGet VAR cText MEMO SIZE 460,400 PIXEL OF oDlg READONLY

   ACTIVATE DIALOG oDlg CENTERED
   RELEASE FONT oFont

return nil

   local oDlg, oFont, oGet, oBtn
   local cText, cName := "Dummy"

   cText := MEMOREAD( "c:\fwh\samples\testxbr3.prg" )

   DEFINE FONT oFont NAME "LUCIDA CONSOLE" SIZE 0,-12
   DEFINE DIALOG oDlg RESOURCE "MEMOGETDLG" FONT oFont

   REDEFINE GET oGet VAR cText MEMO ID 101 OF oDlg READONLY

   ACTIVATE DIALOG oDlg CENTERED
   RELEASE FONT oFont

MEMOGETDLG DIALOG 6, 15, 306, 227
STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "MEMOGET"
FONT 8, "MS Sans Serif"
{
 DEFPUSHBUTTON "OK", IDOK, 252, 211, 50, 14
 EDITTEXT 101, 4, 5, 297, 202, ES_MULTILINE | WS_VSCROLL | ES_READONLY | WS_BORDER
}