diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 4791824acd..acb582ebcd 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,69 @@ The license applies to all entries newer than 2009-04-28. */ +2012-09-26 01:24 UTC+0200 Viktor Szakats (harbour syenar.net) + * contrib/hbnf/aading.prg + * contrib/hbnf/aemaxlen.prg + * contrib/hbnf/aeminlen.prg + * contrib/hbnf/amedian.prg + * contrib/hbnf/any2any.prg + * contrib/hbnf/at2.prg + * contrib/hbnf/blink.prg + * contrib/hbnf/calendar.prg + * contrib/hbnf/clrsel.prg + * contrib/hbnf/d2e.prg + * contrib/hbnf/dectobin.prg + * contrib/hbnf/dfile.prg + * contrib/hbnf/diskfunc.prg + * contrib/hbnf/doc/en/dosver.txt + * contrib/hbnf/doc/en/proper.txt + * contrib/hbnf/doc/en/setdate.txt + * contrib/hbnf/doc/en/settime.txt + * contrib/hbnf/dosver.prg + * contrib/hbnf/e2d.prg + * contrib/hbnf/findith.prg + * contrib/hbnf/gcd.prg + * contrib/hbnf/hex2dec.prg + * contrib/hbnf/invclr.prg + * contrib/hbnf/isshare.prg + * contrib/hbnf/linked.prg + * contrib/hbnf/menu1.prg + * contrib/hbnf/metaph.prg + * contrib/hbnf/miltime.prg + * contrib/hbnf/mouse1.prg + * contrib/hbnf/mouse2.prg + * contrib/hbnf/netpv.prg + * contrib/hbnf/ntow.prg + * contrib/hbnf/nwlstat.prg + * contrib/hbnf/nwsem.prg + * contrib/hbnf/nwuid.prg + * contrib/hbnf/pending.prg + * contrib/hbnf/pickday.prg + * contrib/hbnf/prtesc.prg + * contrib/hbnf/rand1.prg + * contrib/hbnf/savesets.prg + * contrib/hbnf/scancode.prg + * contrib/hbnf/setdate.prg + * contrib/hbnf/settime.prg + * contrib/hbnf/sleep.prg + * contrib/hbnf/sysmem.prg + * contrib/hbnf/tempfile.prg + * contrib/hbnf/vertmenu.prg + * contrib/hbnf/vidmode.prg + * contrib/hbnf/wda.prg + * contrib/hbnf/workdays.prg + * contrib/hbnf/woy.prg + * contrib/hbnf/xbox.prg + * doc/codebloc.txt + * extras/hbxlsxml/tests/example.prg + * extras/hbxlsxml/tests/example2.prg + * extras/hbxlsxml/tests/example3.prg + * extras/httpsrv/uhttpd.prg + * website/samples/codebloc.prg.html + * website/samples/testbrw.prg.html + * website/samples/testcgi.prg.html + * more cleanup, formatting + 2012-09-26 00:52 UTC+0200 Viktor Szakats (harbour syenar.net) * contrib/hbamf/tests/tstendin.prg * contrib/hbnf/floptst.prg diff --git a/harbour/contrib/hbnf/aading.prg b/harbour/contrib/hbnf/aading.prg index 0f216de915..2699c4f83c 100644 --- a/harbour/contrib/hbnf/aading.prg +++ b/harbour/contrib/hbnf/aading.prg @@ -24,7 +24,7 @@ #ifdef FT_TEST -FUNCTION MAIN() +PROCEDURE Main() LOCAL aList1,aList2,var0,nstart,nstop,nelapsed,nCtr CLS ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AADDITION" @@ -57,7 +57,7 @@ FUNCTION MAIN() ? PADR("FT_AADDITION( aList1, aList2, .F., .F. ) ->",44) AEVAL( var0, { |x| QQOUT(x + ",") } ) ? - RETURN NIL + RETURN #endif diff --git a/harbour/contrib/hbnf/aemaxlen.prg b/harbour/contrib/hbnf/aemaxlen.prg index 50ffa3baaf..eca207356f 100644 --- a/harbour/contrib/hbnf/aemaxlen.prg +++ b/harbour/contrib/hbnf/aemaxlen.prg @@ -24,7 +24,7 @@ #ifdef FT_TEST -FUNCTION MAIN() +PROCEDURE Main() LOCAL var0, myarray1 := DIRECTORY() CLS ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AEMAXLEN" @@ -47,7 +47,7 @@ FUNCTION MAIN() ? PADR('FT_AEMAXLEN( aTail( myarray1 ) ) ->',30) ?? var0 ? - RETURN NIL + RETURN #endif diff --git a/harbour/contrib/hbnf/aeminlen.prg b/harbour/contrib/hbnf/aeminlen.prg index 9c263ef441..b1675e6644 100644 --- a/harbour/contrib/hbnf/aeminlen.prg +++ b/harbour/contrib/hbnf/aeminlen.prg @@ -24,7 +24,7 @@ #ifdef FT_TEST -FUNCTION MAIN() +PROCEDURE Main() LOCAL var0, myarray1 := DIRECTORY() CLS ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AEMINLEN" @@ -50,7 +50,7 @@ FUNCTION MAIN() ? PADR('FT_AEMINLEN( myarray1,3 ) ->',30) ?? var0 ? - RETURN NIL + RETURN #endif diff --git a/harbour/contrib/hbnf/amedian.prg b/harbour/contrib/hbnf/amedian.prg index b5f98891d7..cdf7b56afd 100644 --- a/harbour/contrib/hbnf/amedian.prg +++ b/harbour/contrib/hbnf/amedian.prg @@ -28,7 +28,7 @@ #include "directry.ch" -FUNCTION MAIN() +PROCEDURE Main() LOCAL var0, myarray0 := DIRECTORY(), myarray1 := {} CLS ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AMEDIAN" @@ -50,7 +50,7 @@ FUNCTION MAIN() ? PADR('FT_AMEDIAN( myarray1, 8, 40 ) ->',35) ?? var0 ? - RETURN NIL + RETURN #endif diff --git a/harbour/contrib/hbnf/any2any.prg b/harbour/contrib/hbnf/any2any.prg index 8ad6834559..0d9c5e3d4a 100644 --- a/harbour/contrib/hbnf/any2any.prg +++ b/harbour/contrib/hbnf/any2any.prg @@ -43,7 +43,7 @@ #define TRUE (.t.) #define FALSE (.f.) -#Define XTOC(x) CASE_AT(VALTYPE(x), "CNDLM", ; +#define XTOC(x) CASE_AT(VALTYPE(x), "CNDLM", ; { NULL, ; x, ; iif(IS_NUMERIC(x),; diff --git a/harbour/contrib/hbnf/at2.prg b/harbour/contrib/hbnf/at2.prg index b278d3a1b7..503e81f16d 100644 --- a/harbour/contrib/hbnf/at2.prg +++ b/harbour/contrib/hbnf/at2.prg @@ -29,7 +29,7 @@ #ifdef FT_TEST -FUNCTION MAIN() +PROCEDURE Main() LOCAL cSearch,cTarget,var0 CLS ? "TEST TO DEMONSTRATE EXAMPLES OF FT_AT2" @@ -51,7 +51,7 @@ FUNCTION MAIN() ? PADR("FT_AT2( cSearch, cTarget, 2, .F. ) -> ",40) ??var0 ? - RETURN NIL + RETURN #endif diff --git a/harbour/contrib/hbnf/blink.prg b/harbour/contrib/hbnf/blink.prg index bd60d191cd..2e26a91299 100644 --- a/harbour/contrib/hbnf/blink.prg +++ b/harbour/contrib/hbnf/blink.prg @@ -25,9 +25,9 @@ */ #ifdef FT_TEST - FUNCTION MAIN() + PROCEDURE Main() FT_BLINK( "WAIT", 5, 10 ) - RETURN NIL + RETURN #endif FUNCTION FT_BLINK( cMsg, nRow, nCol ) diff --git a/harbour/contrib/hbnf/calendar.prg b/harbour/contrib/hbnf/calendar.prg index c0e92b6114..e4034f7dcb 100644 --- a/harbour/contrib/hbnf/calendar.prg +++ b/harbour/contrib/hbnf/calendar.prg @@ -24,7 +24,7 @@ #include "setcurs.ch" #ifdef FT_TEST - FUNCTION MAIN() + PROCEDURE Main() local aRet[8], i setcolor ('w+/b') cls @@ -33,15 +33,15 @@ endif keyboard chr (28) aRet := ft_calendar (10,40,'w+/rb',.t.,.t.) //display calendar, return all. - @1,0 say 'Date :'+dtoc(aRet[1]) - @2,0 say 'Month Number:'+str(aRet[2],2,0) - @3,0 say 'Day Number :'+str(aRet[3],2,0) - @4,0 say 'Year Number :'+str(aRet[4],4,0) - @5,0 say 'Month :'+aRet[5] - @6,0 say 'Day :'+aRet[6] - @7,0 say 'Julian Day :'+str(aRet[7],3,0) - @8,0 say 'Current Time:'+aRet[8] - RETURN NIL + @ 1,0 say 'Date :'+dtoc(aRet[1]) + @ 2,0 say 'Month Number:'+str(aRet[2],2,0) + @ 3,0 say 'Day Number :'+str(aRet[3],2,0) + @ 4,0 say 'Year Number :'+str(aRet[4],4,0) + @ 5,0 say 'Month :'+aRet[5] + @ 6,0 say 'Day :'+aRet[6] + @ 7,0 say 'Julian Day :'+str(aRet[7],3,0) + @ 8,0 say 'Current Time:'+aRet[8] + RETURN #endif #include "inkey.ch" diff --git a/harbour/contrib/hbnf/clrsel.prg b/harbour/contrib/hbnf/clrsel.prg index 8273514ccb..1746a17996 100644 --- a/harbour/contrib/hbnf/clrsel.prg +++ b/harbour/contrib/hbnf/clrsel.prg @@ -96,9 +96,9 @@ * */ -#IFDEF FT_TEST +#ifdef FT_TEST - FUNCTION Main( cVidMode ) +PROCEDURE Main( cVidMode ) LOCAL nRowDos := ROW() LOCAL nColDos := COL() @@ -145,9 +145,9 @@ SETPOS( nRowDos, nColDos ) SETBLINK( .F. ) // doesn't appear to be reset from FT_RestSets - RETURN Nil + RETURN -#ENDIF +#endif *------------------------------------------------ FUNCTION FT_ClrSel( aClrs, lColour, cChr ) diff --git a/harbour/contrib/hbnf/d2e.prg b/harbour/contrib/hbnf/d2e.prg index a627fc6972..b91780ca1c 100644 --- a/harbour/contrib/hbnf/d2e.prg +++ b/harbour/contrib/hbnf/d2e.prg @@ -29,9 +29,10 @@ #command DEFAULT
TO := iif( == NIL, )
#ifdef FT_TEST
- function main( cNum, cPrec )
+ PROCEDURE Main( cNum, cPrec )
DEFAULT cPrec TO str( DEFAULT_PRECISION )
- return qout( ft_d2e( val(cNum), val(cPrec) ) )
+ qout( ft_d2e( val(cNum), val(cPrec) ) )
+ RETURN
#endif
function ft_d2e( nDec, nPrecision )
diff --git a/harbour/contrib/hbnf/dectobin.prg b/harbour/contrib/hbnf/dectobin.prg
index 89027981a4..351ebc7054 100644
--- a/harbour/contrib/hbnf/dectobin.prg
+++ b/harbour/contrib/hbnf/dectobin.prg
@@ -26,12 +26,12 @@
#ifdef FT_TEST
-FUNCTION MAIN
+PROCEDURE Main()
LOCAL X
FOR X := 1 TO 255
QOUT( FT_DEC2BIN( x ))
next
-return nil
+return
#endif
diff --git a/harbour/contrib/hbnf/dfile.prg b/harbour/contrib/hbnf/dfile.prg
index 1c0979b173..519becaf82 100644
--- a/harbour/contrib/hbnf/dfile.prg
+++ b/harbour/contrib/hbnf/dfile.prg
@@ -31,7 +31,7 @@ THREAD static nHandle := 0
#ifdef FT_TEST
- FUNCTION MAIN()
+ PROCEDURE Main()
@ 0,0 CLEAR
@@ -77,7 +77,7 @@ THREAD static nHandle := 0
@ 20,0 SAY "Key pressed was: " + '[' + cKey + ']'
- return (NIL)
+ return
#endif
diff --git a/harbour/contrib/hbnf/diskfunc.prg b/harbour/contrib/hbnf/diskfunc.prg
index 4b145ae3d0..f0ffed0220 100644
--- a/harbour/contrib/hbnf/diskfunc.prg
+++ b/harbour/contrib/hbnf/diskfunc.prg
@@ -31,12 +31,12 @@
#define DRVTABLE "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
#ifdef FT_TEST
- FUNCTION MAIN( cDrv )
+ PROCEDURE Main( cDrv )
QOut("Disk size: " + str( FT_DSKSIZE() ) )
QOut("Free bytes: " + str( FT_DSKFREE() ) )
- RETURN NIL
+ RETURN
#endif
FUNCTION FT_DSKSIZE( cDrive )
diff --git a/harbour/contrib/hbnf/doc/en/dosver.txt b/harbour/contrib/hbnf/doc/en/dosver.txt
index 93b8b13286..e36b45e1d3 100644
--- a/harbour/contrib/hbnf/doc/en/dosver.txt
+++ b/harbour/contrib/hbnf/doc/en/dosver.txt
@@ -28,8 +28,9 @@
*
*
* $EXAMPLES$
- * FUNCTION main()
- * RETURN QOut( "Dos version: " + FT_DOSVER() )
+ * PROCEDURE Main()
+ * QOut( "Dos version: " + FT_DOSVER() )
+ * RETURN
*
* $END$
*/
diff --git a/harbour/contrib/hbnf/doc/en/proper.txt b/harbour/contrib/hbnf/doc/en/proper.txt
index 10b0c5fabd..8204dc78e0 100644
--- a/harbour/contrib/hbnf/doc/en/proper.txt
+++ b/harbour/contrib/hbnf/doc/en/proper.txt
@@ -32,8 +32,8 @@
* and Mark Zechiel; it was re-written in C (and thus, optimized
* and enhanced) by Robert DiFalco.
* $EXAMPLES$
- * FUNCTION main( cStr )
- * OutStd( FT_PROPER( cStr ) + chr(13) + chr(10) )
- * RETURN ( nil )
+ * PROCEDURE Main( cStr )
+ * OutStd( FT_PROPER( cStr ) + hb_eol() )
+ * RETURN
* $END$
*/
diff --git a/harbour/contrib/hbnf/doc/en/setdate.txt b/harbour/contrib/hbnf/doc/en/setdate.txt
index 92594fbf8f..314f6089fc 100644
--- a/harbour/contrib/hbnf/doc/en/setdate.txt
+++ b/harbour/contrib/hbnf/doc/en/setdate.txt
@@ -31,14 +31,14 @@
* The following program takes a date from the command line and sets
* the DOS system date:
*
- * FUNCTION main( cDate )
+ * PROCEDURE Main( cDate )
*
- * cDate := iif( cDate == nil, dtoc( date() ), cDate )
+ * cDate := iif( cDate == NIL, DToC( Date() ), cDate )
* QOut( "Setting date to: " + cDate + "... " )
- * FT_SETDATE( ctod( cDate ) )
- * Qout( "Today is now: " + dtoc( date() ) )
+ * FT_SETDATE( CToD( cDate ) )
+ * QOut( "Today is now: " + DToC( Date() ) )
*
- * RETURN NIL
+ * RETURN
*
* $END$
*/
diff --git a/harbour/contrib/hbnf/doc/en/settime.txt b/harbour/contrib/hbnf/doc/en/settime.txt
index 355bf44ffc..d3af69b9e0 100644
--- a/harbour/contrib/hbnf/doc/en/settime.txt
+++ b/harbour/contrib/hbnf/doc/en/settime.txt
@@ -29,14 +29,14 @@
* The following program takes a time string from the command line and sets
* the DOS system time:
*
- * FUNCTION main( cTime )
+ * PROCEDURE Main( cTime )
*
- * cTime := iif( cTime == nil, time(), cTime )
+ * cTime := iif( cTime == NIL, Time(), cTime )
* QOut( "Setting time to: " + cTime + "... " )
* FT_SETTIME( cTime )
- * Qout( "Time is now: " + time() )
+ * QOut( "Time is now: " + Time() )
*
- * RETURN NIL
+ * RETURN
*
* $END$
*/
diff --git a/harbour/contrib/hbnf/dosver.prg b/harbour/contrib/hbnf/dosver.prg
index bda1e55321..63f83ee06c 100644
--- a/harbour/contrib/hbnf/dosver.prg
+++ b/harbour/contrib/hbnf/dosver.prg
@@ -31,9 +31,9 @@
#define DOSVER 48
#ifdef FT_TEST
- FUNCTION MAIN()
+ PROCEDURE Main()
QOut( "Dos version: " + FT_DOSVER() )
- RETURN NIL
+ RETURN
#endif
FUNCTION FT_DOSVER()
diff --git a/harbour/contrib/hbnf/e2d.prg b/harbour/contrib/hbnf/e2d.prg
index fdeee5af34..075b22c6a6 100644
--- a/harbour/contrib/hbnf/e2d.prg
+++ b/harbour/contrib/hbnf/e2d.prg
@@ -25,8 +25,9 @@
*/
#ifdef FT_TEST
- function main( sNumE )
- return qout( FT_E2D( sNumE ) )
+ PROCEDURE Main( sNumE )
+ qout( FT_E2D( sNumE ) )
+ RETURN
#endif
function ft_e2d( sNumE )
diff --git a/harbour/contrib/hbnf/findith.prg b/harbour/contrib/hbnf/findith.prg
index 9ef4ba5769..7b0652f61e 100644
--- a/harbour/contrib/hbnf/findith.prg
+++ b/harbour/contrib/hbnf/findith.prg
@@ -29,7 +29,7 @@
#define NULL ""
#ifdef FT_TEST
- FUNCTION MAIN( cCk, cStr, nOcc, xCase )
+ PROCEDURE Main( cCk, cStr, nOcc, xCase )
LOCAL nFind
if pcount() != 4
QOut( "usage: findith cCk cStr nOcc xCase")
@@ -43,7 +43,7 @@
QOut( cStr )
nFind := FT_FINDITH( cCk, cStr, nOcc, xCase )
QOut( iif( nFind > 0, space( nFind - 1) + "^" , "Not found" ) )
- RETURN nil
+ RETURN
#endif
FUNCTION FT_FINDITH(cCheckFor,cCheckIn,nWhichOccurrence,lIgnoreCase)
diff --git a/harbour/contrib/hbnf/gcd.prg b/harbour/contrib/hbnf/gcd.prg
index c6677b8cf1..718a5bc77c 100644
--- a/harbour/contrib/hbnf/gcd.prg
+++ b/harbour/contrib/hbnf/gcd.prg
@@ -33,8 +33,9 @@
IF
+
+// codeblocks test
-
-function Main()
- local B := "this will never print"
- local a := { |b,c| OutStd( "I am a codeblock" + b + c ) }
- local d
- local de
- local ar := { 1, 2 }
- local crlf:=CHR(13)+chr(10)
- local YY, X
- local x1, x2
-
- OutStd( "this should print first" )
- OutStd( crlf )
-
- Eval( a, " with parameters", " ... and it works!" )
- OutStd( crlf )
-
- d ="with access to local variables"
-
- a ={ |b,c| OutStd( "I am a second codeblock " +d +b +;
- IIF(c==NIL, ' empty second parameter ', c)), OutStd(crlf), "WITH return value" }
- EVAL( a, ", codeblock parameters" )
- OutStd( crlf )
-
- EVAL( a, ", codeblock parameters ", "and with second parameter" )
- OutStd( crlf )
-
- OutStd( MyEval( a ) )
- OutStd( crlf )
-
- OtherTest( a )
- OutStd( crlf )
-
- AnotherTest( a, "==> Another " )
- OutStd( crlf )
-
- a ={|c| IIF( c=NIL, {|a| "First "+a}, {|a| "Second "+a}) }
- a =EVAL( a )
- OutStd( crlf )
- OutStd( EVAL( a, "codeblock created in a codeblock" ) )
- OutStd( crlf )
-
- OutStd( ar[ 1 ] )
- OutStd( crlf )
- a :={|| ar[ 1 ]++}
- EVAL( a )
- OutStd( ar[ 1 ] )
- OutStd( crlf )
-
- yy :=5
- x :={|xx| OutStd(LTRIM(STR(xx))), OutStd("+"), OutStd(LTRIM(STR(yy))), OutStd("="), xx + yy }
- OutStd( EVAL( x, 1 ) ) //this is OK
- OutStd( CRLF )
- OutStd( EVAL( x, 1, 2 ) ) //this should ignore unnecesary parameters
-
- QOut( EVAL( RetBlock(), 5 ) )
-
-// BugToFix()
- OutStd( crlf )
-
- OutStd( "Trying to use detached variable ..." )
- OutStd( crlf )
- x1 :=5
- x2 :=6
- de =DetachLocal( x1, x2 )
- OutStd( EVAL( de ) )
- //changing the value of variables
- OutStd( crlf )
- x1 := 10
- x2 := 11
- QOut( EVAL( de ) )
- de =DetachLocal( x1, x2 )
- QOut( EVAL( de ) )
-
-return nil
-
-FUNCTION MyEval( bCodeBlock )
-LOCAL D:="this is another variable"
-
-RETURN( EVAL(bCodeBlock, " from ", "MyEval Function" ) )
-
-PROCEDURE OtherTest( cblock )
-LOCAL cb
-
- cb :={|a,b| EVAL( cblock,a,b ) }
-
- EVAL( cb, "--> with nested ", "EVAL" )
-
-RETURN
-
-PROCEDURE AnotherTest( cb, a )
- OutStd( EVAL( cb, a ) )
- OutStd( chr(13)+chr(10) )
- OutStd( EVAL( cb, a, "again and again" ) )
- OutStd( chr(13)+chr(10) )
-RETURN
-
-FUNCTION DetachLocal( x, y )
-//NOTE! this should work
-LOCAL z:=x+y
-LOCAL cb:={|| QOut("z=x+y="), QOut(z), QOut("x*x="), QOut(x*x), QOut("x*x+z="), x*x+z}
-RETURN( cb )
-
-PROCEDURE BugToFix()
-
- LOCAL b, a := {|| a+b }
-
- b ="bug "
- EVAL( a )
-
-RETURN
-
-FUNCTION RetBlock()
-
-RETURN( {|x| x*x} )
-
-
-
diff --git a/harbour/website/samples/testbrw.prg.html b/harbour/website/samples/testbrw.prg.html
index 9696d7499c..147237a6bc 100644
--- a/harbour/website/samples/testbrw.prg.html
+++ b/harbour/website/samples/testbrw.prg.html
@@ -1,169 +1,169 @@
-
-// codeblocks test
+
+function Main()
+ local B := "this will never print"
+ local a := {| b, c | OutStd( "I am a codeblock" + b + c ) }
+ local d
+ local de
+ local ar := { 1, 2 }
+ local crlf:=CHR(13)+chr(10)
+ local YY, X
+ local x1, x2
+
+ OutStd( "this should print first" )
+ OutStd( crlf )
+
+ Eval( a, " with parameters", " ... and it works!" )
+ OutStd( crlf )
+
+ d ="with access to local variables"
+
+ a ={| b, c | OutStd( "I am a second codeblock " +d +b +;
+ IIF(c==NIL, ' empty second parameter ', c)), OutStd(crlf), "WITH return value" }
+ EVAL( a, ", codeblock parameters" )
+ OutStd( crlf )
+
+ EVAL( a, ", codeblock parameters ", "and with second parameter" )
+ OutStd( crlf )
+
+ OutStd( MyEval( a ) )
+ OutStd( crlf )
+
+ OtherTest( a )
+ OutStd( crlf )
+
+ AnotherTest( a, "==> Another " )
+ OutStd( crlf )
+
+ a ={| c | IIF( c=NIL, {| a | "First "+a}, {| a | "Second "+a}) }
+ a =EVAL( a )
+ OutStd( crlf )
+ OutStd( EVAL( a, "codeblock created in a codeblock" ) )
+ OutStd( crlf )
+
+ OutStd( ar[ 1 ] )
+ OutStd( crlf )
+ a :={|| ar[ 1 ]++}
+ EVAL( a )
+ OutStd( ar[ 1 ] )
+ OutStd( crlf )
+
+ yy :=5
+ x :={|xx| OutStd(LTRIM(STR(xx))), OutStd("+"), OutStd(LTRIM(STR(yy))), OutStd("="), xx + yy }
+ OutStd( EVAL( x, 1 ) ) //this is OK
+ OutStd( CRLF )
+ OutStd( EVAL( x, 1, 2 ) ) //this should ignore unnecesary parameters
+
+ QOut( EVAL( RetBlock(), 5 ) )
+
+// BugToFix()
+ OutStd( crlf )
+
+ OutStd( "Trying to use detached variable ..." )
+ OutStd( crlf )
+ x1 :=5
+ x2 :=6
+ de =DetachLocal( x1, x2 )
+ OutStd( EVAL( de ) )
+ //changing the value of variables
+ OutStd( crlf )
+ x1 := 10
+ x2 := 11
+ QOut( EVAL( de ) )
+ de =DetachLocal( x1, x2 )
+ QOut( EVAL( de ) )
+
+return nil
+
+FUNCTION MyEval( bCodeBlock )
+LOCAL D:="this is another variable"
+
+RETURN( EVAL(bCodeBlock, " from ", "MyEval Function" ) )
+
+PROCEDURE OtherTest( cblock )
+LOCAL cb
+
+ cb :={| a, b | EVAL( cblock,a,b ) }
+
+ EVAL( cb, "--> with nested ", "EVAL" )
+
+RETURN
+
+PROCEDURE AnotherTest( cb, a )
+ OutStd( EVAL( cb, a ) )
+ OutStd( chr(13)+chr(10) )
+ OutStd( EVAL( cb, a, "again and again" ) )
+ OutStd( chr(13)+chr(10) )
+RETURN
+
+FUNCTION DetachLocal( x, y )
+//NOTE! this should work
+LOCAL z:=x+y
+LOCAL cb:={|| QOut("z=x+y="), QOut(z), QOut("x*x="), QOut(x*x), QOut("x*x+z="), x*x+z}
+RETURN( cb )
+
+PROCEDURE BugToFix()
+
+ LOCAL b, a := {|| a+b }
+
+ b ="bug "
+ EVAL( a )
+
+RETURN
+
+FUNCTION RetBlock()
+
+RETURN( {|x| x*x} )
+
+
+
+
+// Harbour Class TBrowse and TBColumn sample
-
-#include "inkey.ch"
-
-function Main()
-
- local oBrowse := TBrowseNew( 5, 5, 16, 30 )
- local aTest0 := { "This", "is", "a", "browse", "on", "an", "array", "test", "with", "a", "long", "data" }
- local aTest1 := { 1, 2, 3, 4, 5, 6, 7, 8, 10000, -1000, 54, 456342 }
- local aTest2 := { date(), date()+4, date()+56, date()+14, date()+5, date()+6, date()+7, date()+8, date()+10000, date()-1000, date()-54, date()+456342 }
- local aTest3 := { .t., .f., .t., .t., .f., .f., .t., .f., .t., .t., .f., .f. }
- local n := 1
- local nKey
- local lEnd := .f.
- local nCursor
- local cColor
- local nRow, nCol
- local nTmpRow, nTmpCol
-
- oBrowse:colorSpec = "W+/B, N/BG"
- oBrowse:ColSep = "¦"
- oBrowse:HeadSep = "Ð-"
- oBrowse:FootSep = "¤-"
- oBrowse:GoTopBlock = { || n := 1 }
- oBrowse:GoBottomBlock = { || n := Len( aTest0 ) }
- oBrowse:SkipBlock = { | nSkip, nPos | nPos := n,;
- n := If( nSkip > 0, Min( Len( aTest0 ), n + nSkip ),;
- Max( 1, n + nSkip )), n - nPos }
-
- oBrowse:AddColumn( TBColumnNew( "First", { || n } ) )
- oBrowse:AddColumn( TBColumnNew( "Second", { || aTest0[ n ] } ) )
- oBrowse:AddColumn( TBColumnNew( "Third", { || aTest1[ n ] } ) )
- oBrowse:AddColumn( TBColumnNew( "Forth", { || aTest2[ n ] } ) )
- oBrowse:AddColumn( TBColumnNew( "Fifth", { || aTest3[ n ] } ) )
- oBrowse:GetColumn(1):Footing = 'Number'
- oBrowse:GetColumn(2):Footing = 'Strins'
-
- oBrowse:GetColumn(2):Picture := '@!'
-
- oBrowse:GetColumn(3):Footing = 'Number'
- oBrowse:GetColumn(3):Picture := '999,999.99'
- oBrowse:GetColumn(4):Footing = 'Dates'
- oBrowse:GetColumn(5):Footing = 'Logical'
- // needed since I've changed some columns _after_ I've added them to TBrowse object
- oBrowse:Configure()
-
- Alert( oBrowse:ClassName() )
- Alert( oBrowse:GetColumn( 1 ):ClassName() )
-
- oBrowse:Freeze = 1
- nCursor := SetCursor( 0 )
- cColor := SetColor( "W+/B" )
- nRow := Row()
- nCol := Col()
- @ 4,4,17,31 BOX "+-+¦+-+¦ "
-#ifdef HB_COMPAT_C53
- oBrowse:Setkey(0,{|ob,nkey| Defproc(ob,nKey)})
-while .t.
- oBrowse:ForceStable()
- if (oBrowse:applykey(inkey(0))== -1)
- exit
-endif
-enddo
-#else
-While !lEnd
- oBrowse:ForceStable()
-
- nKey = InKey( 0 )
-
- do case
- case nKey == K_ESC
- SetPos( 17, 0 )
- lEnd = .t.
-
- case nKey == K_DOWN
- oBrowse:Down()
-
- case nKey == K_UP
- oBrowse:Up()
-
- case nKey == K_LEFT
- oBrowse:Left()
-
- case nKey == K_RIGHT
- oBrowse:Right()
-
- case nKey = K_PGDN
- oBrowse:pageDown()
-
- case nKey = K_PGUP
- oBrowse:pageUp()
-
- case nKey = K_CTRL_PGUP
- oBrowse:goTop()
-
- case nKey = K_CTRL_PGDN
- oBrowse:goBottom()
-
- case nKey = K_HOME
- oBrowse:home()
-
- case nKey = K_END
- oBrowse:end()
-
- case nKey = K_CTRL_LEFT
- oBrowse:panLeft()
-
- case nKey = K_CTRL_RIGHT
- oBrowse:panRight()
-
- case nKey = K_CTRL_HOME
- oBrowse:panHome()
-
- case nKey = K_CTRL_END
- oBrowse:panEnd()
-
- case nKey = K_TAB
- nTmpRow := ROW()
- nTmpCol := COL()
- @ 0, 0 SAY TIME()
- DevPos( nTmpRow, nTmpCol )
-
- endcase
-
- end
-#endif
- DevPos( nRow, nCol )
- SetColor( cColor )
- SetCursor( nCursor )
-
-return nil
-#ifdef HB_COMPAT_C53
-function defproc(ob,nkey)
-Local nTmpRow,nTmpCol
- if nKey = K_TAB
- nTmpRow := ROW()
- nTmpCol := COL()
- @ 0, 0 SAY TIME()
- DevPos( nTmpRow, nTmpCol )
- ob:Refreshall()
- endif
- return 1
-#endif
-
-
diff --git a/harbour/website/samples/testcgi.prg.html b/harbour/website/samples/testcgi.prg.html
index ffe4b6e714..3962ed826b 100644
--- a/harbour/website/samples/testcgi.prg.html
+++ b/harbour/website/samples/testcgi.prg.html
@@ -1,495 +1,495 @@
-
-// Harbour Class TBrowse and TBColumn sample
+
+#include "inkey.ch"
+
+function Main()
+
+ local oBrowse := TBrowseNew( 5, 5, 16, 30 )
+ local aTest0 := { "This", "is", "a", "browse", "on", "an", "array", "test", "with", "a", "long", "data" }
+ local aTest1 := { 1, 2, 3, 4, 5, 6, 7, 8, 10000, -1000, 54, 456342 }
+ local aTest2 := { date(), date()+4, date()+56, date()+14, date()+5, date()+6, date()+7, date()+8, date()+10000, date()-1000, date()-54, date()+456342 }
+ local aTest3 := { .t., .f., .t., .t., .f., .f., .t., .f., .t., .t., .f., .f. }
+ local n := 1
+ local nKey
+ local lEnd := .f.
+ local nCursor
+ local cColor
+ local nRow, nCol
+ local nTmpRow, nTmpCol
+
+ oBrowse:colorSpec = "W+/B, N/BG"
+ oBrowse:ColSep = "|"
+ oBrowse:HeadSep = "?-"
+ oBrowse:FootSep = "¤-"
+ oBrowse:GoTopBlock = {|| n := 1 }
+ oBrowse:GoBottomBlock = {|| n := Len( aTest0 ) }
+ oBrowse:SkipBlock = {| nSkip, nPos | nPos := n,;
+ n := If( nSkip > 0, Min( Len( aTest0 ), n + nSkip ),;
+ Max( 1, n + nSkip )), n - nPos }
+
+ oBrowse:AddColumn( TBColumnNew( "First", {|| n } ) )
+ oBrowse:AddColumn( TBColumnNew( "Second", {|| aTest0[ n ] } ) )
+ oBrowse:AddColumn( TBColumnNew( "Third", {|| aTest1[ n ] } ) )
+ oBrowse:AddColumn( TBColumnNew( "Forth", {|| aTest2[ n ] } ) )
+ oBrowse:AddColumn( TBColumnNew( "Fifth", {|| aTest3[ n ] } ) )
+ oBrowse:GetColumn(1):Footing = 'Number'
+ oBrowse:GetColumn(2):Footing = 'Strins'
+
+ oBrowse:GetColumn(2):Picture := '@!'
+
+ oBrowse:GetColumn(3):Footing = 'Number'
+ oBrowse:GetColumn(3):Picture := '999,999.99'
+ oBrowse:GetColumn(4):Footing = 'Dates'
+ oBrowse:GetColumn(5):Footing = 'Logical'
+ // needed since I've changed some columns _after_ I've added them to TBrowse object
+ oBrowse:Configure()
+
+ Alert( oBrowse:ClassName() )
+ Alert( oBrowse:GetColumn( 1 ):ClassName() )
+
+ oBrowse:Freeze = 1
+ nCursor := SetCursor( 0 )
+ cColor := SetColor( "W+/B" )
+ nRow := Row()
+ nCol := Col()
+ @ 4,4,17,31 BOX "+-+|+-+| "
+#ifdef HB_COMPAT_C53
+ oBrowse:Setkey(0,{|ob,nkey| Defproc(ob,nKey)})
+while .t.
+ oBrowse:ForceStable()
+ if (oBrowse:applykey(inkey(0))== -1)
+ exit
+endif
+enddo
+#else
+While !lEnd
+ oBrowse:ForceStable()
+
+ nKey = InKey( 0 )
+
+ do case
+ case nKey == K_ESC
+ SetPos( 17, 0 )
+ lEnd = .t.
+
+ case nKey == K_DOWN
+ oBrowse:Down()
+
+ case nKey == K_UP
+ oBrowse:Up()
+
+ case nKey == K_LEFT
+ oBrowse:Left()
+
+ case nKey == K_RIGHT
+ oBrowse:Right()
+
+ case nKey = K_PGDN
+ oBrowse:pageDown()
+
+ case nKey = K_PGUP
+ oBrowse:pageUp()
+
+ case nKey = K_CTRL_PGUP
+ oBrowse:goTop()
+
+ case nKey = K_CTRL_PGDN
+ oBrowse:goBottom()
+
+ case nKey = K_HOME
+ oBrowse:home()
+
+ case nKey = K_END
+ oBrowse:end()
+
+ case nKey = K_CTRL_LEFT
+ oBrowse:panLeft()
+
+ case nKey = K_CTRL_RIGHT
+ oBrowse:panRight()
+
+ case nKey = K_CTRL_HOME
+ oBrowse:panHome()
+
+ case nKey = K_CTRL_END
+ oBrowse:panEnd()
+
+ case nKey = K_TAB
+ nTmpRow := ROW()
+ nTmpCol := COL()
+ @ 0, 0 SAY TIME()
+ DevPos( nTmpRow, nTmpCol )
+
+ endcase
+
+ end
+#endif
+ DevPos( nRow, nCol )
+ SetColor( cColor )
+ SetCursor( nCursor )
+
+return nil
+#ifdef HB_COMPAT_C53
+function defproc(ob,nkey)
+Local nTmpRow,nTmpCol
+ if nKey = K_TAB
+ nTmpRow := ROW()
+ nTmpCol := COL()
+ @ 0, 0 SAY TIME()
+ DevPos( nTmpRow, nTmpCol )
+ ob:Refreshall()
+ endif
+ return 1
+#endif
+
+
-
+
+/*
- *
- * TestCGI.PRG
- * Harbour Test of a CGI/HTML-Generator class.
- *
- * 1999/05/30 First implementation.
- *
- * Tips: - Use ShowResults to make dynamic html (to test dynamic
- * results, put the exe file on CGI-BIN dir or equivalent);
- * - Use SaveToFile to make static html page
- *
- * 1999/05/31 Initial CGI functionality.
- * 1999/06/01 Translated %nn to correct chars.
- * 1999/06/02 Dynamic TAG matching routines (inspired on Delphi).
- * First attempt to convert Delphi's ISAPI dll of WebSites'
- * Function List
- * (See http://www.flexsys-ci.com/harbour-project/functions.htm)
- * 1999/06/11 List can be viewed online at
- * http://www.flexsys-ci.com/cgi-bin/testcgi.exe
- * 1999/07/29 Changed qOut() calls to OutStd() calls.
- *
- */
-
-#define CGI_SERVER_SOFTWARE 01
-#define CGI_SERVER_NAME 02
-#define CGI_GATEWAY_INTERFACE 03
-#define CGI_SERVER_PROTOCOL 04
-#define CGI_SERVER_PORT 05
-#define CGI_REQUEST_METHOD 06
-#define CGI_HTTP_ACCEPT 07
-#define CGI_HTTP_USER_AGENT 08
-#define CGI_HTTP_REFERER 09
-#define CGI_PATH_INFO 10
-#define CGI_PATH_TRANSLATED 11
-#define CGI_SCRIPT_NAME 12
-#define CGI_QUERY_STRING 13
-#define CGI_REMOTE_HOST 14
-#define CGI_REMOTE_ADDR 15
-#define CGI_REMOTE_USER 16
-#define CGI_AUTH_TYPE 17
-#define CGI_CONTENT_TYPE 18
-#define CGI_CONTENT_LENGTH 19
-#define CGI_ANNOTATION_SERVER 20
-
-#define IF_BUFFER 65535
-
-FUNCTION Main()
-
- LOCAL oHTML := THTML():New()
- LOCAL hFile, nPos, cString, cBuf, i, cTable, cLine
-
- oHTML:SetHTMLFile( "function.cfm" )
-
- hFile := fOpen( "list.txt", 0 )
-
- cString := space( IF_BUFFER )
- cBuf := ""
- cTable := ""
-
- // Builds dynamic table replacement
- WHILE hFile != -1 .AND. (nPos := fRead( hFile, @cString, IF_BUFFER )) > 0
- i := 1
- DO WHILE i <= nPos
-
- IF substr( cString, i, 1 ) = chr( 13 )
- i := i + 1
- cLine := cBuf
- cBuf := ""
-
- IF left( cLine, 1 ) <> ';'
- cTable += '<TR>' + chr(10)+chr(13) + ;
- '<TD WIDTH="50%"><FONT SIZE="2" FACE="Tahoma">' + ;
- ParseString( cLine, ';', 1 ) + '</FONT></TD>' + chr(10)+chr(13) + ;
- '<TD WIDTH="16%">' + ;
- if( ParseString( cLine, ';', 2 ) = 'R', ;
- '<CENTER><IMG SRC="images/purple-m.gif">', ;
- ' ' ) + ;
- '</TD>' + chr(10)+chr(13) + ;
- '<TD WIDTH="16%">' + ;
- if( ParseString( cLine, ';', 2 ) = 'S', ;
- '<CENTER><IMG SRC="images/purple-m.gif">', ;
- ' ' ) + ;
- '</TD>' + chr(10)+chr(13) + ;
- '<TD WIDTH="16%">' + ;
- if( ParseString( cLine, ';', 2 ) = 'N', ;
- '<CENTER><IMG SRC="images/purple-m.gif">', ;
- ' ' ) + ;
- '</TD>' + chr(10)+chr(13) + ;
- '</TR>'
- ENDIF
- ELSE
- cBuf := cBuf + substr( cString, i, 1 )
- ENDIF
-
- i++
- ENDDO
- ENDDO
-
- fClose( hFile )
-
- oHTML:AddReplaceTag( "Functions", cTable )
- oHTML:Generate()
-
- // Uncomment the following if you don't have a Web Server to test
- // this sample
-
-// oHTML:SaveToFile( "test.htm" )
-
- // If the above is uncommented, you may comment this line:
-
- oHTML:ShowResult()
-
- RETURN( NIL )
-
-FUNCTION ParseString( cString, cDelim, nRet )
-
- LOCAL cBuf, aElem, nPosFim, nSize, i
-
- nSize := len( cString ) - len( StrTran( cString, cDelim, '' ) ) + 1
- aElem := array( nSize )
-
- cBuf := cString
- i := 1
- FOR i := 1 TO nSize
- nPosFim := at( cDelim, cBuf )
-
- IF nPosFim > 0
- aElem[i] := substr( cBuf, 1, nPosFim - 1 )
- ELSE
- aElem[i] := cBuf
- ENDIF
-
- cBuf := substr( cBuf, nPosFim + 1, len( cBuf ) )
-
- NEXT i
-
- RETURN( aElem[ nRet ] )
-
-FUNCTION Hex2Dec( cHex )
-
- LOCAL aHex := { { "0", 00 }, ;
- { "1", 01 }, ;
- { "2", 02 }, ;
- { "3", 03 }, ;
- { "4", 04 }, ;
- { "5", 05 }, ;
- { "6", 06 }, ;
- { "7", 07 }, ;
- { "8", 08 }, ;
- { "9", 09 }, ;
- { "A", 10 }, ;
- { "B", 11 }, ;
- { "C", 12 }, ;
- { "D", 13 }, ;
- { "E", 14 }, ;
- { "F", 15 } }
- LOCAL nRet
- LOCAL nRes
-
- nRet := ascan( aHex, { |x| upper( x[1] ) = upper( left( cHex, 1 ) ) } )
- nRes := aHex[nRet, 2] * 16
- nRet := ascan( aHex, { |x| upper( x[1] ) = upper( right( cHex, 1 ) ) } )
- nRes += aHex[nRet, 2]
-
- RETURN( nRes )
-
-/*-------------------------------------------------------------------------*/
-
-FUNCTION THTML
-
- STATIC oClass
-
- IF oClass == NIL
- oClass = HBClass():New( "THTML" )
-
- oClass:AddData( "cTitle" ) // Page Title
- oClass:AddData( "cBody" ) // HTML Body Handler
- oClass:AddData( "cBGColor" ) // Background Color
- oClass:AddData( "cLinkColor" ) // Link Color
- oClass:AddData( "cvLinkColor" ) // Visited Link Color
- oClass:AddData( "cContent" ) // Page Content Handler
-
- oClass:AddData( "aCGIContents" )
- oClass:AddData( "aQueryFields" )
- oClass:AddData( "cHTMLFile" )
- oClass:AddData( "aReplaceTags" )
-
- oClass:AddMethod( "New", @New() ) // New Method
- oClass:AddMethod( "SetTitle", @SetTitle() ) // Set Page Title
- oClass:AddMethod( "AddHead", @AddHead() ) // Add <H1> Header
- oClass:AddMethod( "AddLink", @AddLink() ) // Add Hyperlink
- oClass:AddMethod( "AddPara", @AddPara() ) // Add Paragraph
- oClass:AddMethod( "SaveToFile", @SaveToFile() ) // Saves Content to File
- oClass:AddMethod( "ShowResult", @ShowResult() ) // Show Result - SEE Fcn
- oClass:AddMethod( "Generate", @Generate() ) // Generate HTML
- oClass:AddMethod( "SetHTMLFile",@SetHTMLFile() ) // Sets source HTML file
-
- oClass:AddMethod( "ProcessCGI", @ProcessCGI() )
- oClass:AddMethod( "GetCGIParam", @GetCGIParam() )
- oClass:AddMethod( "QueryFields", @QueryFields() )
- oClass:AddMethod( "AddReplaceTag", @AddReplaceTag() )
-
- oClass:Create()
-
- ENDIF
-
- RETURN( oClass:Instance() )
-
-STATIC FUNCTION New()
-
- LOCAL Self := QSelf()
-
- ::cTitle := "Untitled"
- ::cBGColor := "#FFFFFF"
- ::cLinkColor := "#0000FF"
- ::cvLinkColor := "#FF0000"
- ::cContent := ""
- ::cBody := ""
- ::aCGIContents := {}
- ::aQueryFields := {}
- ::aReplaceTags := {}
- ::cHTMLFile := ""
-
- RETURN( Self )
-
-STATIC FUNCTION SetTitle( cTitle )
-
- LOCAL Self := QSelf()
-
- ::cTitle := cTitle
-
- RETURN( Self )
-
-STATIC FUNCTION AddLink( cLinkTo, cLinkName )
-
- LOCAL Self := QSelf()
-
- ::cBody := ::cBody + ;
- "<A HREF='" + cLinkTo + "'>" + cLinkName + "</A>"
-
- RETURN( Self )
-
-STATIC FUNCTION AddHead( cDescr )
-
- LOCAL Self := QSelf()
-
- // Why this doesn't work?
- // ::cBody += ...
- // ???
-
- ::cBody := ::cBody + ;
- "<H1>" + cDescr + "</H1>"
-
- RETURN( NIL )
-
-STATIC FUNCTION AddPara( cPara, cAlign )
-
- LOCAL Self := QSelf()
-
- ::cBody := ::cBody + ;
- "<P ALIGN='" + cAlign + "'>" + HB_OSNewLine() + ;
- cPara + HB_OSNewLine() + ;
- "</P>"
-
- RETURN( Self )
-
-STATIC FUNCTION Generate()
-
- LOCAL Self := QSelf()
- LOCAL cFile, i, hFile, nPos, cRes := ""
- LOCAL lFlag := .f.
-
- // Is this a meta file or hand generated script?
- IF empty( ::cHTMLFile )
- ::cContent := ;
- "<HTML><HEAD>" + HB_OSNewLine() + ;
- "<TITLE>" + ::cTitle + "</TITLE>" + HB_OSNewLine() + ;
- "<BODY link='" + ::cLinkColor + "' " + ;
- "vlink='" + ::cvLinkColor + "'>" + + HB_OSNewLine() + ;
- ::cBody + HB_OSNewLine() + ;
- "</BODY></HTML>"
- ELSE
- ::cContent := ""
-
- // Does cHTMLFile exists?
- IF !File( ::cHTMLFile )
- ::cContent := "<H1>Server Error</H1><P><I>No such file: " + ;
- ::cHTMLFile
- ELSE
- // Read from file
- hFile := fOpen( ::cHTMLFile, 0 )
- cFile := space( IF_BUFFER )
- DO WHILE (nPos := fRead( hFile, @cFile, IF_BUFFER )) > 0
-
- cFile := left( cFile, nPos )
- cRes += cFile
- cFile := space( IF_BUFFER )
-
- ENDDO
-
- fClose( hFile )
-
- // Replace matched tags
- i := 1
- ::cContent := cRes
- /* TODO: Replace this DO WHILE with FOR..NEXT */
- DO WHILE i <= len( ::aReplaceTags )
- ::cContent := strtran( ::cContent, ;
- "<#" + ::aReplaceTags[i, 1] + ">", ::aReplaceTags[i, 2] )
- i++
- ENDDO
-
- /* TODO: Clear remaining (not matched) tags */
- /*
- cRes := ""
- FOR i := 1 TO len( ::cContent )
- IF substr( ::cContent, i, 1 ) == "<" .AND. ;
- substr( ::cContent, i + 1, 1 ) == "#"
- lFlag := .t.
- ELSEIF substr( ::cContent, i, 1 ) == ">" .AND. lFlag
- lFlag := .f.
- ELSEIF !lFlag
- cRes += substr( ::cContent, i, 1 )
- ENDIF
- NEXT i
-
- ::cContent := cRes
- */
-
- ENDIF
- ENDIF
-
- RETURN( Self )
-
-STATIC FUNCTION ShowResult()
-
- LOCAL Self := QSelf()
-
- OutStd( ;
- "HTTP/1.0 200 OK" + HB_OSNewLine() + ;
- "CONTENT-TYPE: TEXT/HTML" + HB_OSNewLine() + HB_OSNewLine() + ;
- ::cContent )
-
- RETURN( Self )
-
-STATIC FUNCTION SaveToFile( cFile )
-
- LOCAL Self := QSelf()
- LOCAL hFile := fCreate( cFile )
-
- fWrite( hFile, ::cContent )
- fClose( hFile )
-
- RETURN( Self )
-
-STATIC FUNCTION ProcessCGI()
-
- LOCAL Self := QSelf()
- LOCAL cQuery := ""
- LOCAL cBuff := ""
- LOCAL nBuff := 0
- LOCAL i
-
- IF empty( ::aCGIContents )
- ::aCGIContents := { ;
- GetEnv( "SERVER_SOFTWARE" ), ;
- GetEnv( "SERVER_NAME" ), ;
- GetEnv( "GATEWAY_INTERFACE" ), ;
- GetEnv( "SERVER_PROTOCOL" ), ;
- GetEnv( "SERVER_PORT" ), ;
- GetEnv( "REQUEST_METHOD" ), ;
- GetEnv( "HTTP_ACCEPT" ), ;
- GetEnv( "HTTP_USER_AGENT" ), ;
- GetEnv( "HTTP_REFERER" ), ;
- GetEnv( "PATH_INFO" ), ;
- GetEnv( "PATH_TRANSLATED" ), ;
- GetEnv( "SCRIPT_NAME" ), ;
- GetEnv( "QUERY_STRING" ), ;
- GetEnv( "REMOTE_HOST" ), ;
- GetEnv( "REMOTE_ADDR" ), ;
- GetEnv( "REMOTE_USER" ), ;
- GetEnv( "AUTH_TYPE" ), ;
- GetEnv( "CONTENT_TYPE" ), ;
- GetEnv( "CONTENT_LENGTH" ), ;
- GetEnv( "ANNOTATION_SERVER" ) ;
- }
-
- cQuery := ::GetCGIParam( CGI_QUERY_STRING )
-
- IF !empty( cQuery )
-
- ::aQueryFields := {}
-
- FOR i := 1 TO len( cQuery ) + 1
-
- IF i > len( cQuery ) .OR. substr( cQuery, i, 1 ) == "&"
-
- aadd( ::aQueryFields, ;
- { substr( cBuff, 1, at( "=", cBuff ) - 1 ), ;
- strtran( substr( cBuff, at( "=", cBuff ) + 1, ;
- len( cBuff ) - at( "=", cBuff ) + 1 ), "+", " " ) } )
- cBuff := ""
- ELSE
- IF substr( cQuery, i, 1 ) = "%"
- cBuff += chr( Hex2Dec( substr( cQuery, i + 1, 2 ) ) )
- nBuff := 3
- ENDIF
-
- IF nBuff = 0
- cBuff += substr( cQuery, i, 1 )
- ELSE
- nBuff--
- ENDIF
- ENDIF
-
- NEXT
-
- ENDIF
-
- ENDIF
-
- RETURN( Self )
-
-STATIC FUNCTION GetCGIParam( nParam )
-
- LOCAL Self := QSelf()
-
- ::ProcessCGI()
-
- IF nParam > 20 .OR. nParam < 1
- outerr( "Invalid CGI parameter" )
- RETURN( NIL )
- ENDIF
-
- RETURN( ::aCGIContents[nParam] )
-
-STATIC FUNCTION QueryFields( cQueryName )
-
- LOCAL Self := QSelf()
- LOCAL cRet := ""
- LOCAL nRet
-
- ::ProcessCGI()
-
- nRet := aScan( ::aQueryFields, ;
- { |x| upper( x[1] ) = upper( cQueryName ) } )
-
- IF nRet > 0
- cRet := ::aQueryFields[nRet, 2]
- ENDIF
-
- RETURN( cRet )
-
-STATIC FUNCTION SetHTMLFile( cFile )
-
- LOCAL Self := QSelf()
-
- ::cHTMLFile := cFile
-
- RETURN( Self )
-
-STATIC FUNCTION AddReplaceTag( cTag, cReplaceText )
-
- LOCAL Self := QSelf()
-
- aAdd( ::aReplaceTags, { cTag, cReplaceText } )
-
- RETURN( Self )
-
-
+
/*
+ *
+ * TestCGI.PRG
+ * Harbour Test of a CGI/HTML-Generator class.
+ *
+ * 1999/05/30 First implementation.
+ *
+ * Tips: - Use ShowResults to make dynamic html (to test dynamic
+ * results, put the exe file on CGI-BIN dir or equivalent);
+ * - Use SaveToFile to make static html page
+ *
+ * 1999/05/31 Initial CGI functionality.
+ * 1999/06/01 Translated %nn to correct chars.
+ * 1999/06/02 Dynamic TAG matching routines (inspired on Delphi).
+ * First attempt to convert Delphi's ISAPI dll of WebSites'
+ * Function List
+ * (See http://www.flexsys-ci.com/harbour-project/functions.htm)
+ * 1999/06/11 List can be viewed online at
+ * http://www.flexsys-ci.com/cgi-bin/testcgi.exe
+ * 1999/07/29 Changed qOut() calls to OutStd() calls.
+ *
+ */
+
+#define CGI_SERVER_SOFTWARE 01
+#define CGI_SERVER_NAME 02
+#define CGI_GATEWAY_INTERFACE 03
+#define CGI_SERVER_PROTOCOL 04
+#define CGI_SERVER_PORT 05
+#define CGI_REQUEST_METHOD 06
+#define CGI_HTTP_ACCEPT 07
+#define CGI_HTTP_USER_AGENT 08
+#define CGI_HTTP_REFERER 09
+#define CGI_PATH_INFO 10
+#define CGI_PATH_TRANSLATED 11
+#define CGI_SCRIPT_NAME 12
+#define CGI_QUERY_STRING 13
+#define CGI_REMOTE_HOST 14
+#define CGI_REMOTE_ADDR 15
+#define CGI_REMOTE_USER 16
+#define CGI_AUTH_TYPE 17
+#define CGI_CONTENT_TYPE 18
+#define CGI_CONTENT_LENGTH 19
+#define CGI_ANNOTATION_SERVER 20
+
+#define IF_BUFFER 65535
+
+FUNCTION Main()
+
+ LOCAL oHTML := THTML():New()
+ LOCAL hFile, nPos, cString, cBuf, i, cTable, cLine
+
+ oHTML:SetHTMLFile( "function.cfm" )
+
+ hFile := fOpen( "list.txt", 0 )
+
+ cString := space( IF_BUFFER )
+ cBuf := ""
+ cTable := ""
+
+ // Builds dynamic table replacement
+ WHILE hFile != -1 .AND. (nPos := fRead( hFile, @cString, IF_BUFFER )) > 0
+ i := 1
+ DO WHILE i <= nPos
+
+ IF substr( cString, i, 1 ) = chr( 13 )
+ i := i + 1
+ cLine := cBuf
+ cBuf := ""
+
+ IF left( cLine, 1 ) <> ';'
+ cTable += '<TR>' + chr(10)+chr(13) + ;
+ '<TD WIDTH="50%"><FONT SIZE="2" FACE="Tahoma">' + ;
+ ParseString( cLine, ';', 1 ) + '</FONT></TD>' + chr(10)+chr(13) + ;
+ '<TD WIDTH="16%">' + ;
+ if( ParseString( cLine, ';', 2 ) = 'R', ;
+ '<CENTER><IMG SRC="images/purple-m.gif">', ;
+ ' ' ) + ;
+ '</TD>' + chr(10)+chr(13) + ;
+ '<TD WIDTH="16%">' + ;
+ if( ParseString( cLine, ';', 2 ) = 'S', ;
+ '<CENTER><IMG SRC="images/purple-m.gif">', ;
+ ' ' ) + ;
+ '</TD>' + chr(10)+chr(13) + ;
+ '<TD WIDTH="16%">' + ;
+ if( ParseString( cLine, ';', 2 ) = 'N', ;
+ '<CENTER><IMG SRC="images/purple-m.gif">', ;
+ ' ' ) + ;
+ '</TD>' + chr(10)+chr(13) + ;
+ '</TR>'
+ ENDIF
+ ELSE
+ cBuf := cBuf + substr( cString, i, 1 )
+ ENDIF
+
+ i++
+ ENDDO
+ ENDDO
+
+ fClose( hFile )
+
+ oHTML:AddReplaceTag( "Functions", cTable )
+ oHTML:Generate()
+
+ // Uncomment the following if you don't have a Web Server to test
+ // this sample
+
+// oHTML:SaveToFile( "test.htm" )
+
+ // If the above is uncommented, you may comment this line:
+
+ oHTML:ShowResult()
+
+ RETURN( NIL )
+
+FUNCTION ParseString( cString, cDelim, nRet )
+
+ LOCAL cBuf, aElem, nPosFim, nSize, i
+
+ nSize := len( cString ) - len( StrTran( cString, cDelim, '' ) ) + 1
+ aElem := array( nSize )
+
+ cBuf := cString
+ i := 1
+ FOR i := 1 TO nSize
+ nPosFim := at( cDelim, cBuf )
+
+ IF nPosFim > 0
+ aElem[i] := substr( cBuf, 1, nPosFim - 1 )
+ ELSE
+ aElem[i] := cBuf
+ ENDIF
+
+ cBuf := substr( cBuf, nPosFim + 1, len( cBuf ) )
+
+ NEXT i
+
+ RETURN( aElem[ nRet ] )
+
+FUNCTION Hex2Dec( cHex )
+
+ LOCAL aHex := { { "0", 00 }, ;
+ { "1", 01 }, ;
+ { "2", 02 }, ;
+ { "3", 03 }, ;
+ { "4", 04 }, ;
+ { "5", 05 }, ;
+ { "6", 06 }, ;
+ { "7", 07 }, ;
+ { "8", 08 }, ;
+ { "9", 09 }, ;
+ { "A", 10 }, ;
+ { "B", 11 }, ;
+ { "C", 12 }, ;
+ { "D", 13 }, ;
+ { "E", 14 }, ;
+ { "F", 15 } }
+ LOCAL nRet
+ LOCAL nRes
+
+ nRet := ascan( aHex, {| x | upper( x[1] ) = upper( left( cHex, 1 ) ) } )
+ nRes := aHex[nRet, 2] * 16
+ nRet := ascan( aHex, {| x | upper( x[1] ) = upper( right( cHex, 1 ) ) } )
+ nRes += aHex[nRet, 2]
+
+ RETURN( nRes )
+
+/*-------------------------------------------------------------------------*/
+
+FUNCTION THTML
+
+ STATIC oClass
+
+ IF oClass == NIL
+ oClass = HBClass():New( "THTML" )
+
+ oClass:AddData( "cTitle" ) // Page Title
+ oClass:AddData( "cBody" ) // HTML Body Handler
+ oClass:AddData( "cBGColor" ) // Background Color
+ oClass:AddData( "cLinkColor" ) // Link Color
+ oClass:AddData( "cvLinkColor" ) // Visited Link Color
+ oClass:AddData( "cContent" ) // Page Content Handler
+
+ oClass:AddData( "aCGIContents" )
+ oClass:AddData( "aQueryFields" )
+ oClass:AddData( "cHTMLFile" )
+ oClass:AddData( "aReplaceTags" )
+
+ oClass:AddMethod( "New", @New() ) // New Method
+ oClass:AddMethod( "SetTitle", @SetTitle() ) // Set Page Title
+ oClass:AddMethod( "AddHead", @AddHead() ) // Add <H1> Header
+ oClass:AddMethod( "AddLink", @AddLink() ) // Add Hyperlink
+ oClass:AddMethod( "AddPara", @AddPara() ) // Add Paragraph
+ oClass:AddMethod( "SaveToFile", @SaveToFile() ) // Saves Content to File
+ oClass:AddMethod( "ShowResult", @ShowResult() ) // Show Result - SEE Fcn
+ oClass:AddMethod( "Generate", @Generate() ) // Generate HTML
+ oClass:AddMethod( "SetHTMLFile",@SetHTMLFile() ) // Sets source HTML file
+
+ oClass:AddMethod( "ProcessCGI", @ProcessCGI() )
+ oClass:AddMethod( "GetCGIParam", @GetCGIParam() )
+ oClass:AddMethod( "QueryFields", @QueryFields() )
+ oClass:AddMethod( "AddReplaceTag", @AddReplaceTag() )
+
+ oClass:Create()
+
+ ENDIF
+
+ RETURN( oClass:Instance() )
+
+STATIC FUNCTION New()
+
+ LOCAL Self := QSelf()
+
+ ::cTitle := "Untitled"
+ ::cBGColor := "#FFFFFF"
+ ::cLinkColor := "#0000FF"
+ ::cvLinkColor := "#FF0000"
+ ::cContent := ""
+ ::cBody := ""
+ ::aCGIContents := {}
+ ::aQueryFields := {}
+ ::aReplaceTags := {}
+ ::cHTMLFile := ""
+
+ RETURN( Self )
+
+STATIC FUNCTION SetTitle( cTitle )
+
+ LOCAL Self := QSelf()
+
+ ::cTitle := cTitle
+
+ RETURN( Self )
+
+STATIC FUNCTION AddLink( cLinkTo, cLinkName )
+
+ LOCAL Self := QSelf()
+
+ ::cBody := ::cBody + ;
+ "<A HREF='" + cLinkTo + "'>" + cLinkName + "</A>"
+
+ RETURN( Self )
+
+STATIC FUNCTION AddHead( cDescr )
+
+ LOCAL Self := QSelf()
+
+ // Why this doesn't work?
+ // ::cBody += ...
+ // ???
+
+ ::cBody := ::cBody + ;
+ "<H1>" + cDescr + "</H1>"
+
+ RETURN( NIL )
+
+STATIC FUNCTION AddPara( cPara, cAlign )
+
+ LOCAL Self := QSelf()
+
+ ::cBody := ::cBody + ;
+ "<P ALIGN='" + cAlign + "'>" + HB_OSNewLine() + ;
+ cPara + HB_OSNewLine() + ;
+ "</P>"
+
+ RETURN( Self )
+
+STATIC FUNCTION Generate()
+
+ LOCAL Self := QSelf()
+ LOCAL cFile, i, hFile, nPos, cRes := ""
+ LOCAL lFlag := .f.
+
+ // Is this a meta file or hand generated script?
+ IF empty( ::cHTMLFile )
+ ::cContent := ;
+ "<HTML><HEAD>" + HB_OSNewLine() + ;
+ "<TITLE>" + ::cTitle + "</TITLE>" + HB_OSNewLine() + ;
+ "<BODY link='" + ::cLinkColor + "' " + ;
+ "vlink='" + ::cvLinkColor + "'>" + + HB_OSNewLine() + ;
+ ::cBody + HB_OSNewLine() + ;
+ "</BODY></HTML>"
+ ELSE
+ ::cContent := ""
+
+ // Does cHTMLFile exists?
+ IF !File( ::cHTMLFile )
+ ::cContent := "<H1>Server Error</H1><P><I>No such file: " + ;
+ ::cHTMLFile
+ ELSE
+ // Read from file
+ hFile := fOpen( ::cHTMLFile, 0 )
+ cFile := space( IF_BUFFER )
+ DO WHILE (nPos := fRead( hFile, @cFile, IF_BUFFER )) > 0
+
+ cFile := left( cFile, nPos )
+ cRes += cFile
+ cFile := space( IF_BUFFER )
+
+ ENDDO
+
+ fClose( hFile )
+
+ // Replace matched tags
+ i := 1
+ ::cContent := cRes
+ /* TODO: Replace this DO WHILE with FOR..NEXT */
+ DO WHILE i <= len( ::aReplaceTags )
+ ::cContent := strtran( ::cContent, ;
+ "<#" + ::aReplaceTags[i, 1] + ">", ::aReplaceTags[i, 2] )
+ i++
+ ENDDO
+
+ /* TODO: Clear remaining (not matched) tags */
+ /*
+ cRes := ""
+ FOR i := 1 TO len( ::cContent )
+ IF substr( ::cContent, i, 1 ) == "<" .AND. ;
+ substr( ::cContent, i + 1, 1 ) == "#"
+ lFlag := .t.
+ ELSEIF substr( ::cContent, i, 1 ) == ">" .AND. lFlag
+ lFlag := .f.
+ ELSEIF !lFlag
+ cRes += substr( ::cContent, i, 1 )
+ ENDIF
+ NEXT i
+
+ ::cContent := cRes
+ */
+
+ ENDIF
+ ENDIF
+
+ RETURN( Self )
+
+STATIC FUNCTION ShowResult()
+
+ LOCAL Self := QSelf()
+
+ OutStd( ;
+ "HTTP/1.0 200 OK" + HB_OSNewLine() + ;
+ "CONTENT-TYPE: TEXT/HTML" + HB_OSNewLine() + HB_OSNewLine() + ;
+ ::cContent )
+
+ RETURN( Self )
+
+STATIC FUNCTION SaveToFile( cFile )
+
+ LOCAL Self := QSelf()
+ LOCAL hFile := fCreate( cFile )
+
+ fWrite( hFile, ::cContent )
+ fClose( hFile )
+
+ RETURN( Self )
+
+STATIC FUNCTION ProcessCGI()
+
+ LOCAL Self := QSelf()
+ LOCAL cQuery := ""
+ LOCAL cBuff := ""
+ LOCAL nBuff := 0
+ LOCAL i
+
+ IF empty( ::aCGIContents )
+ ::aCGIContents := { ;
+ GetEnv( "SERVER_SOFTWARE" ), ;
+ GetEnv( "SERVER_NAME" ), ;
+ GetEnv( "GATEWAY_INTERFACE" ), ;
+ GetEnv( "SERVER_PROTOCOL" ), ;
+ GetEnv( "SERVER_PORT" ), ;
+ GetEnv( "REQUEST_METHOD" ), ;
+ GetEnv( "HTTP_ACCEPT" ), ;
+ GetEnv( "HTTP_USER_AGENT" ), ;
+ GetEnv( "HTTP_REFERER" ), ;
+ GetEnv( "PATH_INFO" ), ;
+ GetEnv( "PATH_TRANSLATED" ), ;
+ GetEnv( "SCRIPT_NAME" ), ;
+ GetEnv( "QUERY_STRING" ), ;
+ GetEnv( "REMOTE_HOST" ), ;
+ GetEnv( "REMOTE_ADDR" ), ;
+ GetEnv( "REMOTE_USER" ), ;
+ GetEnv( "AUTH_TYPE" ), ;
+ GetEnv( "CONTENT_TYPE" ), ;
+ GetEnv( "CONTENT_LENGTH" ), ;
+ GetEnv( "ANNOTATION_SERVER" ) ;
+ }
+
+ cQuery := ::GetCGIParam( CGI_QUERY_STRING )
+
+ IF !empty( cQuery )
+
+ ::aQueryFields := {}
+
+ FOR i := 1 TO len( cQuery ) + 1
+
+ IF i > len( cQuery ) .OR. substr( cQuery, i, 1 ) == "&"
+
+ aadd( ::aQueryFields, ;
+ { substr( cBuff, 1, at( "=", cBuff ) - 1 ), ;
+ strtran( substr( cBuff, at( "=", cBuff ) + 1, ;
+ len( cBuff ) - at( "=", cBuff ) + 1 ), "+", " " ) } )
+ cBuff := ""
+ ELSE
+ IF substr( cQuery, i, 1 ) = "%"
+ cBuff += chr( Hex2Dec( substr( cQuery, i + 1, 2 ) ) )
+ nBuff := 3
+ ENDIF
+
+ IF nBuff = 0
+ cBuff += substr( cQuery, i, 1 )
+ ELSE
+ nBuff--
+ ENDIF
+ ENDIF
+
+ NEXT
+
+ ENDIF
+
+ ENDIF
+
+ RETURN( Self )
+
+STATIC FUNCTION GetCGIParam( nParam )
+
+ LOCAL Self := QSelf()
+
+ ::ProcessCGI()
+
+ IF nParam > 20 .OR. nParam < 1
+ outerr( "Invalid CGI parameter" )
+ RETURN( NIL )
+ ENDIF
+
+ RETURN( ::aCGIContents[nParam] )
+
+STATIC FUNCTION QueryFields( cQueryName )
+
+ LOCAL Self := QSelf()
+ LOCAL cRet := ""
+ LOCAL nRet
+
+ ::ProcessCGI()
+
+ nRet := aScan( ::aQueryFields, ;
+ {| x | upper( x[1] ) = upper( cQueryName ) } )
+
+ IF nRet > 0
+ cRet := ::aQueryFields[nRet, 2]
+ ENDIF
+
+ RETURN( cRet )
+
+STATIC FUNCTION SetHTMLFile( cFile )
+
+ LOCAL Self := QSelf()
+
+ ::cHTMLFile := cFile
+
+ RETURN( Self )
+
+STATIC FUNCTION AddReplaceTag( cTag, cReplaceText )
+
+ LOCAL Self := QSelf()
+
+ aAdd( ::aReplaceTags, { cTag, cReplaceText } )
+
+ RETURN( Self )
+
+