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

2010-11-24 01:09 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* examples/uhttpd2/uhttpd2.hbp
    * Converted uhttpd2 core to a lib.

  + examples/uhttpd2/uhttpd2.hbc
    + Added .hbc file.

  * examples/uhttpd2/umain.prg
  * examples/uhttpd2/uwidgets.prg
  * examples/uhttpd2/uhbext.prg
  * examples/uhttpd2/app.prg
    * Formatted (with hbformat for the most part)
    * Minor cleanups.
    ! Fixed all -w3 warnings.

  + examples/uhttpd2/tests
  + examples/uhttpd2/tests/hbmk.hbm
  - examples/uhttpd2/carts.dbf
  - examples/uhttpd2/items.dbf
  - examples/uhttpd2/users.dbf
  + examples/uhttpd2/tests/carts.dbf
  + examples/uhttpd2/tests/items.dbf
  + examples/uhttpd2/tests/users.dbf
  - examples/uhttpd2/files
  + examples/uhttpd2/tests/files
  - examples/uhttpd2/app.prg
  + examples/uhttpd2/tests/webapp.prg
    + Added tests dir and moved app specific files there.
This commit is contained in:
Viktor Szakats
2010-11-24 00:09:54 +00:00
parent cad91155f3
commit afa82f20e1
14 changed files with 1810 additions and 1635 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
harbour/ChangeLog
View File

@@ -16,6 +16,35 @@
The license applies to all entries newer than 2009-04-28.
*/
2010-11-24 01:09 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* examples/uhttpd2/uhttpd2.hbp
* Converted uhttpd2 core to a lib.
+ examples/uhttpd2/uhttpd2.hbc
+ Added .hbc file.
* examples/uhttpd2/umain.prg
* examples/uhttpd2/uwidgets.prg
* examples/uhttpd2/uhbext.prg
* examples/uhttpd2/app.prg
* Formatted (with hbformat for the most part)
* Minor cleanups.
! Fixed all -w3 warnings.
+ examples/uhttpd2/tests
+ examples/uhttpd2/tests/hbmk.hbm
- examples/uhttpd2/carts.dbf
- examples/uhttpd2/items.dbf
- examples/uhttpd2/users.dbf
+ examples/uhttpd2/tests/carts.dbf
+ examples/uhttpd2/tests/items.dbf
+ examples/uhttpd2/tests/users.dbf
- examples/uhttpd2/files
+ examples/uhttpd2/tests/files
- examples/uhttpd2/app.prg
+ examples/uhttpd2/tests/webapp.prg
+ Added tests dir and moved app specific files there.
2010-11-23 23:58 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
+ contrib/hbposix/tests
+ contrib/hbposix/tests/hbmk.hbm

413
harbour/examples/uhttpd2/app.prg
View File

@@ -1,413 +0,0 @@
/*
* $Id$
*/
#include "hbclass.ch"
#include "common.ch"
#include "fileio.ch"
#define CR_LF (CHR(13)+CHR(10))
REQUEST DBFCDX
MEMVAR server, get, post, cookie, session
STATIC s_aMap
FIELD USER, NAME, PASSWORD, CODE, PRICE, TOTAL, TITLE
FUNC main()
LOCAL oServer
IF HB_ARGCHECK("help")
? "Usage: app [options]"
? "Options:"
? " //help Print help"
? " //stop Stop running server"
RETURN 0
ENDIF
IF HB_ARGCHECK("stop")
HB_MEMOWRIT(".uhttpd.stop", "")
RETURN 0
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
oServer := UHttpdNew()
oServer:nPort := 8002
oServer:bIdle := {|o| IIF(HB_FILEEXISTS(".uhttpd.stop"), (FERASE(".uhttpd.stop"), o:Stop()), NIL)}
s_aMap := {"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:aMount := ;
{"/hello" => {{|| UWrite("Hello!")}, .F.}, ;
"/info" => {{|| UProcInfo()}, .F.}, ;
"/files/*"=> {{|x| UProcFiles( hb_dirBase() + "files/" + X, .F.)}, .F.}, ;
"/app/*" => {{|x| UProcWidgets(x, s_aMap)}, .T.}, ;
"/*" => {{|| URedirect("/app/login")}, .F.}}
? "Listening on port:", oServer:nPort
IF ! oServer:Run()
? "Server error:", oServer:cError
RETURN 1
ENDIF
RETURN 0
STATIC FUNC 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")
GetWidgetById("errtxt"):cText := "Invalid username or password!"
ENDIF
UWDefaultHandler(cMethod)
USessionDestroy()
ENDIF
RETURN .T.
STATIC FUNC 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", "")
GetWidgetById("user"):cValue := cUser
GetWidgetById("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()
USER := cUser
NAME := cName
PASSWORD := cPassword
DBUNLOCK()
session["loggedin"] := cUser
URedirect("main")
ENDIF
DBCLOSEAREA()
ELSEIF cMethod == "GET"
IF HB_HHasKey(get, "err")
IF get["err"] == "1"
GetWidgetById("errtxt"):cText := "All fields are required!"
ELSEIF get["err"] == "2"
GetWidgetById("errtxt"):cText := "Passwords does not match!"
ELSEIF get["err"] == "3"
GetWidgetById("errtxt"):cText := "This user already exists!"
ENDIF
ENDIF
UWDefaultHandler(cMethod)
ENDIF
RETURN .T.
STATIC FUNC proc_account(cMethod)
LOCAL cUser, cName, 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(NAME), 2, 2 )
oM:Add( UWHtmlNew(ULink("Edit", "account/edit")) )
UWDefaultHandler(cMethod)
ELSEIF cMethod == "EXIT"
users->(DBCLOSEAREA())
ENDIF
RETURN .T.
STATIC FUNC 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", TRIM(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", "")
GetWidgetById("name"):cValue := TRIM(cName)
IF EMPTY(cName)
URedirect("?err=1")
ELSEIF (! EMPTY(cPassword) .OR. ! EMPTY(cPassword2)) .AND. ! (cPassword == cPassword2)
URedirect("?err=2")
ELSE
FLOCK()
NAME := cName
QOUT("PO DBAPPEND", ALIAS(), RECNO(), cName)
IF ! EMPTY(cPassword)
PASSWORD := cPassword
ENDIF
DBUNLOCK()
URedirect("../account")
ENDIF
ELSEIF cMethod == "GET"
IF HB_HHasKey(get, "err")
IF get["err"] == "1"
GetWidgetById("errtxt"):cText := "All fields are required!"
ELSEIF get["err"] == "2"
GetWidgetById("errtxt"):cText := "Passwords does not match!"
ENDIF
ENDIF
UWDefaultHandler(cMethod)
ELSEIF cMethod == "EXIT"
ENDIF
RETURN .T.
STATIC FUNC 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 FUNC 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=" + TRIM(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 += TOTAL}))
GetWidgetById("cartsum"):cText := "Your cart is worth: " + LTRIM(STR(nT))
UWDefaultHandler(cMethod)
ELSEIF cMethod == "EXIT"
items->(DBCLOSEAREA())
carts->(DBCLOSEAREA())
ENDIF
RETURN .T.
STATIC FUNC 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.), TITLE)})
oW:AddColumn(103, "Amount", "AMOUNT")
oW:AddColumn(104, "Total", "TOTAL")
oW:AddColumn(104, "", {|| ULink("Delete", "?del=" + TRIM(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 += TOTAL}))
GetWidgetById("cartsum"):cText := "Your cart is worth: " + LTRIM(STR(nT))
UWDefaultHandler(cMethod)
ELSEIF cMethod == "EXIT"
items->(DBCLOSEAREA())
carts->(DBCLOSEAREA())
ENDIF
RETURN .T.
STATIC FUNC 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.

0
harbour/examples/uhttpd2/carts.dbf → harbour/examples/uhttpd2/tests/carts.dbf
View File

0
harbour/examples/uhttpd2/files/main.css → harbour/examples/uhttpd2/tests/files/main.css
View File

0
harbour/examples/uhttpd2/files/main.js → harbour/examples/uhttpd2/tests/files/main.js
View File

7
harbour/examples/uhttpd2/tests/hbmk.hbm Normal file
View File

@@ -0,0 +1,7 @@
#
# $Id$
#
../uhttpd2.hbc
-w3 -es2

0
harbour/examples/uhttpd2/items.dbf → harbour/examples/uhttpd2/tests/items.dbf
View File

0
harbour/examples/uhttpd2/users.dbf → harbour/examples/uhttpd2/tests/users.dbf
View File

431
harbour/examples/uhttpd2/tests/webapp.prg Normal file
View File

@@ -0,0 +1,431 @@
/*
* $Id$
*/
#include "hbclass.ch"
#include "common.ch"
#include "fileio.ch"
#define CR_LF (CHR(13)+CHR(10))
REQUEST DBFCDX
MEMVAR server, get, post, cookie, session
STATIC s_aMap
FIELD USER, NAME, PASSWORD, CODE, PRICE, TOTAL, TITLE
FUNCTION Main()
LOCAL oServer
IF HB_ARGCHECK( "help" )
? "Usage: app [options]"
? "Options:"
? " //help Print help"
? " //stop Stop running server"
RETURN 0
ENDIF
IF HB_ARGCHECK( "stop" )
HB_MEMOWRIT( ".uhttpd.stop", "" )
RETURN 0
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
oServer := UHttpdNew()
oServer:nPort := 8002
oServer:bIdle := { |o| iif( HB_FILEEXISTS( ".uhttpd.stop" ), ( FErase(".uhttpd.stop" ), o:Stop() ), NIL ) }
s_aMap := {;
"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:aMount := {;
"/hello" => { {|| UWrite( "Hello!")}, .F. }, ;
"/info" => { {|| UProcInfo() }, .F. }, ;
"/files/*" => { {|x| UProcFiles( hb_dirBase() + "files/" + x, .F. ) }, .F. }, ;
"/app/*" => { {|x| UProcWidgets( x, s_aMap ) }, .T. }, ;
"/*" => { {|| URedirect( "/app/login" ) }, .F. } }
? "Listening on port:", oServer:nPort
IF ! oServer:Run()
? "Server error:", oServer:cError
RETURN 1
ENDIF
RETURN 0
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" )
GetWidgetById( "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", "" )
GetWidgetById( "user" ):cValue := cUser
GetWidgetById( "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()
USER := cUser
NAME := cName
PASSWORD := cPassword
dbUnlock()
session[ "loggedin" ] := cUser
URedirect( "main" )
ENDIF
dbCloseArea()
ELSEIF cMethod == "GET"
IF HB_HHasKey( get, "err" )
IF get[ "err" ] == "1"
GetWidgetById( "errtxt" ):cText := "All fields are required!"
ELSEIF get[ "err" ] == "2"
GetWidgetById( "errtxt" ):cText := "Passwords does not match!"
ELSEIF get[ "err" ] == "3"
GetWidgetById( "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( 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( 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", "" )
GetWidgetById( "name" ):cValue := RTrim( cName )
IF Empty( cName )
URedirect( "?err=1" )
ELSEIF ( ! Empty( cPassword ) .OR. ! Empty( cPassword2 ) ) .AND. ! ( cPassword == cPassword2 )
URedirect( "?err=2" )
ELSE
FLock()
NAME := cName
QOut( "PO DBAPPEND", Alias(), RecNo(), cName )
IF ! Empty( cPassword )
PASSWORD := cPassword
ENDIF
dbUnlock()
URedirect( "../account" )
ENDIF
ELSEIF cMethod == "GET"
IF HB_HHasKey( get, "err" )
IF get[ "err" ] == "1"
GetWidgetById( "errtxt" ):cText := "All fields are required!"
ELSEIF get[ "err" ] == "2"
GetWidgetById( "errtxt" ):cText := "Passwords does 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( 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 += TOTAL } ) )
GetWidgetById( "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. ), TITLE ) } )
oW:AddColumn( 103, "Amount", "AMOUNT" )
oW:AddColumn( 104, "Total", "TOTAL" )
oW:AddColumn( 104, "", {|| ULink( "Delete", "?del=" + RTrim( 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 += TOTAL } ) )
GetWidgetById( "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.

47
harbour/examples/uhttpd2/uhbext.prg
View File

@@ -8,28 +8,35 @@
*
*************************************************************/
FUNCTION split( cSeparator, cString )
FUNC split(cSeparator, cString)
LOCAL aRet := {}, nI
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
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
FUNC join(cSeparator, aData)
LOCAL cRet := "", nI
FUNCTION join( cSeparator, aData )
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 += LTRIM(STR(aData[nI]))
ELSEIF VALTYPE(aData[nI]) == "D"; cRet += IF(!EMPTY(aData[nI]), DTOC(aData[nI]), "")
ELSE
ENDIF
NEXT
RETURN cRet
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

10
harbour/examples/uhttpd2/uhttpd2.hbc Normal file
View File

@@ -0,0 +1,10 @@
#
# $Id$
#
incpaths=.
libpaths=.
libs=${hb_name}${__HB_DYN__}
mt=yes

10
harbour/examples/uhttpd2/uhttpd2.hbp
View File

@@ -2,11 +2,13 @@
# $Id$
#
-ouhttpd2
-hblib
-inc
-o${hb_name}
-w3 -es2
app.prg
uhbext.prg
umain.prg
uwidgets.prg
-mt

1718
harbour/examples/uhttpd2/umain.prg
View File

File diff suppressed because it is too large Load Diff

780
harbour/examples/uhttpd2/uwidgets.prg
View File

@@ -4,419 +4,481 @@
#include "hbclass.ch"
#pragma -kM+
#pragma -km+
MEMVAR session, server, get, post
//============================================================
CLASS UWMain
DATA aChilds INIT {}
METHOD Add()
METHOD Paint()
CREATE CLASS UWMain
DATA aChilds INIT {}
METHOD Add( oWidget )
METHOD Paint()
ENDCLASS
FUNCTION UWMainNew()
FUNC UWMainNew()
LOCAL oW := UWMain()
session["_uthis", "main"] := oW
RETURN oW
LOCAL oW := UWMain()
session["_uthis", "main"] := oW
RETURN oW
METHOD Paint() CLASS UWMain
UWrite('<html><link href="/files/main.css" type=text/css rel=stylesheet>')
UWrite('<meta http-equiv="content-type" content="text/html; charset=windows-1257">')
UWrite('<script language="javascript" src="/files/main.js"></script>')
UWrite('<body>')
AEVAL(Self:aChilds, {|x| X:Paint()})
UWrite('</body></html>')
RETURN Self
UWrite( '<html><link href="/files/main.css" type=text/css rel=stylesheet>' )
UWrite( '<meta http-equiv="content-type" content="text/html; charset=windows-1257">' )
UWrite( '<script language="javascript" src="/files/main.js"></script>' )
UWrite( '<body>' )
AEval( Self:aChilds, { |x| X:Paint() } )
UWrite( '</body></html>' )
METHOD Add(oWidget) CLASS UWMain
AADD(Self:aChilds, oWidget)
RETURN Self
RETURN Self
METHOD Add( oWidget ) CLASS UWMain
AAdd( Self:aChilds, oWidget )
RETURN Self
//============================================================
CLASS UWLayoutGrid
DATA aChilds INIT {{{}}} // {{{}}, {{}}} ; {{{}, {}}}
METHOD Add()
METHOD Paint()
CREATE CLASS UWLayoutGrid
DATA aChilds INIT { { {} } } // {{{}}, {{}}} ; {{{}, {}}}
METHOD Add( oWidget, nRow, nCol )
METHOD Paint()
ENDCLASS
FUNCTION UWLayoutGridNew()
FUNC UWLayoutGridNew()
LOCAL oW := UWLayoutGrid()
RETURN oW
LOCAL oW := UWLayoutGrid()
RETURN oW
METHOD Paint() CLASS UWLayoutGrid
LOCAL aRow, aCell
UWrite('<table>')
FOR EACH aRow IN Self:aChilds
UWrite('<tr>')
FOR EACH aCell IN aRow
UWrite('<td>')
AEVAL(aCell, {|o| o:Paint()})
UWrite('</td>')
NEXT
UWrite('</tr>')
NEXT
UWrite('</table>')
RETURN Self
LOCAL aRow, aCell
METHOD Add(oWidget, nRow, nCol) CLASS UWLayoutGrid
LOCAL nI, nJ, aI
IF nRow > LEN(Self:aChilds)
FOR nI := LEN(Self:aChilds) + 1 TO nRow
aI := ARRAY(LEN(Self:aChilds[1]))
FOR nJ := 1 TO LEN(Self:aChilds[1])
aI[nJ] := {}
UWrite( '<table>' )
FOR EACH aRow IN Self:aChilds
UWrite( '<tr>' )
FOR EACH aCell IN aRow
UWrite( '<td>' )
AEval( aCell, { |o| o:Paint() } )
UWrite( '</td>' )
NEXT
AADD(Self:aChilds, aI)
NEXT
ENDIF
IF nCol > LEN(Self:aChilds[1])
FOR nI := LEN(Self:aChilds[1]) + 1 TO nCol
AEVAL(Self:aChilds, {|x| AADD(x, {})})
NEXT
ENDIF
AADD(Self:aChilds[nRow, nCol], oWidget)
RETURN Self
UWrite( '</tr>' )
NEXT
UWrite( '</table>' )
RETURN Self
METHOD Add( oWidget, nRow, nCol ) CLASS UWLayoutGrid
LOCAL nI, nJ, aI
IF nRow > Len( Self:aChilds )
FOR nI := Len( Self:aChilds ) + 1 TO nRow
aI := Array( Len( Self:aChilds[1] ) )
FOR nJ := 1 TO Len( Self:aChilds[1] )
aI[nJ] := {}
NEXT
AAdd( Self:aChilds, aI )
NEXT
ENDIF
IF nCol > Len( Self:aChilds[1] )
FOR nI := Len( Self:aChilds[1] ) + 1 TO nCol
AEval( Self:aChilds, { |x| AAdd( x, {} ) } )
NEXT
ENDIF
AAdd( Self:aChilds[nRow, nCol], oWidget )
RETURN Self
//============================================================
CLASS UWHtml
DATA cText
METHOD Paint()
CREATE CLASS UWHtml
DATA cText
METHOD Paint()
ENDCLASS
FUNCTION UWHtmlNew( cText )
FUNC UWHtmlNew(cText)
LOCAL oW := UWHtml()
oW:cText := cText
RETURN oW
LOCAL oW := UWHtml()
oW:cText := cText
RETURN oW
METHOD Paint() CLASS UWHtml
UWrite(Self:cText)
RETURN Self
UWrite( Self:cText )
RETURN Self
//============================================================
CLASS UWLabel
DATA cText
DATA cID
DATA cStyle
METHOD Paint()
CREATE CLASS UWLabel
DATA cText
DATA cID
DATA cStyle
METHOD Paint()
ENDCLASS
FUNCTION UWLabelNew( cText, cID, cStyle )
FUNC UWLabelNew(cText, cID, cStyle)
LOCAL oW := UWLabel()
oW:cText := cText
SetWId(oW, cID)
oW:cStyle := cStyle
RETURN oW
LOCAL oW := UWLabel()
oW:cText := cText
SetWId( oW, cID )
oW:cStyle := cStyle
RETURN oW
METHOD Paint() CLASS UWLabel
UWrite('<div' + IIF(Self:cID != NIL, ' id="' + Self:cID + '"', "") + ;
IIF(Self:cStyle != NIL, ' style="' + Self:cStyle + '"', "") + '>' + ;
UHtmlEncode(Self:cText) + '</span>')
RETURN Self
UWrite( '<div' + iif( Self:cID != NIL, ' id="' + Self:cID + '"', "" ) + ;
iif( Self:cStyle != NIL, ' style="' + Self:cStyle + '"', "" ) + '>' + ;
UHtmlEncode( Self:cText ) + '</span>' )
RETURN Self
//============================================================
CLASS UWForm
DATA cAction
DATA cMethod INIT "POST"
DATA aChilds INIT {}
METHOD Add()
METHOD Paint()
CREATE CLASS UWForm
DATA cAction
DATA cMethod INIT "POST"
DATA aChilds INIT {}
METHOD Add( oWidget )
METHOD Paint()
ENDCLASS
FUNCTION UWFormNew( cAction )
FUNC UWFormNew(cAction)
LOCAL oW := UWForm()
oW:cAction := cAction
RETURN oW
LOCAL oW := UWForm()
oW:cAction := cAction
METHOD Add(oWidget) CLASS UWForm
AADD(Self:aChilds, oWidget)
RETURN Self
RETURN oW
METHOD Add( oWidget ) CLASS UWForm
AAdd( Self:aChilds, oWidget )
RETURN Self
METHOD Paint() CLASS UWForm
UWrite('<form action="' + Self:cAction + '" method="' + Self:cMethod + '">')
AEVAL(Self:aChilds, {|x| X:Paint()})
UWrite('</form>')
RETURN Self
UWrite( '<form action="' + Self:cAction + '" method="' + Self:cMethod + '">' )
AEval( Self:aChilds, { |x| X:Paint() } )
UWrite( '</form>' )
RETURN Self
//============================================================
CLASS UWInput
DATA cName
DATA cValue
DATA cID
DATA cStyle
METHOD Paint()
CREATE CLASS UWInput
DATA cName
DATA cValue
DATA cID
DATA cStyle
METHOD Paint()
ENDCLASS
FUNCTION UWInputNew( cName, cValue, cID, cStyle )
FUNC UWInputNew(cName, cValue, cID, cStyle)
LOCAL oW := UWInput()
oW:cName := cName
oW:cValue := cValue
SetWId(oW, cID)
oW:cStyle := cStyle
RETURN oW
LOCAL oW := UWInput()
oW:cName := cName
oW:cValue := cValue
SetWId( oW, cID )
oW:cStyle := cStyle
RETURN oW
METHOD Paint() CLASS UWInput
UWrite('<input type="text" name="' + IIF(Self:cName != NIL, Self:cName, "") + ;
'" value="' + IIF(Self:cValue != NIL, UHtmlEncode(Self:cValue), "") + '">')
RETURN Self
UWrite( '<input type="text" name="' + iif( Self:cName != NIL, Self:cName, "" ) + ;
'" value="' + iif( Self:cValue != NIL, UHtmlEncode( Self:cValue ), "" ) + '">' )
RETURN Self
//============================================================
CLASS UWPassword
DATA cName
DATA cValue
METHOD Paint()
CREATE CLASS UWPassword
DATA cName
DATA cValue
METHOD Paint()
ENDCLASS
FUNCTION UWPasswordNew( cName )
FUNC UWPasswordNew(cName)
LOCAL oW := UWPassword()
oW:cName := cName
RETURN oW
LOCAL oW := UWPassword()
oW:cName := cName
RETURN oW
METHOD Paint() CLASS UWPassword
UWrite('<input type="password" name="' + IIF(Self:cName != NIL, Self:cName, "") + ;
'" value="' + IIF(Self:cValue != NIL, Self:cValue, "") + '">')
RETURN Self
UWrite( '<input type="password" name="' + iif( Self:cName != NIL, Self:cName, "" ) + ;
'" value="' + iif( Self:cValue != NIL, Self:cValue, "" ) + '">' )
RETURN Self
//============================================================
CLASS UWSubmit
DATA cName
DATA cValue
METHOD Paint()
CREATE CLASS UWSubmit
DATA cName
DATA cValue
METHOD Paint()
ENDCLASS
FUNCTION UWSubmitNew( cName, cValue )
FUNC UWSubmitNew(cName, cValue)
LOCAL oW := UWSubmit()
oW:cName := cName
oW:cValue := cValue
RETURN oW
LOCAL oW := UWSubmit()
oW:cName := cName
oW:cValue := cValue
RETURN oW
METHOD Paint() CLASS UWSubmit
UWrite('<input type="submit" name="' + IIF(Self:cName != NIL, Self:cName, "") + ;
'" value="' + IIF(Self:cValue != NIL, UHtmlEncode(Self:cValue), "") + '">')
RETURN Self
UWrite( '<input type="submit" name="' + iif( Self:cName != NIL, Self:cName, "" ) + ;
'" value="' + iif( Self:cValue != NIL, UHtmlEncode( Self:cValue ), "" ) + '">' )
RETURN Self
//============================================================
CLASS UWSeparator
METHOD Paint()
CREATE CLASS UWSeparator
METHOD Paint()
ENDCLASS
FUNCTION UWSeparatorNew()
FUNC UWSeparatorNew()
LOCAL oW := UWSeparator()
RETURN oW
LOCAL oW := UWSeparator()
RETURN oW
METHOD Paint() CLASS UWSeparator
UWrite('<hr>')
RETURN Self
UWrite( '<hr>' )
RETURN Self
//============================================================
CLASS UWMenu
DATA aItems INIT {}
METHOD AddItem()
METHOD Paint()
CREATE CLASS UWMenu
DATA aItems INIT {}
METHOD AddItem( cTitle, cLink )
METHOD Paint()
ENDCLASS
FUNCTION UWMenuNew()
FUNC UWMenuNew()
LOCAL oB := UWMenu()
RETURN oB
LOCAL oB := UWMenu()
RETURN oB
METHOD AddItem(cTitle, cLink) CLASS UWMenu
AADD(Self:aItems, {cTitle, cLink})
RETURN Self
METHOD AddItem( cTitle, cLink ) CLASS UWMenu
AAdd( Self:aItems, { cTitle, cLink } )
RETURN Self
METHOD Paint() CLASS UWMenu
LOCAL nI
UWrite('<div>')
FOR nI := 1 TO LEN(Self:aItems)
IF nI != 1
UWrite('&nbsp;|&nbsp;')
ENDIF
UWrite('<a href="' + Self:aItems[nI, 2] + '">' + UHtmlEncode(Self:aItems[nI, 1]) + '</a>')
NEXT
UWrite('</div>')
RETURN Self
LOCAL nI
UWrite( '<div>' )
FOR nI := 1 TO Len( Self:aItems )
IF nI != 1
UWrite( '&nbsp;|&nbsp;' )
ENDIF
UWrite( '<a href="' + Self:aItems[nI, 2] + '">' + UHtmlEncode( Self:aItems[nI, 1] ) + '</a>' )
NEXT
UWrite( '</div>' )
RETURN Self
//============================================================
CLASS UWBrowse
DATA cID
DATA aColumns INIT {}
DATA nArea
DATA nRecno
DATA lBof INIT .F.
DATA lEof INIT .F.
CREATE CLASS UWBrowse
DATA cID
DATA aColumns INIT {}
DATA nArea
DATA nRecno
DATA lBof INIT .F.
DATA lEof INIT .F.
METHOD AddColumn( nID, cTitle, cField, lRaw )
METHOD Paint()
METHOD PaintBody()
METHOD Ajax( cAction )
METHOD Skipper( nSkip )
METHOD AddColumn()
METHOD Paint()
METHOD PaintBody()
METHOD Ajax()
METHOD Skipper()
ENDCLASS
FUNCTION UWBrowseNew( cID )
FUNC UWBrowseNew(cID)
LOCAL oW := UWBrowse()
SetWId(oW, cID)
oW:nArea := SELECT()
RETURN oW
LOCAL oW := UWBrowse()
SetWId( oW, cID )
oW:nArea := Select()
METHOD AddColumn(nID, cTitle, cField, lRaw) CLASS UWBrowse
AADD(Self:aColumns, {nID, cTitle, cField, !EMPTY(lRaw)})
RETURN Self
RETURN oW
METHOD AddColumn( nID, cTitle, cField, lRaw ) CLASS UWBrowse
AAdd( Self:aColumns, { nID, cTitle, cField, !Empty( lRaw ) } )
RETURN Self
METHOD Paint() CLASS UWBrowse
UWrite('<div id="' + Self:cID + '">')
Self:PaintBody()
UWrite('</div>')
RETURN Self
UWrite( '<div id="' + Self:cID + '">' )
Self:PaintBody()
UWrite( '</div>' )
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>')
LOCAL nI, nJ, xI, xField, nArea
// Header
UWrite('<tr>')
FOR nI := 1 TO LEN(Self:aColumns)
UWrite('<th>' + UHtmlEncode(Self:aColumns[nI, 2]) + '</th>')
NEXT
UWrite('</tr>')
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>' )
// 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]
IF VALTYPE(xField) == "C"
xI := FIELDGET(FIELDPOS(xField))
ELSEIF VALTYPE(xField) == "B"
xI := EVAL(xField)
// Header
UWrite( '<tr>' )
FOR nI := 1 TO Len( Self:aColumns )
UWrite( '<th>' + UHtmlEncode( Self:aColumns[nI, 2] ) + '</th>' )
NEXT
UWrite( '</tr>' )
// Body
dbGoto( Self:nRecno )
FOR nI := 1 TO 20
IF Eof(); EXIT
ENDIF
IF VALTYPE(xI) == "C"; xI := TRIM(xI)
ELSEIF VALTYPE(xI) == "N"; xI := STR(xI)
ELSEIF VALTYPE(xI) == "D"; xI := DTOC(xI)
ELSE ; xI := "VALTYPE()==" + VALTYPE(xI)
ENDIF
IF ! Self:aColumns[nJ, 4]
xI := UHtmlEncode(xI)
ENDIF
UWrite('<td><nobr>' + xI + '</nobr></td>')
NEXT
UWrite('</tr>')
DBSKIP()
NEXT
UWrite('</table>')
DBSELECTAREA(nArea)
RETURN Self
UWrite( '<tr>' )
FOR nJ := 1 TO Len( Self:aColumns )
xField := Self:aColumns[nJ, 3]
IF ValType( xField ) == "C"
xI := FieldGet( FieldPos( xField ) )
ELSEIF ValType( xField ) == "B"
xI := Eval( xField )
ENDIF
IF ValType( xI ) == "C"; xI := RTrim( xI )
ELSEIF ValType( xI ) == "N"; xI := Str( xI )
ELSEIF ValType( xI ) == "D"; xI := DToC( xI )
ELSE ; xI := "VALTYPE()==" + ValType( xI )
ENDIF
IF ! Self:aColumns[nJ, 4]
xI := UHtmlEncode( xI )
ENDIF
UWrite( '<td><nobr>' + xI + '</nobr></td>' )
NEXT
UWrite( '</tr>' )
dbSkip()
NEXT
UWrite( '</table>' )
dbSelectArea( nArea )
RETURN Self
METHOD Ajax(cAction) CLASS UWBrowse
LOCAL nI, nJ, aI, aJ, xI
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
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()
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)
Self:lBof := .F.
ENDIF
ENDIF
Self:nRecno := RECNO()
RETURN Self
ELSE
dbSkip( - 1 )
IF Bof()
Self:lBof := .T.
ELSE
dbSkip( 1 )
Self:lBof := .F.
ENDIF
ENDIF
Self:nRecno := RecNo()
RETURN Self
/********************************************************************
@@ -425,96 +487,100 @@ RETURN Self
*
********************************************************************/
PROC UProcWidgets(cURL, aMap)
LOCAL aStack, aURL, aFrame, cI, nI, nL, lRet
PROCEDURE UProcWidgets( cURL, aMap )
? "cURL:", cURL
IF HB_HHasKey(aMap, cURL)
// aStack[i] = {url_part, function, variables}
IF (aStack := hb_HGetDef(session, "_ustack")) == NIL
session["_ustack"] := aStack := {}
ENDIF
LOCAL aStack, aURL, aFrame, cI, nI, nL, lRet
aURL := split("/", cURL)
nI := 1
nL := MIN(LEN(aURL), LEN(aStack))
DO WHILE nI <= nL
IF aStack[nI, 1] == aURL[nI]
nI++
ELSE
EXIT
? "cURL:", cURL
IF HB_HHasKey( aMap, cURL )
// aStack[i] = {url_part, function, variables}
IF ( aStack := hb_HGetDef( session, "_ustack" ) ) == NIL
session["_ustack"] := aStack := {}
ENDIF
ENDDO
// Exit procedures
DO WHILE nI <= LEN(aStack)
aFrame := ATAIL(aStack)
IF aFrame[2] != NIL
session["_uthis"] := aFrame[3]
EVAL(aFrame[2], "EXIT")
aURL := split( "/", cURL )
nI := 1
nL := Min( Len( aURL ), Len( aStack ) )
DO WHILE nI <= nL
IF aStack[nI, 1] == aURL[nI]
nI ++
ELSE
EXIT
ENDIF
ENDDO
// Exit procedures
DO WHILE nI <= Len( aStack )
aFrame := ATAIL( aStack )
IF aFrame[2] != NIL
session["_uthis"] := aFrame[3]
Eval( aFrame[2], "EXIT" )
session["_uthis"] := NIL
ENDIF
ASize( aStack, Len( aStack ) - 1 )
ENDDO
aFrame := NIL
lRet := .T.
// Enter procedures
DO WHILE nI <= Len( aURL )
cI := join( "/", ASize( AClone(aURL ), nI ) )
IF HB_HHasKey( aMap, cI )
session["_uthis"] := { "idhash" => { => } }
IF ( lRet := Eval( aMap[cI], "INIT" ) ) == .T.
AAdd( aStack, { aURL[nI], aMap[cI], session["_uthis"] } )
session["_uthis"] := NIL
ELSE
session["_uthis"] := NIL
EXIT
ENDIF
ELSE
AAdd( aStack, { aURL[nI], NIL, NIL } )
ENDIF
nI ++
ENDDO
IF lRet
session["_uthis"] := ATAIL( aStack )[3]
IF server["REQUEST_METHOD"] == "GET"
Eval( ATAIL( aStack )[2], "GET" )
ELSEIF server["REQUEST_METHOD"] == "POST"
Eval( ATAIL( aStack )[2], "POST" )
ENDIF
ATAIL( aStack )[3] := session["_uthis"]
session["_uthis"] := NIL
ENDIF
ASIZE(aStack, LEN(aStack) - 1)
ENDDO
aFrame := NIL
ELSE
USetStatusCode( 404 )
ENDIF
lRet := .T.
// Enter procedures
DO WHILE nI <= LEN(aURL)
cI := join("/", ASIZE(ACLONE(aURL), nI))
IF HB_HHasKey(aMap, cI)
session["_uthis"] := {"idhash"=>{=>}}
IF (lRet := EVAL(aMap[cI], "INIT")) == .T.
AADD(aStack, {aURL[nI], aMap[cI], session["_uthis"]})
session["_uthis"] := NIL
ELSE
session["_uthis"] := NIL
EXIT
ENDIF
RETURN
PROCEDURE UWDefaultHandler( cMethod )
LOCAL cID, oW
IF cMethod == "GET"
IF ( cID := hb_HGetDef( get, "ajax" ) ) == NIL
session["_uthis", "main"]:Paint()
ELSE
AADD(aStack, {aURL[nI], NIL, NIL})
IF ( oW := GetWidgetById( cID ) ) != NIL
UAddHeader( "Content-type", "text/html; charset=windows-1257" )
oW:Ajax( hb_HGetDef( get, "action" ) )
ENDIF
ENDIF
nI++
ENDDO
ENDIF
IF lRet
session["_uthis"] := ATAIL(aStack)[3]
IF server["REQUEST_METHOD"] == "GET"
EVAL(ATAIL(aStack)[2], "GET")
ELSEIF server["REQUEST_METHOD"] == "POST"
EVAL(ATAIL(aStack)[2], "POST")
ENDIF
ATAIL(aStack)[3] := session["_uthis"]
session["_uthis"] := NIL
ENDIF
ELSE
USetStatusCode(404)
ENDIF
RETURN
RETURN
STATIC PROC SetWId( oW, cID )
PROC UWDefaultHandler(cMethod)
LOCAL cID, oW
IF cMethod == "GET"
IF (cID := hb_HGetDef(get, "ajax")) == NIL
session["_uthis", "main"]:Paint()
ELSE
IF (oW := GetWidgetById(cID)) != NIL
UAddHeader("Content-type", "text/html; charset=windows-1257")
oW:Ajax(hb_HGetDef(get, "action"))
ENDIF
ENDIF
ENDIF
RETURN
IF cID != NIL
oW:cID := cID
session["_uthis", "idhash", cID] := oW
ENDIF
RETURN
STATIC PROC SetWId(oW, cID)
IF cID != NIL
oW:cID := cID
session["_uthis", "idhash", cID] := oW
ENDIF
RETURN
FUNC GetWidgetById(cID)
RETURN hb_HGetDef(session["_uthis", "idhash"], cID)
FUNCTION GetWidgetById( cID )
RETURN hb_HGetDef( session["_uthis", "idhash"], cID )