FWForum Post and code grabber

[Marc Venken]

I'm making a smal program that will hold all information that is usefull for me. I read all sample functions, but i also want to grab some posts and code from the forum. We have already a global forum grabber, but for this I want a topic
grabber.

Sample code from the forum that I would copy/paste into a getfield and the function should give the data

f=6&t=42239&sid=4290062a3f768e4ee2ba52d66b669097#p253728

Maybe the guys that worked on those grabbers can see for this function ? Read the contact of this specific post : Forum : 6 Post : 253728 and strip it into usefull data like

Author, Date, body content and the sample function code. Once into a Variable, I can save to dbf and start using it.

I looked into it and there is a lot of html code that need to be stripped. These guys will probably have done it in there programs ....

[Antonio Linares]

Dear Marc,

With this code you retrieve the complete post. Then searching for "select all" we could try to identify the portions of code. Not sure if this may be of help for your project:

Code: Select all | Expand

#include "FiveWin.ch"

function Main()

   local cPost := "f=6&t=42239&sid=4290062a3f768e4ee2ba52d66b669097#p253728"

   FW_memoEdit( WebPageContents( "https://fivetechsupport.com/forums/viewtopic.php?http://fivetechsupport.com/forums/viewtopic.php?" + ;
                cPost ) )

return nil

[Jimmy]

hi Marc,

look at my "phpbb Forum Grabber"
https://www.hmgforum.com/viewtopic.php?f=5&t=7281


i have made for FiveWin "Special" CODE while it use COLOR and other HTML in CODEBLOCK
look into Source how i find "Marker" Author, Date, body content and "extract" CODE when have download Website

p.s. "phpbb Forum Grabber" can also "translate" BODY into your Language, change Codepage in CONFIG.INI

[Marc Venken]

Jimmy,

In the download is only the exe file ?

[Marc Venken]

My code is mostly very simple, but I get stuff working my way ))))

It would be nice to see this code pimped and more in the style of better programming. I'm always looking to get source better....

This code almost does the job : more stripping is needed in the source

Code: Select all | Expand

#include "FiveWin.ch"

function Main()

   local cPost := "f=6&t=42239&sid=4290062a3f768e4ee2ba52d66b669097#p253728"
   Local cZoeksub1_start,cZoeksub1_end
   Local cZoeksub1_strip_link_start := 'a href="/'
   Local cZoeksub1_strip_link_end := '"'
   Local cText, cTemp, cTempSub
   Local nSubmenu
   Local aData:={}

   FW_memoEdit( WebPageContents( "https://fivetechsupport.com/forums/viewtopic.php?http://fivetechsupport.com/forums/viewtopic.php?" + cPost ) )
   cText = WebPageContents( "https://fivetechsupport.com/forums/viewtopic.php?http://fivetechsupport.com/forums/viewtopic.php?" + cPost )
   cText = strtran(cText,"<br />",CRLF)

   cZoeksub1_start := 'id="p253728"'
   cZoeksub1_end := '"divider"'
   cText = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )

   //  Topic selected
   cZoeksub1_start := '"#p253728"'
   cZoeksub1_end := '</a>'
   ctempSub = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )

   // Auther
   cZoeksub1_start := 'coloured">'
   cZoeksub1_end := '</a>'
   ctempSub = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )
   aadd(aData,"Author : "+cTempSub)
   // Date
   cZoeksub1_start := 'raquo;'
   cZoeksub1_end := '</p>'
   ctempSub = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )
   aadd(aData,"Date : "+cTempSub)

   // Content
   cZoeksub1_start := '"content">'
   cZoeksub1_end := '<dl class'
   ctempSub = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )
   aadd(aData,"Content : "+cTempSub)
   // Source code
      //cZoeksub1_start := 'Expand view'
   cZoeksub1_start := '00D7D7;">'  // This color seems to be always there
   cZoeksub1_end := '</code>'
   ctempSub = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )
   aadd(aData,"Source 1 : "+cTempSub)
   //  Trim the source from HTML code
   ctempSub = strtran(ctempSub,"</span>","")
   aadd(aData,"Source 2: "+cTempSub)
   // More trimming needed

   xbrowser(aData)

return nil

function Textertussen( 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


 

[Marc Venken]

The result is getting better and better ))))

Code: Select all | Expand

#include "FiveWin.ch"

function Main()

   // link for second test
   //local cPost := "f=6&t=42239&sid=4290062a3f768e4ee2ba52d66b669097#p253728"
   local cPost := "f=3&t=42249&sid=844b9e3e8d8f3961169850370d02d06b#p253781"

   Local cZoeksub1_start,cZoeksub1_end
   Local cZoeksub1_strip_link_start := 'a href="/'
   Local cZoeksub1_strip_link_end := '"'
   Local cText, cTemp, cTempSub, cData
   Local nSubmenu, nTel:=1
   Local aData:={}
   //  See content
   cText = WebPageContents( "https://fivetechsupport.com/forums/viewtopic.php?http://fivetechsupport.com/forums/viewtopic.php?" + cPost )
   FW_memoEdit(cText)
   cText = strtran(cText,"<br />",CRLF)

   //cZoeksub1_start := 'id="p253728"'
   cZoeksub1_start := 'id="p253781"'
   cZoeksub1_end := '"divider"'
   cText = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )

   //  Topic selected
   //cZoeksub1_start := 'id="p253728"'
   cZoeksub1_start := '"#p253781"'
   cZoeksub1_end := '</a>'
   ctempSub = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )

   // Auther
   cZoeksub1_start := 'coloured">'
   cZoeksub1_end := '</a>'
   ctempSub = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )
   aadd(aData,"Author : "+cTempSub)
   // Date
   cZoeksub1_start := 'raquo;'
   cZoeksub1_end := '</p>'
   ctempSub = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )
   aadd(aData,"Date : "+cTempSub)

   // Content
   cZoeksub1_start := '"content">'
   cZoeksub1_end := '<dl class'
   ctempSub = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )
   aadd(aData,"Content : "+cTempSub)
   // Source code
   cZoeksub1_start := '00D7D7;">'  // This color seems to be always there
   cZoeksub1_end := '</code>'
   ctempSub = textertussen( cText, cZoeksub1_start,cZoeksub1_end, 1 )
   aadd(aData,"Source 1 : "+cTempSub)
   //  Trim the source from HTML code
   ctempSub = strtran(ctempSub,"</span>","")
   aadd(aData,"Source 2: "+cTempSub)

   //  Clean more HTML code that is more than once in de code

   cZoeksub1_start := '<'  // This color seems to be always there
   cZoeksub1_end := '>'

    do while .t.
     nTel++
     if nTel > 100  // In case of endless loop
        exit
     endif
     if at("<",cTempSub) > 0 .and. at(">",cTempSub) > 0
       cData = textertussen( ctempSub, cZoeksub1_start,cZoeksub1_end, 1 )
       if !empty(cData)
          ctempsub = strtran(ctempsub,cData,"")
          ctempsub = strtran(ctempsub,"<>","")
       endif
     else
       exit
     endif
    enddo

   do while at("&#40;",ctempsub) > 0
      ctempsub = strtran(ctempsub,"&#40;","(")
   enddo
   do while at("&#41;",ctempsub) > 0
      ctempsub = strtran(ctempsub,"&#41;",")")
   enddo


   cZoeksub1_start := '#'
   cZoeksub1_end := ';'

    do while .t.
     nTel++
     if nTel > 100  // In case of endless loop
        exit
     endif
     if at("#",cTempSub) > 0 .and. at(";",cTempSub) > 0
       cData = textertussen( ctempSub, cZoeksub1_start,cZoeksub1_end, 1 )
       if !empty(cData)
          ctempsub = strtran(ctempsub,cData,"")
          ctempsub = strtran(ctempsub,"#;","")
       endif
     else
       exit
     endif
   enddo



   do while at("&quot;",ctempsub) > 0
      ctempsub = strtran(ctempsub,"&quot;","")
   enddo
   do while at("&nbsp;",ctempsub) > 0
      ctempsub = strtran(ctempsub,"&nbsp;","")
   enddo
   do while at("&&",ctempsub) > 0
      ctempsub = strtran(ctempsub,"&&","")
   enddo
   do while at("&&",ctempsub) > 0
      ctempsub = strtran(ctempsub,"&&","")
   enddo




   aadd(aData,"Source 3 : "+CRLF+CRLF+cTempSub)

   xbrowser(aData)
   msginfo(cTempSub)

return nil

function Textertussen( 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

 

[Jimmy]

hi Marc,

In the download is only the exe file ?

please go back in Thread and you will find Source CODE

i have made some Update after Source Release but i will release next Source Version soon

[Jimmy]

hi,

have release lates Source and EXE
https://www.hmgforum.com/viewtopic.php?f=5&t=7281

[Marc Venken]

Jimmy,

Youre code is not that easy for me ))))

I was trying to take the Google Translate function to put in my application.
I only need the folowing

cSource = "This is a sample text in english"

Result from the function only in dutch 'NL'

Can you help me with this ? I get stuck op the Do EVENTS, Set property, do method that seems to be external ?

Thanks

[Antonio Linares]

Dear Marc,

DO EVENTS in FWH is SysRefresh()

[Marc Venken]

Dear Marc,

DO EVENTS in FWH is SysRefresh()

ahaa... Is Jimmy's code written for his other forum then?

[Antonio Linares]

it seems so, let see what Jimmy says

[Jimmy]

hi Marc,

I get stuck op the Do EVENTS, Set property, do method that seems to be external ?

i´m still learning FiveWin so i wrote the App using HMG Syntax which OOP Syntax is like Xbase++

while GUI is different lets talk about PROCEDURE TranslateByGoogle()

Code: Select all | Expand

DO Events                                    -> SysRefresh()

GetPropertry(oWin, oControl,xValue)         -> get xValue of cControl in oWin
SetPropertry(oWin, oControl,xValue, 123)    -> Set xValue of cControl in oWin

DoMethod( oWin, oControl, xMethod )         -> use Method of cControl in oWin

in "phpBB Forum Grabber" i have a Window "TranslateMemo" with and RTF Control "RichEdit_Translate"

Code: Select all | Expand

      SetProperty( "TranslateMemo", "RichEdit_Translate", "Value", TRIM( cTranslated ) )
      DoMethod( "TranslateMemo", "RichEdit_Translate", "Refresh" )

i assign TRIM( cTranslated ) as "Value" to RTF Control
calling Method "Refresh" will show cTranslated

! Note : this (free) Way is "limited" on Request Google Translate.
for Commercial Way you need a Google API-Key

---

Fivewin ActiveX have

Code: Select all | Expand

OleSetProperty()
OLEInvoke()

which is a about same but (only) for ActiveX

[Marc Venken]

Thanks Jimmy,

I changed the DO Events to sysrefresh and uncomment the 2 lines

//SetProperty( "TranslateMemo", "RichEdit_Translate", "Value", TRIM( cTranslated ) )
//DoMethod( "TranslateMemo", "RichEdit_Translate", "Refresh" )

Then it seems to work !! Thanks for the code.

Restarting the program resets the Google timer for the request right ?
How many request are possible in free mode ?

Code: Select all | Expand

*+--------------------------------------------------------------------
*+
*+    Procedure TranslateByGoogle()
*+
*+    Called from ( forumhmg.prg )   1 - static procedure forum_store()
*+                ( translat.prg )   1 - procedure translatememoform()
*+                                   1 - static procedure oninittranslate()
*+    Source = Jimmy from FW-Forum
*+--------------------------------------------------------------------
*+
PROCEDURE TranslateByGoogle()

LOCAL cTargetLang := "NL"
LOCAL cSourceLang := "auto"                                           // default
LOCAL cSampleText
LOCAL cSourceText
LOCAL cGTUrl
LOCAL hResp, nTry, i, nHttpError, cErrorDesc
LOCAL cTranslated := ""
LOCAL cOryginal   := ""
LOCAL cLangDetect := ""
LOCAL oHTTP, oErr, nReadystate, nStatus
LOCAL cTest:="This is a test for translation"

   BEGIN SEQUENCE WITH { | o | BREAK( o ) }
      oHTTP := Win_OleCreateObject( "MSXML2.ServerXMLHTTP" )
   RECOVER
   END SEQUENCE

   IF EMPTY( oHTTP )
      RETURN
   ENDIF

   cSampleText := TRIM( cTest )
   cSourceText := hb_StrToUTF8( cSampleText )

   cGTUrl := "https://translate.googleapis.com/translate_a/single?client=gtx" + ;
             "&sl=" + cSourceLang + ;
             "&tl=" + cTargetLang + ;
             "&dt=t&q=" + tip_URLEncode( cSourceText )

   BEGIN SEQUENCE WITH { | o | BREAK( o ) }

      oHTTP:Open( "POST", cGTUrl, .F. )
      oHTTP:SetRequestHeader( "Content-Type", "application/x-www-form-urlencoded" )
      nTry := 0
      DO WHILE oHTTP:readyState = 0
         nTry ++
         millisec( 500 )
         sysrefresh()
         IF nTry > 5
            BREAK
         ENDIF
      ENDDO

      oHTTP:Send()

      nReadystate := oHttp:readyState
      IF nReadystate <> 4
         BREAK
      ENDIF

      nStatus := oHttp:Status
      IF nStatus = 200
         IF HB_jsonDecode( oHTTP:responseText, @hResp ) > 0
            cLangDetect := hResp[ 3 ]
            FOR i := 1 TO LEN( hResp[ 1 ] )
               cTranslated += hResp[ 1 ] [ i ] [ 1 ]
               cOryginal += hResp[ 1 ] [ i ] [ 2 ]
            NEXT i
         ENDIF
      ELSE
         BREAK
      ENDIF

      MsgInfo ("To translate: " + cOryginal   + CRLF + CRLF + ;
              "Translated:   " + cTranslated + CRLF + CRLF + ;
              "Language: "     + cLangDetect )

      //SetProperty( "TranslateMemo", "RichEdit_Translate", "Value", TRIM( cTranslated ) )
      //DoMethod( "TranslateMemo", "RichEdit_Translate", "Refresh" )

   RECOVER USING oErr

      IF nStatus = 429
         lTranslate := .F.
         MsgStop( 'too many requests in a given amount of time ("rate limiting")' )
      ELSE
         nHttpError := IF( oHttp:readyState > 1, oHTTP:status, IF( oErr == Nil, - 1, oErr:SubCode ) )
         cErrorDesc := IF( oErr == Nil, "None descripion", hb_Translate( oErr:Description, "DEWIN" ) )
         MsgStop( " Error " + cErrorDesc + " ( " + STR( nHttpError ) + " )" )
      ENDIF
   END SEQUENCE

   oHTTP:Abort()
   oHTTP := NIL

RETURN



 

[Jimmy]

hi Marc,

Restarting the program resets the Google timer for the request right ?

NO, just lTranslate := .F. will be "reset" in "phpBB Forum Grabber"

you must get new (real) IP which Google use to "identify" User
but this is only possible when Router "disconnect"

have a look into IPINFO.PRG how to get "real" IP

How many request are possible in free mode ?

as i understood Google "count Sign"

Message in Forum have not so much Sign so i can "translate" new Message (about 50+)

but without API-Key it is "very limited" and not for Customer with "large Text"
using API-Key you got 500000 Sign "free" and than have to pay