fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2012-01-27 20:52 UTC+0100 Viktor Szakats (harbour syenar.net)

Browse Source 
* contrib/hbplist
  * contrib/hbhttpd/core.prg
  * contrib/hbhttpd/hbhttpd.hbp
  * contrib/hbhttpd/hbhttpd.hbc
  + contrib/hbhttpd/hbhttpds.hbp
  + contrib/hbhttpd/hbhttpds.hbc
  * contrib/hbhttpd/widgets.prg
  * contrib/hbhttpd/hbhttpd.hbx
  - contrib/hbhttpd/tests/webapp.prg
  + contrib/hbhttpd/tests/eshop.prg
  * contrib/hbhttpd/tests/files/main.js
  + contrib/hbhttpd/tests/tpl
    + merged latest uhttpd changes (0.4) posted by Mindaugas on his
      website into hbhttpd. It implements these changes (quote):
    * strict scope for UHttpd class methods and variables
    * support for more HTTP status codes
    * added error handler for child processes
    ! fixed bug in HttpDateUnformat()
    * new server parameters setting approach implemented
    * more friendly UProcInfo() output format
    + client IP filtering
This commit is contained in:
Viktor Szakats
2012-01-27 19:58:14 +00:00
parent 401423620e
commit 8cf24d1ffd
21 changed files with 1794 additions and 1084 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
harbour/ChangeLog
View File

@@ -16,18 +16,41 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-01-27 20:52 UTC+0100 Viktor Szakats (harbour syenar.net)
* contrib/hbplist
* contrib/hbhttpd/core.prg
* contrib/hbhttpd/hbhttpd.hbp
* contrib/hbhttpd/hbhttpd.hbc
+ contrib/hbhttpd/hbhttpds.hbp
+ contrib/hbhttpd/hbhttpds.hbc
* contrib/hbhttpd/widgets.prg
* contrib/hbhttpd/hbhttpd.hbx
- contrib/hbhttpd/tests/webapp.prg
+ contrib/hbhttpd/tests/eshop.prg
* contrib/hbhttpd/tests/files/main.js
+ contrib/hbhttpd/tests/tpl
+ merged latest uhttpd changes (0.4) posted by Mindaugas on his
website into hbhttpd. It implements these changes (quote):
* strict scope for UHttpd class methods and variables
* support for more HTTP status codes
* added error handler for child processes
! fixed bug in HttpDateUnformat()
* new server parameters setting approach implemented
* more friendly UProcInfo() output format
+ client IP filtering
2012-01-27 18:25 UTC+0200 Mindaugas Kavaliauskas (dbtopas/at/dbtopas.lt)
* src/vm/hashes.c
* src/vm/hashfunc.c
+ implemented posibility to use hashes a sorted arays with binary search.
Implemented HB_BOOL hb_hashScanSoft( pHash, pKey, &nPos ). Function
Implemented HB_BOOL hb_hashScanSoft( pHash, pKey, &nPos ). Function
if similar to, but returns nPos even if pKey is not found in pHash.
Extended HB_HHASKEY( aHash, xKey [, @nPos ] ) --> lFound
Function optionaly returns position of the item with a largest key
smaller or equal to xKey. If xKey is less than all keys in hash,
zero position is returned. I.e.,
Function optionaly returns position of the item with a largest key
smaller or equal to xKey. If xKey is less than all keys in hash,
zero position is returned. I.e.,
aHash := {10=>, 20=>}
? HB_HHASKEY( aHash, 5, @nPos ), nPos // .F. 0
? HB_HHASKEY( aHash, 10, @nPos ), nPos // .T. 1

1631
harbour/contrib/hbhttpd/core.prg
View File

File diff suppressed because it is too large Load Diff

4
harbour/contrib/hbhttpd/hbhttpd.hbc
View File

@@ -4,6 +4,8 @@
incpaths=.
libs=${_HB_DYNPREF}${hb_name}${_HB_DYNSUFF}
{!HB_HTTPD_OPENSSL|dos}libs=${_HB_DYNPREF}${hb_name}${_HB_DYNSUFF}
{HB_HTTPD_OPENSSL&!dos}libs=${_HB_DYNPREF}${hb_name}s${_HB_DYNSUFF}
{HB_HTTPD_OPENSSL&!dos}libs=../hbssl/hbssl.hbc
mt=yes

4
harbour/contrib/hbhttpd/hbhttpd.hbp
View File

@@ -5,7 +5,7 @@
-hblib
-inc
-o${hb_name}
-o${hb_targetname}
-w3 -es2
@@ -16,3 +16,5 @@ hbhttpd.hbx
core.prg
widgets.prg
log.prg
hbssl.hbc

9
harbour/contrib/hbhttpd/hbhttpd.hbx
View File

@@ -32,18 +32,21 @@ DYNAMIC UHTMLENCODE
DYNAMIC UHTTPD
DYNAMIC UHTTPDLOG
DYNAMIC UHTTPDNEW
DYNAMIC UHTTPD_JOIN
DYNAMIC UHTTPD_SPLIT
DYNAMIC ULINK
DYNAMIC UOSFILENAME
DYNAMIC UPARSE
DYNAMIC UPROCFILES
DYNAMIC UPROCINFO
DYNAMIC UPROCWIDGETS
DYNAMIC UREDIRECT
DYNAMIC USESSIONDESTROY
DYNAMIC USESSIONSTART
DYNAMIC USESSIONSTOP
DYNAMIC USETSTATUSCODE
DYNAMIC UURLCHECKSUM
DYNAMIC UURLDECODE
DYNAMIC UURLENCODE
DYNAMIC UURLVALIDATE
DYNAMIC UWBROWSE
DYNAMIC UWBROWSENEW
DYNAMIC UWDEFAULTHANDLER
@@ -61,6 +64,8 @@ DYNAMIC UWMAIN
DYNAMIC UWMAINNEW
DYNAMIC UWMENU
DYNAMIC UWMENUNEW
DYNAMIC UWOPTION
DYNAMIC UWOPTIONNEW
DYNAMIC UWPASSWORD
DYNAMIC UWPASSWORDNEW
DYNAMIC UWRITE

11
harbour/contrib/hbhttpd/hbhttpds.hbc Normal file
View File

@@ -0,0 +1,11 @@
#
# $Id$
#
incpaths=.
libs=${_HB_DYNPREF}${hb_name}${_HB_DYNSUFF}
mt=yes
libs=../hbssl/hbssl.hbc

9
harbour/contrib/hbhttpd/hbhttpds.hbp Normal file
View File

@@ -0,0 +1,9 @@
#
# $Id$
#
@hbhttpd.hbp
../hbssl/hbssl.hbc
-DHB_HAS_OPENSSL

388
harbour/contrib/hbhttpd/tests/eshop.prg Normal file
View File

@@ -0,0 +1,388 @@
/*
* $Id$
*/
REQUEST DBFCDX
MEMVAR server, get, post, cookie, session
PROCEDURE Main()
LOCAL oServer
LOCAL oLogAccess
LOCAL oLogError
LOCAL nPort
IF HB_ARGCHECK( "help" )
? "Usage: app [options]"
? "Options:"
? " //help Print help"
? " //stop Stop running server"
RETURN
ENDIF
IF HB_ARGCHECK( "stop" )
HB_MEMOWRIT( ".uhttpd.stop", "" )
RETURN
ELSE
FErase( ".uhttpd.stop" )
ENDIF
rddSetDefault( "DBFCDX" )
SET( _SET_DATEFORMAT, "yyyy-mm-dd" )
IF ! HB_FILEEXISTS( "users.dbf" )
FErase( "users.cdx" )
dbCreate( "users", { { "USER", "C", 16, 0 }, { "PASSWORD", "C", 16, 0 }, { "NAME", "C", 50, 0 } }, , .T. , "user" )
dbAppend()
FIELD->USER := "demo"
FIELD->PASSWORD := "demo"
FIELD->NAME := "Demo"
OrdCreate( "users", "user", "USER" )
dbCloseArea()
ELSEIF ! HB_FILEEXISTS( "users.cdx" )
dbUseArea( .T. , , "users", , .F. , .F. )
OrdCreate( "users", "user", "USER" )
dbCloseArea()
ENDIF
IF ! HB_FILEEXISTS( "carts.dbf" )
FErase( "carts.cdx" )
dbCreate( "carts", { { "USER", "C", 16, 0 }, { "CODE", "C", 16, 0 }, { "AMOUNT", "N", 6, 0 }, { "TOTAL", "N", 9, 2 } }, , .T. , "cart" )
OrdCreate( "carts", "user", "USER+CODE" )
dbCloseArea()
ELSEIF ! HB_FILEEXISTS( "carts.cdx" )
dbUseArea( .T. , , "carts", , .F. , .F. )
OrdCreate( "carts", "user", "USER+CODE" )
dbCloseArea()
ENDIF
IF ! HB_FILEEXISTS( "items.dbf" )
FErase( "items.cdx" )
dbCreate( "items", { { "CODE", "C", 16, 0 }, { "TITLE", "C", 80, 0 }, { "PRICE", "N", 9, 2 } }, , .T. , "items" )
OrdCreate( "items", "code", "CODE" )
dbCloseArea()
ELSEIF ! HB_FILEEXISTS( "item.cdx" )
dbUseArea( .T. , , "items", , .F. , .F. )
OrdCreate( "items", "code", "CODE" )
dbCloseArea()
ENDIF
oLogAccess := UHttpdLog():New( "eshop_access.log" )
IF ! oLogAccess:Add( "" )
oLogAccess:Close()
? "Access log file open error " + hb_ntos( FError() )
RETURN
ENDIF
oLogError := UHttpdLog():New( "eshop_error.log" )
IF ! oLogError:Add( "" )
oLogError:Close()
oLogAccess:Close()
? "Error log file open error " + hb_ntos( FError() )
RETURN
ENDIF
? "Listening on port:", nPort := 8002
oLogError:Add( "hello" )
oServer := UHttpdNew()
IF ! oServer:Run( {;
"FirewallFilter" => "", ;
"LogAccess" => {| m | oLogAccess:Add( m + hb_eol() ) }, ;
"LogError" => {| m | oLogError:Add( m + hb_eol() ) }, ;
"Trace" => {| ... | QOut( ... ) }, ;
"Port" => nPort, ;
"Idle" => {| o | iif( HB_FILEEXISTS( ".uhttpd.stop" ), ( FErase(".uhttpd.stop" ), o:Stop() ), NIL ) }, ;
"Mount" => {;
"/hello" => {|| UWrite( "Hello!" ) }, ;
"/info" => {|| UProcInfo() }, ;
"/files/*" => {| x | QOUT( HB_DIRBASE() + "/files/" + X ), UProcFiles( HB_DIRBASE() + "/files/" + X, .F. ) }, ;
"/app/login" => @proc_login(), ;
"/app/logout" => @proc_logout(), ;
"/app/account" => @proc_account(), ;
"/app/account/edit" => @proc_account_edit(), ;
"/app/register" => @proc_register(), ;
"/app/main" => @proc_main(), ;
"/app/shopping" => @proc_shopping(), ;
"/app/cart" => @proc_cart(), ;
"/" => {|| URedirect( "/app/login" ) } } } )
oLogError:Close()
oLogAccess:Close()
? "Server error:", oServer:cError
ErrorLevel( 1 )
RETURN
ENDIF
oLogError:Close()
oLogAccess:Close()
RETURN
STATIC FUNCTION proc_login()
LOCAL cUser
IF server["REQUEST_METHOD"] == "POST"
dbUseArea( .T. , , "users", "users", .T. , .T. )
OrdSetFocus( "user" )
cUser := PadR( HB_HGetDef( post, "user", "" ), 16 )
USessionStart()
IF !Empty( cUser ) .AND. dbSeek( cUser, .F. ) .AND. ! Deleted() .AND. ;
PadR( HB_HGetDef( post, "password", "" ), 16 ) == FIELD->PASSWORD
session["user"] := cUser
URedirect( "main" )
ELSE
URedirect( "login?err" )
USessionDestroy()
ENDIF
dbCloseArea()
ELSE
IF HB_HHasKey( get, "err" )
RETURN { "errtext" => "Invalid user name or password!" }
ENDIF
RETURN { => }
ENDIF
RETURN NIL
STATIC FUNCTION proc_logout()
USessionStart()
USessionDestroy()
RETURN { => }
STATIC FUNCTION proc_main()
USessionStart()
IF ! HB_HHasKey( session, "user" )
URedirect( "/app/login" )
RETURN NIL
ENDIF
RETURN { => }
STATIC FUNCTION proc_shopping()
LOCAL oW, nT, cCode
USessionStart()
IF ! HB_HHasKey( session, "user" )
URedirect( "/app/login" )
RETURN NIL
ENDIF
dbUseArea( .T. , , "carts", "carts", .T. , .F. )
OrdSetFocus( "user" )
dbUseArea( .T. , , "items", "items", .T. , .T. )
OrdSetFocus( "code" )
IF HB_HHasKey( get, "add" )
cCode := PadR( get["add"], 16 )
IF items->( dbSeek( cCode ) ) .AND. carts->( FLock() )
IF ! carts->( dbSeek( session["user"] + cCode ) )
carts->( dbAppend() )
carts->USER := session["user"]
carts->CODE := cCode
ENDIF
carts->AMOUNT += 1
carts->TOTAL += items->PRICE
carts->( dbUnlock() )
ENDIF
URedirect( "shopping" )
RETURN NIL
ENDIF
dbSelectArea( "carts" )
ORDSCOPE( 0, session["user"] )
ORDSCOPE( 1, session["user"] )
nT := 0
carts->( dbEval( { || nT += FIELD->TOTAL } ) )
dbSelectArea( "items" )
oW := UWBrowseNew( "br_item" )
oW:AddColumn( 101, "Item No.", "CODE" )
oW:AddColumn( 102, "Title", "TITLE" )
oW:AddColumn( 103, "Price", "PRICE" )
oW:AddColumn( 104, "", { || ULink( "Add to cart", "?add=" + RTrim( FIELD->CODE ) ) }, .T. )
oW:nPageSize := 10
IF HB_HHasKey( get, "_pos" )
oW:nPos := Val( get["_pos"] )
ENDIF
RETURN { "browse" => oW:Output(), "cartsum" => nT }
STATIC FUNCTION proc_cart()
LOCAL oW, nT, cCode
USessionStart()
IF ! HB_HHasKey( session, "user" )
URedirect( "/app/login" )
RETURN NIL
ENDIF
dbUseArea( .T. , , "items", "items", .T. , .T. )
OrdSetFocus( "code" )
dbUseArea( .T. , , "carts", "carts", .T. , .F. )
OrdSetFocus( "user" )
IF HB_HHasKey( get, "del" )
cCode := PadR( get["del"], 16 )
IF items->( dbSeek( cCode ) ) .AND. carts->( FLock() )
IF carts->( dbSeek( session["user"] + cCode ) )
carts->( dbDelete() )
carts->USER := ""
carts->CODE := cCode
ENDIF
carts->( dbUnlock() )
ENDIF
URedirect( "cart" )
RETURN NIL
ENDIF
ORDSCOPE( 0, session["user"] )
ORDSCOPE( 1, session["user"] )
nT := 0
carts->( dbEval( { || nT += FIELD->TOTAL } ) )
oW := UWBrowseNew( "br_cart" )
oW:AddColumn( 101, "Item No.", "CODE" )
oW:AddColumn( 102, "Title", { || items->( dbSeek( carts->CODE, .F. ), FIELD->TITLE ) } )
oW:AddColumn( 103, "Amount", "AMOUNT" )
oW:AddColumn( 104, "Total", "TOTAL" )
oW:AddColumn( 104, "", { || ULink( "Delete", "?del=" + RTrim( FIELD->CODE ) ) }, .T. )
oW:nPageSize := 10
IF HB_HHasKey( get, "_pos" )
oW:nPos := Val( get["_pos"] )
ENDIF
RETURN { "browse" => oW:Output(), "cartsum" => nT }
STATIC FUNCTION proc_account()
USessionStart()
IF ! HB_HHasKey( session, "user" )
URedirect( "/app/login" )
RETURN NIL
ENDIF
dbUseArea( .T. , , "users", "users", .T. , .F. )
OrdSetFocus( "user" )
dbSeek( session["user"], .F. )
RETURN { "user" => users->USER, "name" => users->NAME }
STATIC FUNCTION proc_account_edit()
LOCAL cName, cPassword1, cPassword2, aRet
USessionStart()
IF ! HB_HHasKey( session, "user" )
URedirect( "/app/login" )
RETURN NIL
ENDIF
dbUseArea( .T. , , "users", "users", .T. , .F. )
OrdSetFocus( "user" )
dbSeek( session["user"], .F. )
cName := users->NAME
IF HB_HHasKey( session, "formdata_account/edit" )
cName := session["formdata_account/edit", "name"]
ENDIF
IF server["REQUEST_METHOD"] == "POST"
cName := HB_HGetDef( post, "name", "" )
cPassword1 := HB_HGetDef( post, "password1", "" )
cPassword2 := HB_HGetDef( post, "password2", "" )
IF Empty( cName )
session["formdata_account/edit"] := { "name" => cName }
URedirect( "?err=1" )
ELSEIF ( ! Empty( cPassword1 ) .OR. ! Empty( cPassword2 ) ) .AND. ! ( cPassword1 == cPassword2 )
session["formdata_account/edit"] := { "name" => cName }
URedirect( "?err=2" )
ELSE
FLock()
FIELD->NAME := cName
IF ! Empty( cPassword1 )
FIELD->PASSWORD := cPassword1
ENDIF
dbUnlock()
IF HB_HHasKey( session, "formdata_account/edit" )
HB_HDel( session, "formdata_account/edit" )
ENDIF
URedirect( "/app/account" )
ENDIF
RETURN NIL
ENDIF
aRet := { "user" => users->USER, "name" => cName }
IF HB_HHasKey( get, "err" )
IF get["err"] == "1"
aRet["errtext"] := "Name value should not be empty!"
ELSEIF get["err"] == "2"
aRet["errtext"] := "Passwords do not match!"
ENDIF
ENDIF
RETURN aRet
STATIC FUNCTION proc_register()
LOCAL cUser, cName, cPassword1, cPassword2, aRet
USessionStart()
cUser := ""
cName := ""
IF HB_HHasKey( session, "formdata_register" )
cUser := session["formdata_register", "user"]
cName := session["formdata_register", "name"]
ENDIF
IF server["REQUEST_METHOD"] == "POST"
dbUseArea( .T. , , "users", "users", .T. , .F. )
OrdSetFocus( "user" )
cUser := HB_HGetDef( post, "user", "" )
cName := HB_HGetDef( post, "name", "" )
cPassword1 := HB_HGetDef( post, "password1", "" )
cPassword2 := HB_HGetDef( post, "password2", "" )
IF Empty( cUser ) .OR. Empty( cName ) .OR. Empty( cPassword1 ) .OR. Empty( cPassword2 )
session["formdata_register"] := { "user" => cUser, "name" => cName }
URedirect( "?err=1" )
ELSEIF !( cPassword1 == cPassword2 )
session["formdata_register"] := { "user" => cUser, "name" => cName }
URedirect( "?err=2" )
ELSEIF dbSeek( cUser, .F. )
session["formdata_register"] := { "user" => cUser, "name" => cName }
URedirect( "?err=3" )
ELSE
FLock()
dbAppend()
FIELD->USER := cUser
FIELD->NAME := cName
FIELD->PASSWORD := cPassword1
dbUnlock()
USessionDestroy()
USessionStart()
session["user"] := cUser
URedirect( "/app/main" )
ENDIF
RETURN NIL
ENDIF
aRet := { "user" => cUser, "name" => cName }
IF HB_HHasKey( get, "err" )
IF get["err"] == "1"
aRet["errtext"] := "All fields are required!"
ELSEIF get["err"] == "2"
aRet["errtext"] := "Passwords does not match!"
ELSEIF get["err"] == "3"
aRet["errtext"] := "This user already exists!"
ENDIF
ENDIF
RETURN aRet

39
harbour/contrib/hbhttpd/tests/files/main.js
View File

@@ -1,39 +0,0 @@
function getXmlHttp()
{
var obj=null;
if( window.XMLHttpRequest )
{
obj = new XMLHttpRequest();
}
else if( window.ActiveXObject )
{
obj = new ActiveXObject("Microsoft.XMLHTTP");
}
if ( obj == null )
{
alert("Browser does not support HTTP Request");
}
return obj;
}
function ubrcall(id,param)
{
var tbl = document.getElementById(id);
var r = getXmlHttp();
r.open("GET", "?ajax=" + id + "&" + param, true);
r.onreadystatechange=function ()
{
if( r.readyState == 4 )
{
if( r.status == 200 )
{
tbl.innerHTML = r.responseText;
}
r = null;
}
}
r.send(null);
}

9
harbour/contrib/hbhttpd/tests/tpl/_main.tpl Normal file
View File

@@ -0,0 +1,9 @@
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1257" />
<link rel="stylesheet" type="text/css" href="/files/main.css" />
</head>
<body>
{{:}}
</body>
</html>

11
harbour/contrib/hbhttpd/tests/tpl/app/account.tpl Normal file
View File

@@ -0,0 +1,11 @@
{{extend _main}}
<a href="/app/shopping">Shopping</a> | <a href="/app/cart">Cart</a> | <a href="/app/logout">Logout</a>
<hr>
<H1>My account</H1>
{{if errtext}}<span style="color:red; font-weight:bold; border:2px solid red; padding:5px; background-color:#FCC;">{{= errtext}}</span><p>{{endif}}
<table>
<tr><td><b>User name</b></td><td>{{= user}}</td></tr>
<tr><td><b>Name</b></td><td>{{= name}}</td></tr>
</table>
<p>
<a href="/app/account/edit">Edit</a>

14
harbour/contrib/hbhttpd/tests/tpl/app/account/edit.tpl Normal file
View File

@@ -0,0 +1,14 @@
{{extend _main}}
<a href="/app/shopping">Shopping</a> | <a href="/app/cart">Cart</a> | <a href="/app/account">My account</a> | <a href="/app/logout">Logout</a>
<hr>
<H1>My account</H1>
{{if errtext}}<span style="color:red; font-weight:bold; border:2px solid red; padding:5px; background-color:#FCC;">{{= errtext}}</span><p>{{endif}}
<form method="post">
<table>
<tr><td>User name</td><td>{{= user}}</td></tr>
<tr><td>Name</td><td><input name="name" value="{{= name}}"></td></tr>
<tr><td>Password</td><td><input type="password" name="password1" value=""></td></tr>
<tr><td>Repeat password</td><td><input type="password" name="password2" value=""></td></tr>
<tr><td>&nbsp;</td><td><input type="submit" name="save" value="Save"></td></tr>
</table>
</form>

8
harbour/contrib/hbhttpd/tests/tpl/app/cart.tpl Normal file
View File

@@ -0,0 +1,8 @@
{{extend _main}}
<a href="/app/shopping">Shopping</a> | <a href="/app/account">My account</a> | <a href="/app/logout">Logout</a>
<hr>
<H1>Cart</H1>
Your cart is worth: {{= cartsum}}
<p>
{{: browse}}

12
harbour/contrib/hbhttpd/tests/tpl/app/login.tpl Normal file
View File

@@ -0,0 +1,12 @@
{{extend _main}}
<H1>Login</H1>
{{if errtext}}<span style="color:red; font-weight:bold; border:2px solid red; padding:5px; background-color:#FCC;">{{= errtext}}</span><p>{{endif}}
<form method="POST">
<table style="layoutgrid">
<tr><td>User</td><td><input type="text" name="user"></td></tr>
<tr><td>Password</td><td><input type="password" name="password"></td></tr>
<tr><td></td><td><input type="submit" name="login" value="Login"></td></tr>
</table>
</form>
<p>
<a href="/app/register">Create new account</a>

4
harbour/contrib/hbhttpd/tests/tpl/app/logout.tpl Normal file
View File

@@ -0,0 +1,4 @@
{{extend _main}}
<a href="/app/login">Login</a>
<hr>
Thank, You, for using uhttpd.

4
harbour/contrib/hbhttpd/tests/tpl/app/main.tpl Normal file
View File

@@ -0,0 +1,4 @@
{{extend _main}}
<a href="/app/shopping">Shopping</a> | <a href="/app/cart">Cart</a> | <a href="/app/account">My account</a> | <a href="/app/logout">Logout</a>
<hr>
You can do shopping, or edit your cart using menu links above

14
harbour/contrib/hbhttpd/tests/tpl/app/register.tpl Normal file
View File

@@ -0,0 +1,14 @@
{{extend _main}}
<a href="/app/login">Login</a>
<hr>
<H1>Create new account</H1>
{{if errtext}}<span style="color:red; font-weight:bold; border:2px solid red; padding:5px; background-color:#FCC;">{{= errtext}}</span><p>{{endif}}
<form method="post">
<table>
<tr><td>User name</td><td><input name="user" value="{{= user}}"></td></tr>
<tr><td>Name</td><td><input name="name" value="{{= name}}"></td></tr>
<tr><td>Password</td><td><input type="password" name="password1" value=""></td></tr>
<tr><td>Repeat password</td><td><input type="password" name="password2" value=""></td></tr>
<tr><td>&nbsp;</td><td><input type="submit" name="register" value="Create new account"></td></tr>
</table>
</form>

8
harbour/contrib/hbhttpd/tests/tpl/app/shopping.tpl Normal file
View File

@@ -0,0 +1,8 @@
{{extend _main}}
<a href="/app/cart">Cart</a> | <a href="/app/account">My account</a> | <a href="/app/logout">Logout</a>
<hr>
<H1>Shopping</H1>
Your cart is worth: {{= cartsum}}
<p>
{{: browse}}

453
harbour/contrib/hbhttpd/tests/webapp.prg
View File

@@ -1,453 +0,0 @@
/*
* $Id$
*/
REQUEST DBFCDX
MEMVAR server, get, post, cookie, session
PROCEDURE Main()
LOCAL oServer
LOCAL oLogAccess
LOCAL oLogError
LOCAL hMap
IF HB_ARGCHECK( "help" )
? "Usage: app [options]"
? "Options:"
? " //help Print help"
? " //stop Stop running server"
RETURN
ENDIF
IF HB_ARGCHECK( "stop" )
HB_MEMOWRIT( ".uhttpd.stop", "" )
RETURN
ELSE
FErase( ".uhttpd.stop" )
ENDIF
rddSetDefault( "DBFCDX" )
SET( _SET_DATEFORMAT, "yyyy-mm-dd" )
IF ! HB_FILEEXISTS( "users.dbf" )
FErase( "users.cdx" )
dbCreate( "users", { { "USER", "C", 16, 0 }, { "PASSWORD", "C", 16, 0 }, { "NAME", "C", 50, 0 } }, , .T. , "user" )
OrdCreate( "users", "user", "USER" )
dbCloseArea()
ELSEIF ! HB_FILEEXISTS( "users.cdx" )
dbUseArea( .T. , , "users", , .F. , .F. )
OrdCreate( "users", "user", "USER" )
dbCloseArea()
ENDIF
IF ! HB_FILEEXISTS( "carts.dbf" )
FErase( "carts.cdx" )
dbCreate( "carts", { { "USER", "C", 16, 0 }, { "CODE", "C", 16, 0 }, { "AMOUNT", "N", 6, 0 }, { "TOTAL", "N", 9, 2 } }, , .T. , "cart" )
OrdCreate( "carts", "user", "USER+CODE" )
dbCloseArea()
ELSEIF ! HB_FILEEXISTS( "carts.cdx" )
dbUseArea( .T. , , "carts", , .F. , .F. )
OrdCreate( "carts", "user", "USER+CODE" )
dbCloseArea()
ENDIF
IF ! HB_FILEEXISTS( "items.dbf" )
FErase( "items.cdx" )
dbCreate( "items", { { "CODE", "C", 16, 0 }, { "TITLE", "C", 80, 0 }, { "PRICE", "N", 9, 2 } }, , .T. , "items" )
OrdCreate( "items", "code", "CODE" )
dbCloseArea()
ELSEIF ! HB_FILEEXISTS( "item.cdx" )
dbUseArea( .T. , , "items", , .F. , .F. )
OrdCreate( "items", "code", "CODE" )
dbCloseArea()
ENDIF
oLogAccess := UHttpdLog():New( "webapp_access.log" )
IF ! oLogAccess:Add( "" )
oLogAccess:Close()
? "Access log file open error " + hb_ntos( FError() )
RETURN
ENDIF
oLogError := UHttpdLog():New( "webapp_error.log" )
IF ! oLogError:Add( "" )
oLogError:Close()
oLogAccess:Close()
? "Error log file open error " + hb_ntos( FError() )
RETURN
ENDIF
oServer := UHttpdNew()
oServer:bLogAccess := {| m | oLogAccess:Add( m + hb_eol() ) }
oServer:bLogError := {| m | oLogError:Add( m + hb_eol() ) }
oServer:bTrace := {| ... | QOut( ... ) }
oServer:nPort := 8002
oServer:bIdle := { |o| iif( HB_FILEEXISTS( ".uhttpd.stop" ), ( FErase(".uhttpd.stop" ), o:Stop() ), NIL ) }
hMap := {;
"login" => @proc_login(), ;
"logout" => @proc_logout(), ;
"register" => @proc_register(), ;
"account" => @proc_account(), ;
"account/edit" => @proc_account_edit(), ;
"main" => @proc_main(), ;
"shopping" => @proc_shopping(), ;
"cart" => @proc_cart() }
oServer:hMount := {;
"/hello" => { {|| UWrite( "Hello!" ) }, .F. }, ;
"/info" => { {|| UProcInfo() }, .F. }, ;
"/files/*" => { {|x| UProcFiles( hb_dirBase() + "files/" + x, .F. ) }, .F. }, ;
"/app/*" => { {|x| UProcWidgets( x, hMap ) }, .T. }, ;
"/*" => { {|| URedirect( "/app/login" ) }, .F. } }
? "Listening on port:", oServer:nPort
IF ! oServer:Run()
oLogError:Close()
oLogAccess:Close()
? "Server error:", oServer:cError
ErrorLevel( 1 )
RETURN
ENDIF
oLogError:Close()
oLogAccess:Close()
RETURN
STATIC FUNCTION proc_login( cMethod )
LOCAL cUser, oM, oF, oG
? ProcName(), cMethod
IF cMethod == "INIT"
oM := UWMainNew()
oM:Add( UWLabelNew( "", "errtxt", "color:red; font-weight:bold;" ) )
oM:Add( oF := UWFormNew( "" ) )
oF:Add( oG := UWLayoutGridNew() )
oG:Add( UWHtmlNew( "User" ), 1, 1 )
oG:Add( UWInputNew( "user" ), 1, 2 )
oG:Add( UWHtmlNew( "Password" ), 2, 1 )
oG:Add( UWPasswordNew( "password" ), 2, 2 )
oG:Add( UWSubmitNew( "submit", "Login" ), 3, 2 )
oM:Add( UWHtmlNew( ULink("Register", "register" ) ) )
ELSEIF cMethod == "POST"
dbUseArea( .T. , , "users", "users", .T. , .T. )
OrdSetFocus( "user" )
cUser := PadR( hb_HGetDef( post, "user", "" ), 16 )
IF !Empty( cUser ) .AND. dbSeek( cUser, .F. ) .AND. ! Deleted() .AND. ;
PadR( hb_HGetDef( post, "password", "" ), 16 ) == FIELD->PASSWORD
session[ "loggedin" ] := cUser
URedirect( "main" )
ELSE
URedirect( "login?err" )
USessionDestroy()
ENDIF
dbCloseArea()
ELSEIF cMethod == "GET"
IF HB_HHasKey( get, "err" )
UGetWidgetById( "errtxt" ):cText := "Invalid username or password!"
ENDIF
UWDefaultHandler( cMethod )
USessionDestroy()
ENDIF
RETURN .T.
STATIC FUNCTION proc_register( cMethod )
LOCAL cUser, cName, cPassword, cPassword2, oM, oF, oG
? ProcName(), cMethod
IF cMethod == "INIT"
oM := UWMainNew()
oM:Add( UWLabelNew( "", "errtxt", "color:red; font-weight:bold;" ) )
oM:Add( oF := UWFormNew( "" ) )
oF:Add( oG := UWLayoutGridNew() )
oG:Add( UWHtmlNew( "User name" ), 1, 1 )
oG:Add( UWInputNew( "user",, "user" ), 1, 2 )
oG:Add( UWHtmlNew( "Name" ), 2, 1 )
oG:Add( UWInputNew( "name",, "name" ), 2, 2 )
oG:Add( UWHtmlNew( "Password" ), 3, 1 )
oG:Add( UWPasswordNew( "password" ), 3, 2 )
oG:Add( UWHtmlNew( "Password again" ), 4, 1 )
oG:Add( UWPasswordNew( "password2" ), 4, 2 )
oG:Add( UWSubmitNew( "register", "Register" ), 5, 2 )
ELSEIF cMethod == "POST"
dbUseArea( .T. , , "users", "users", .T. , .F. )
OrdSetFocus( "user" )
cUser := hb_HGetDef( post, "user", "" )
cName := hb_HGetDef( post, "name", "" )
cPassword := hb_HGetDef( post, "password", "" )
cPassword2 := hb_HGetDef( post, "password2", "" )
UGetWidgetById( "user" ):cValue := cUser
UGetWidgetById( "name" ):cValue := cName
IF Empty( cUser ) .OR. Empty( cName ) .OR. Empty( cPassword ) .OR. Empty( cPassword2 )
URedirect( "?err=1" )
ELSEIF !( cPassword == cPassword2 )
URedirect( "?err=2" )
ELSEIF dbSeek( cUser, .F. )
URedirect( "?err=3" )
ELSE
FLock()
dbAppend()
FIELD->USER := cUser
FIELD->NAME := cName
FIELD->PASSWORD := cPassword
dbUnlock()
session[ "loggedin" ] := cUser
URedirect( "main" )
ENDIF
dbCloseArea()
ELSEIF cMethod == "GET"
IF HB_HHasKey( get, "err" )
IF get[ "err" ] == "1"
UGetWidgetById( "errtxt" ):cText := "All fields are required!"
ELSEIF get[ "err" ] == "2"
UGetWidgetById( "errtxt" ):cText := "Passwords does not match!"
ELSEIF get[ "err" ] == "3"
UGetWidgetById( "errtxt" ):cText := "This user already exists!"
ENDIF
ENDIF
UWDefaultHandler( cMethod )
ENDIF
RETURN .T.
STATIC FUNCTION proc_account( cMethod )
LOCAL oM, oG
? ProcName(), cMethod
IF cMethod == "INIT"
IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
ENDIF
dbUseArea( .T. , , "users", "users", .T. , .F. )
OrdSetFocus( "user" )
ELSEIF cMethod == "GET"
dbSeek( session[ "loggedin" ], .F. )
/* Create object here because user name can be changed in account/edit */
oM := UWMainNew()
oM:Add( UWMenuNew():AddItem( "Shopping", "shopping" ):AddItem( "Cart", "cart" ):AddItem( "Logout", "logout" ) )
oM:Add( UWSeparatorNew() )
oM:Add( oG := UWLayoutGridNew() )
oG:Add( UWHtmlNew( "User name:" ), 1, 1 )
oG:Add( UWHtmlNew( session[ "loggedin" ] ), 1, 2 )
oG:Add( UWHtmlNew( "Name:" ), 2, 1 )
oG:Add( UWHtmlNew( FIELD->NAME ), 2, 2 )
oM:Add( UWHtmlNew( ULink("Edit", "account/edit" ) ) )
UWDefaultHandler( cMethod )
ELSEIF cMethod == "EXIT"
users->( dbCloseArea() )
ENDIF
RETURN .T.
STATIC FUNCTION proc_account_edit( cMethod )
LOCAL cName, cPassword, cPassword2, oM, oG, oF
? ProcName(), cMethod
IF cMethod == "INIT"
IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
ENDIF
dbSeek( session[ "loggedin" ], .F. )
oM := UWMainNew()
oM:Add( UWLabelNew( "", "errtxt", "color:red; font-weight:bold;" ) )
oM:Add( oF := UWFormNew( "" ) )
oF:Add( oG := UWLayoutGridNew() )
oG:Add( UWHtmlNew( "User name" ), 1, 1 )
oG:Add( UWHtmlNew( session[ "loggedin" ] ), 1, 2 )
oG:Add( UWHtmlNew( "Name" ), 2, 1 )
oG:Add( UWInputNew( "name", RTrim( FIELD->NAME ), "name" ), 2, 2 )
oG:Add( UWHtmlNew( "Password" ), 3, 1 )
oG:Add( UWPasswordNew( "password" ), 3, 2 )
oG:Add( UWHtmlNew( "Password again" ), 4, 1 )
oG:Add( UWPasswordNew( "password2" ), 4, 2 )
oG:Add( UWSubmitNew( "save", "Save" ), 5, 2 )
ELSEIF cMethod == "POST"
dbSeek( session[ "loggedin" ], .F. )
cName := hb_HGetDef( post, "name", "" )
cPassword := hb_HGetDef( post, "password", "" )
cPassword2 := hb_HGetDef( post, "password2", "" )
UGetWidgetById( "name" ):cValue := RTrim( cName )
IF Empty( cName )
URedirect( "?err=1" )
ELSEIF ( ! Empty( cPassword ) .OR. ! Empty( cPassword2 ) ) .AND. ! ( cPassword == cPassword2 )
URedirect( "?err=2" )
ELSE
FLock()
FIELD->NAME := cName
QOut( "PO DBAPPEND", Alias(), RecNo(), cName )
IF ! Empty( cPassword )
FIELD->PASSWORD := cPassword
ENDIF
dbUnlock()
URedirect( "../account" )
ENDIF
ELSEIF cMethod == "GET"
IF HB_HHasKey( get, "err" )
IF get[ "err" ] == "1"
UGetWidgetById( "errtxt" ):cText := "All fields are required!"
ELSEIF get[ "err" ] == "2"
UGetWidgetById( "errtxt" ):cText := "Passwords do not match!"
ENDIF
ENDIF
UWDefaultHandler( cMethod )
ELSEIF cMethod == "EXIT"
ENDIF
RETURN .T.
STATIC FUNCTION proc_main( cMethod )
LOCAL oM
? ProcName(), cMethod
IF cMethod == "INIT"
IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
ENDIF
oM := UWMainNew()
oM:Add( UWMenuNew():AddItem( "Shopping", "shopping" );
:AddItem( "Cart", "cart" );
:AddItem( "My account", "account" );
:AddItem( "Logout", "logout" ) )
oM:Add( UWSeparatorNew() )
oM:Add( UWLabelNew( "You can do shopping, or edit your cart using menu links above" ) )
ELSEIF cMethod == "GET"
UWDefaultHandler( cMethod )
ENDIF
RETURN .T.
STATIC FUNCTION proc_shopping( cMethod )
LOCAL oM, oW, nT, cCode
? ProcName(), cMethod
IF cMethod == "INIT"
IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
ENDIF
oM := UWMainNew()
oM:Add( UWMenuNew():AddItem( "Cart", "cart" ):AddItem( "My account", "account" ):AddItem( "Logout", "logout" ) )
oM:Add( UWSeparatorNew() )
oM:Add( UWLabelNew( "", "cartsum" ) )
dbUseArea( .T. , , "carts", "carts", .T. , .F. )
OrdSetFocus( "user" )
ORDSCOPE( 0, session[ "loggedin" ] )
ORDSCOPE( 1, session[ "loggedin" ] )
dbUseArea( .T. , , "items", "items", .T. , .T. )
OrdSetFocus( "code" )
oW := UWBrowseNew( "1" )
oW:AddColumn( 101, "Item No.", "CODE" )
oW:AddColumn( 102, "Title", "TITLE" )
oW:AddColumn( 103, "Price", "PRICE" )
oW:AddColumn( 104, "", {|| ULink( "Add to cart", "?add=" + RTrim( FIELD->CODE ) ) }, .T. )
oM:Add( oW )
ELSEIF cMethod == "GET"
IF HB_HHasKey( get, "add" )
cCode := PadR( get[ "add" ], 16 )
IF items->( dbSeek( cCode ) ) .AND. carts->( FLock() )
IF ! carts->( dbSeek( session[ "loggedin" ] + cCode ) )
carts->( dbAppend() )
carts->USER := session[ "loggedin" ]
carts->CODE := cCode
ENDIF
carts->AMOUNT += 1
carts->TOTAL += items->PRICE
carts->( dbUnlock() )
ENDIF
URedirect( "shopping" )
RETURN .T.
ENDIF
nT := 0
carts->( dbEval( {|| nT += FIELD->TOTAL } ) )
UGetWidgetById( "cartsum" ):cText := "Your cart is worth: " + hb_ntos( nT )
UWDefaultHandler( cMethod )
ELSEIF cMethod == "EXIT"
items->( dbCloseArea() )
carts->( dbCloseArea() )
ENDIF
RETURN .T.
STATIC FUNCTION proc_cart( cMethod )
LOCAL oM, oW, nT, cCode
? ProcName(), cMethod
IF cMethod == "INIT"
IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
ENDIF
oM := UWMainNew()
oM:Add( UWMenuNew():AddItem( "Shopping", "shopping" ):AddItem( "My account", "account" ):AddItem( "Logout", "logout" ) )
oM:Add( UWSeparatorNew() )
oM:Add( UWLabelNew( "", "cartsum" ) )
dbUseArea( .T. , , "items", "items", .T. , .T. )
OrdSetFocus( "code" )
dbUseArea( .T. , , "carts", "carts", .T. , .F. )
OrdSetFocus( "user" )
ORDSCOPE( 0, session[ "loggedin" ] )
ORDSCOPE( 1, session[ "loggedin" ] )
oW := UWBrowseNew( "1" )
oW:AddColumn( 101, "Item No.", "CODE" )
oW:AddColumn( 102, "Title", {|| items->( dbSeek(carts->CODE, .F. ), FIELD->TITLE ) } )
oW:AddColumn( 103, "Amount", "AMOUNT" )
oW:AddColumn( 104, "Total", "TOTAL" )
oW:AddColumn( 104, "", {|| ULink( "Delete", "?del=" + RTrim( FIELD->CODE ) ) }, .T. )
oM:Add( oW )
ELSEIF cMethod == "GET"
IF HB_HHasKey( get, "del" )
cCode := PadR( get[ "del" ], 16 )
IF items->( dbSeek( cCode ) ) .AND. carts->( FLock() )
IF carts->( dbSeek( session[ "loggedin" ] + cCode ) )
carts->( dbDelete() )
carts->USER := ""
carts->CODE := cCode
ENDIF
carts->( dbUnlock() )
ENDIF
URedirect( "cart" )
RETURN .T.
ENDIF
nT := 0
carts->( dbEval( {|| nT += FIELD->TOTAL } ) )
UGetWidgetById( "cartsum" ):cText := "Your cart is worth: " + hb_ntos( nT )
UWDefaultHandler( cMethod )
ELSEIF cMethod == "EXIT"
items->( dbCloseArea() )
carts->( dbCloseArea() )
ENDIF
RETURN .T.
STATIC FUNCTION proc_logout( cMethod )
LOCAL oM
? ProcName(), cMethod
IF cMethod == "INIT"
IF ! HB_HHasKey( session, "loggedin" ); URedirect( "/app/login" ); RETURN .F.
ENDIF
oM := UWMainNew()
oM:Add( UWMenuNew():AddItem( "Login", "login" ) )
oM:Add( UWSeparatorNew() )
oM:Add( UWLabelNew( "Your session is ended." ) )
ELSEIF cMethod == "GET"
UWDefaultHandler( cMethod )
USessionDestroy()
ENDIF
RETURN .T.

214
harbour/contrib/hbhttpd/widgets.prg
View File

@@ -336,29 +336,19 @@ METHOD Paint() CLASS UWMenu
CREATE CLASS UWBrowse
VAR cID
VAR aColumns INIT {}
VAR nArea
VAR nRecno
VAR lBof INIT .F.
VAR lEof INIT .F.
VAR nPageSize INIT 0
VAR nPos INIT 0
METHOD AddColumn( nID, cTitle, cField, lRaw )
METHOD Paint()
METHOD PaintBody()
METHOD Ajax( cAction )
METHOD Skipper( nSkip )
METHOD Output()
ENDCLASS
FUNCTION UWBrowseNew( cID )
FUNC UWBrowseNew()
LOCAL oW := UWBrowse()
SetWId( oW, cID )
oW:nArea := Select()
RETURN oW
METHOD AddColumn( nID, cTitle, cField, lRaw ) CLASS UWBrowse
@@ -367,56 +357,29 @@ METHOD AddColumn( nID, cTitle, cField, lRaw ) CLASS UWBrowse
RETURN Self
METHOD Paint() CLASS UWBrowse
METHOD Output() CLASS UWBrowse
UWrite( '<div id="' + Self:cID + '">' )
Self:PaintBody()
UWrite( '</div>' )
LOCAL cRet := "", nI, xI, xField, nPos, cUrl, cI, lValidate
RETURN Self
METHOD PaintBody() CLASS UWBrowse
LOCAL nI, nJ, xI, xField, nArea
nArea := Select()
dbSelectArea( Self:nArea )
IF Self:nRecNo == NIL
DBGOTOP()
Self:nRecno := RecNo()
Self:Skipper( 0 )
ELSE
dbGoto( Self:nRecno )
Self:Skipper( 0 )
Self:nRecno := RecNo()
ENDIF
IF ! Self:lBof
UWrite( '<a href="" onclick="ubrcall(' + "'" + Self:cID + "','action=prevpg');return false;" + '">&lt;</a> ' )
ELSE
UWrite( '&lt; ' )
ENDIF
IF ! Self:lEof
UWrite( '<a href="" onclick="ubrcall(' + "'" + Self:cID + "','action=nextpg');return false;" + '">&gt;</a> ' )
ELSE
UWrite( '&gt; ' )
ENDIF
UWrite( '<table class="ubr"><tr>' )
cRet += '<table class="ubr"><tr>'
// Header
UWrite( '<tr>' )
cRet += '<tr>'
FOR nI := 1 TO Len( Self:aColumns )
UWrite( '<th>' + UHtmlEncode( Self:aColumns[nI, 2] ) + '</th>' )
cRet += '<th>' + UHtmlEncode( Self:aColumns[nI, 2] ) + '</th>'
NEXT
UWrite( '</tr>' )
cRet += '</tr>'
// Body
dbGoto( Self:nRecno )
FOR nI := 1 TO 20
IF Eof(); EXIT
ENDIF
UWrite( '<tr>' )
FOR nJ := 1 TO Len( Self:aColumns )
xField := Self:aColumns[nJ, 3]
nPos := 0
DBGOTOP()
IF Self:nPageSize > 0 .AND. Self:nPos > 0
dbSkip( Self:nPos )
ENDIF
DO WHILE ! Eof()
cRet += '<tr>'
FOR nI := 1 TO Len( Self:aColumns )
xField := Self:aColumns[nI, 3]
IF ValType( xField ) == "C"
xI := FieldGet( FieldPos( xField ) )
ELSEIF ValType( xField ) == "B"
@@ -427,59 +390,77 @@ METHOD PaintBody() CLASS UWBrowse
ELSEIF ValType( xI ) == "D"; xI := DToC( xI )
ELSE ; xI := "VALTYPE()==" + ValType( xI )
ENDIF
IF ! Self:aColumns[nJ, 4]
IF ! Self:aColumns[nI, 4]
xI := UHtmlEncode( xI )
ENDIF
UWrite( '<td><nobr>' + xI + '</nobr></td>' )
cRet += '<td><nobr>' + xI + '</nobr></td>'
NEXT
UWrite( '</tr>' )
cRet += '</tr>'
dbSkip()
NEXT
UWrite( '</table>' )
dbSelectArea( nArea )
RETURN Self
METHOD Ajax( cAction ) CLASS UWBrowse
IF cAction == "nextpg"
( Self:nArea ) -> ( Self:Skipper( 20 ) )
ELSEIF cAction == "prevpg"
( Self:nArea ) -> ( Self:Skipper( - 20 ) )
ENDIF
Self:PaintBody()
RETURN Self
METHOD Skipper( nSkip ) CLASS UWBrowse
dbGoto( Self:nRecno )
dbSkip( nSkip )
Self:nRecno := RecNo()
IF Eof()
dbSkip( - 1 )
Self:nRecno := RecNo()
Self:lEof := Eof()
ELSE
dbSkip( 20 )
Self:lEof := Eof()
ENDIF
dbGoto( Self:nRecno )
IF Bof()
Self:lBof := .T.
ELSE
dbSkip( - 1 )
IF Bof()
Self:lBof := .T.
ELSE
dbSkip( 1 )
Self:lBof := .F.
IF ++ nPos >= Self:nPageSize
EXIT
ENDIF
ENDDO
cRet += '</table>'
IF ! Eof() .OR. Self:nPos > 0
cUrl := server["REQUEST_URI"]
IF ( nI := At( "?_ucs=", cUrl ) ) == 0
nI := At( "&_ucs=", cUrl )
ENDIF
IF ( lValidate := nI > 0 )
cUrl := Left( cUrl, nI - 1 )
ENDIF
IF ( nI := At( "?_pos=", cUrl ) ) == 0
nI := At( "&_pos=", cUrl )
ENDIF
IF nI > 0
cUrl := Left( cUrl, nI - 1 )
ENDIF
cUrl += iif( "?" $ cUrl, "&", "?" ) + "_pos="
cRet := '<br>' + cRet
IF ! Eof()
cI := cUrl + hb_ntos( Self:nPos + Self:nPageSize )
cRet := '<a href="' + iif( lValidate, UUrlChecksum( cI ), cI ) + '">&gt;&gt;</a>' + cRet
ENDIF
IF Self:nPos > 0
cI := cUrl + hb_ntos( Max( 0, Self:nPos - Self:nPageSize ) )
cRet := '<a href="' + iif( lValidate, UUrlChecksum( cI ), cI ) + '">&lt;&lt;</a>&nbsp;&nbsp;' + cRet
ENDIF
ENDIF
Self:nRecno := RecNo()
RETURN cRet
//============================================================
CREATE CLASS UWOption
VAR aOption INIT {}
VAR cValue
METHOD Add( cTitle, cCode, lRaw )
METHOD Output()
ENDCLASS
FUNC UWOptionNew()
LOCAL oW := UWOption()
RETURN oW
METHOD Add( cTitle, cCode, lRaw ) CLASS UWOption
AAdd( Self:aOption, { iif( ! Empty(lRaw ), cTitle, UHtmlEncode(cTitle ) ), cCode } )
RETURN Self
METHOD Output() CLASS UWOption
LOCAL cRet := ""
AEval( Self:aOption, {| X | cRet += HB_STRFORMAT( '<option value="%s"%s>%s</option>', UHtmlEncode(X[2] ), iif(X[2] == Self:cValue, " selected", "" ), X[1] ) } )
RETURN cRet
/********************************************************************
*
@@ -583,3 +564,36 @@ STATIC PROCEDURE SetWId( oW, cID )
FUNCTION UGetWidgetById( cID )
RETURN hb_HGetDef( session[ "_uthis", "idhash" ], cID )
STATIC FUNCTION uhttpd_split( cSeparator, cString )
LOCAL aRet := {}
LOCAL nI
DO WHILE ( nI := At( cSeparator, cString ) ) > 0
AAdd( aRet, Left( cString, nI - 1 ) )
cString := SubStr( cString, nI + Len( cSeparator ) )
ENDDO
AAdd( aRet, cString )
RETURN aRet
STATIC FUNCTION uhttpd_join( cSeparator, aData )
LOCAL cRet := ""
LOCAL nI
FOR nI := 1 TO Len( aData )
IF nI > 1
cRet += cSeparator
ENDIF
IF ValType( aData[ nI ] ) $ "CM" ; cRet += aData[ nI ]
ELSEIF ValType( aData[ nI ] ) == "N" ; cRet += hb_ntos( aData[ nI ] )
ELSEIF ValType( aData[ nI ] ) == "D" ; cRet += iif( Empty( aData[ nI ] ), "", DToC( aData[ nI ] ) )
ELSE
ENDIF
NEXT
RETURN cRet

1
harbour/contrib/hbplist
View File

@@ -24,6 +24,7 @@ hbgs/hbgs.hbp
hbgt/hbgt.hbp
hbhpdf/hbhpdf.hbp # uses: libhpdf (locally hosted)
hbhttpd/hbhttpd.hbp
hbhttpd/hbhttpds.hbp
hbide/hbide.hbp
hblzf/hblzf.hbp # uses: liblzf (locally hosted)
hbmagic/hbmagic.hbp