/*
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 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 }, ;
{ ' '," " }, ;
{ 'ÿ'," " }, ;
{ '"','"' } }
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
//----------------------------------------------------------------------------//
@ 120,420 SAY oSay PROMPT SAMPLES->CODE SIZE 460,540 PIXEL OF oDlg ;
FONT oMono UPDATE
acuellar wrote:Estimado goosfancito
Y lo hago con SAY, claro no tiene SCROLL
- Code: Select all Expand view RUN
@ 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
}
Another thing: I take the data from mysql, which is declared as MEMO and if I do this:
vgets: = memored (oQry: fieldget ("text"))
vgests is empty.
if I do directly:
vgets: = oQry: fieldget ("text")
vgets if it remains with data.
En mi programa muestra el error. Para replicar lo que hago:
1) copio un texto escrito en WORD o write que sea extenso
2) pego ese texto en el get
3) muevo el scroll
el error aparece.
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: No registered users and 121 guests