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

2009-01-30 03:24 UTC+0100 Francesco Saverio Giudice (info/at/fsgiudice.com)

Browse Source 
* harbour/contrib/examples/uhttpd/uhttpd.prg
    * Updated uHTTPD (Work in progress)
      + Added HRB caching (set #define HRB_ACTIVATE_CACHE .T. to enable)
      + Added support for Cookies
      * Formatted
      ! Renamed all public functions with uhttpd_ prefix (TOCHECK)
      + Added support for array content in POST variables
      * Optimized some code
  + harbour/contrib/examples/uhttpd/cgifunc.prg
    + Some helper function moved here from uhttpd prg and added
      some functions of mine
  + harbour/contrib/examples/uhttpd/cookie.prg
    + Cookie class
  + harbour/contrib/examples/uhttpd/modules/cookie.prg
    + cookie sample module
  + harbour/contrib/examples/uhttpd/home/postsample.html
    + POST example
  * harbour/contrib/examples/uhttpd/uhttpd.ini
    + Added new script alias for cookie sample

  * harbour/contrib/examples/uhttpd/hbmk_b32.bat
  * harbour/contrib/examples/uhttpd/home/index.html
  * harbour/contrib/examples/uhttpd/home/testxmldb.html
  * harbour/contrib/examples/uhttpd/modules/bldhrb.bat
  * harbour/contrib/examples/uhttpd/modules/info.prg
  * harbour/contrib/examples/uhttpd/modules/showcounter.prg
  * harbour/contrib/examples/uhttpd/modules/tableservletdb.prg
    * Updated for new function prefix and some formatting
This commit is contained in:
Francesco Saverio Giudice
2009-01-30 02:26:55 +00:00
parent d83d51d6b9
commit a1cb9aa400
14 changed files with 2162 additions and 931 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
harbour/ChangeLog
View File

@@ -8,6 +8,36 @@
2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2009-01-30 03:24 UTC+0100 Francesco Saverio Giudice (info/at/fsgiudice.com)
* harbour/contrib/examples/uhttpd/uhttpd.prg
* Updated uHTTPD (Work in progress)
+ Added HRB caching (set #define HRB_ACTIVATE_CACHE .T. to enable)
+ Added support for Cookies
* Formatted
! Renamed all public functions with uhttpd_ prefix (TOCHECK)
+ Added support for array content in POST variables
* Optimized some code
+ harbour/contrib/examples/uhttpd/cgifunc.prg
+ Some helper function moved here from uhttpd prg and added
some functions of mine
+ harbour/contrib/examples/uhttpd/cookie.prg
+ Cookie class
+ harbour/contrib/examples/uhttpd/modules/cookie.prg
+ cookie sample module
+ harbour/contrib/examples/uhttpd/home/postsample.html
+ POST example
* harbour/contrib/examples/uhttpd/uhttpd.ini
+ Added new script alias for cookie sample
* harbour/contrib/examples/uhttpd/hbmk_b32.bat
* harbour/contrib/examples/uhttpd/home/index.html
* harbour/contrib/examples/uhttpd/home/testxmldb.html
* harbour/contrib/examples/uhttpd/modules/bldhrb.bat
* harbour/contrib/examples/uhttpd/modules/info.prg
* harbour/contrib/examples/uhttpd/modules/showcounter.prg
* harbour/contrib/examples/uhttpd/modules/tableservletdb.prg
* Updated for new function prefix and some formatting
2009-01-29 22:50 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/config/rules.cf
* harbour/config/dos/bcc16.cf

859
harbour/contrib/examples/uhttpd/cgifunc.prg Normal file
View File

@@ -0,0 +1,859 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* uHTTPD (Micro HTTP server) cgi functions
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
//#include "xhb.ch"
#include "common.ch"
#include "error.ch"
#include "fileio.ch"
//#define HB_USE_HBTIP // Use functions from HBTIP - TOIMPLEMENT
#define CRLF (Chr(13)+Chr(10))
#xtranslate THROW( <oErr> ) => ( Eval( ErrorBlock(), <oErr> ), Break( <oErr> ) )
MEMVAR _SERVER, _GET, _POST, _COOKIE, _REQUEST, _HTTP_REQUEST
FUNCTION uhttpd_GetVars( cFields, cSeparator )
LOCAL hHashVars := Hash()
LOCAL aField, cField, aFields
LOCAL cName, xValue
DEFAULT cSeparator TO "&"
aFields := uhttpd_Split( cSeparator, cFields )
FOR EACH cField in aFields
aField := uhttpd_Split( "=", cField, 1 )
IF Len( aField ) == 1
hHashVars[ aField[ 1 ] ] := NIL
LOOP
ELSEIF Len( aField ) != 2
LOOP
ENDIF
cName := LTrim( aField[ 1 ] )
xValue := uhttpd_UrlDecode( aField[ 2 ] )
// Is it an array entry?
IF Substr( cName, Len( cName ) - 1 ) == "[]"
cName := Substr( cName, 1, Len( cName ) - 2 )
hHashVars[ cName ] := { xValue }
ELSE
// now check if variable already exists. If yes and I have already another element
// with same name, then I will change it to an array
IF ( hb_HPos( hHashVars, cName ) ) > 0
IF !HB_ISARRAY( hHashVars[ cName ] )
// Transoform it to array
hHashVars[ cName ] := { hHashVars[ cName ] }
ENDIF
aAdd( hHashVars[ cName ], xValue )
ELSE
hHashVars[ cName ] := xValue
ENDIF
ENDIF
NEXT
RETURN hHashVars
/*
uhttpd_SplitUrl( cUrl ) --> hUrl
(C) 2006 Francesco Saverio Giudice
Splits a valid URL into simple components and return them in a hash
it works like parse_url() PHP function
a URL string is something like this:
http://[username:password@]hostname[:port][/path[/file[.ext]][?arg1=[value][&arg2=[value]]][#anchor]]
Parameters:
cUrl - Valid URL string
Returns:
hUrl - Hash containing these keys:
SCHEME - protocol name
HOST - hostname
PORT - protocol port number
USER - username
PASS - password
PATH - path to directory and/or file
QUERY - part after question mark ?
FRAGMENT - part after hashmark #
*/
FUNCTION uhttpd_SplitUrl( cUrl )
LOCAL hUrl := Hash()
LOCAL nPos, cTemp, cUserNamePassword, cHostnamePort
LOCAL cProto, cHost, cPort, nPort, cUser, cPass, cPath, cQuery, cFragment
// Prevents case matching
HSetCaseMatch( hUrl, FALSE )
cTemp := cUrl
// Starting with
// http://[username:password@]hostname[:port][/path[/file[.ext]][?arg1=[value][&arg2=[value]]][#anchor]]
// Read protocol
nPos := At( "://", cTemp )
IF nPos > 0
cProto := Left( cTemp, nPos - 1 )
// delete protocol from temp string
cTemp := SubStr( cTemp, nPos + 3 )
ELSE
cProto := ""
ENDIF
// Now we have:
// [username:password@]hostname[:port][/path[/file[.ext]][?arg1=[value][&arg2=[value]]][#anchor]]
// Read username and password
nPos := At( "@", cTemp )
IF nPos > 0
cUserNamePassword := Left( cTemp, nPos - 1 )
// delete Username and Password from temp string
cTemp := SubStr( cTemp, nPos + 1 )
// Split username and password
nPos := At( ":", cUserNamePassword )
IF nPos > 0
cUser := Left( cUserNamePassword, nPos - 1 )
cPass := SubStr( cUserNamePassword, nPos + 1 )
ELSE
cUser := cUserNamePassword
cPass := ""
ENDIF
ELSE
cUser := ""
cPass := ""
ENDIF
// Now we have:
// hostname[:port][/path[/file[.ext]][?arg1=[value][&arg2=[value]]][#anchor]]
// Search for anchor using # char from right
nPos := RAt( "#", cTemp )
IF nPos > 0
cFragment := SubStr( cTemp, nPos + 1 )
// delete anchor from temp string
cTemp := SubStr( cTemp, 1, nPos - 1 )
ELSE
cFragment := ""
ENDIF
// Now we have:
// hostname[:port][/path[/file[.ext]][?arg1=[value][&arg2=[value]]]]
// Search for Query part using ? char from right
nPos := RAt( "?", cTemp )
IF nPos > 0
cQuery := SubStr( cTemp, nPos + 1 )
// delete query from temp string
cTemp := SubStr( cTemp, 1, nPos - 1 )
ELSE
cQuery := ""
ENDIF
// Now we have:
// hostname[:port][/path[/file[.ext]]
// Search for Path part using / char from right
nPos := RAt( "/", cTemp )
IF nPos > 0
cPath := SubStr( cTemp, nPos )
// delete path from temp string
cTemp := SubStr( cTemp, 1, nPos - 1 )
ELSE
cPath := "/"
ENDIF
// Now we have:
// hostname[:port][/path[/file[.ext]]
cHostnamePort := cTemp
// Searching port number
nPos := At( ":", cHostnamePort )
IF nPos > 0
cHost := Left( cHostnamePort, nPos - 1 )
cPort := SubStr( cHostnamePort, nPos + 1 )
nPort := Val( cPort )
IF nPort <= 0
nPort := -1
ENDIF
ELSE
cHost := cHostnamePort
nPort := -1
ENDIF
// Assemble hash
WITH OBJECT hUrl
:SCHEME := cProto
:HOST := cHost
:PORT := nPort
:USER := cUser
:PASS := cPass
:PATH := cPath
:QUERY := cQuery
:FRAGMENT := cFragment
END
// Prevents externals to add something else to this Hash
HSetAutoAdd( hUrl, FALSE )
RETURN hUrl
/*
uhttpd_SplitString( cString ) --> aLines
(C) 2006 Francesco Saverio Giudice
Splits a string into simple components and return them in an array
Parameters:
cString - Initial string
cDelim - Delimiter - default CRLF
lRemDelim - Remove delimiter from return values - default TRUE
Returns:
aLines - Array with lines / fields for each element
Sample:
SplitString( "this=is=a=line=with=equals", "=" ) -> { "this", "is", "a", "line", "with", "equals" }
*/
FUNCTION uhttpd_SplitString( cString, cDelim, lRemDelim, nCount )
LOCAL nEOLPos
LOCAL cBuffer := cString
LOCAL aLines := {}, cLine
LOCAL nHowMany := 0
DEFAULT cDelim TO ( CHR(13) + CHR(10) )
DEFAULT lRemDelim TO TRUE
DEFAULT nCount TO -1
//WriteToLogFile( "Splitstring: " + cStr( cString ) )
DO WHILE ( nEOLPos := AT( cDelim, cBuffer ) ) > 0
nHowMany++
IF lRemDelim
cLine := LEFT( cBuffer, nEOLPos - 1 )
ELSE
cLine := LEFT( cBuffer, ( nEOLPos + LEN( cDelim ) ) - 1 )
ENDIF
//WriteToLogFile( "cBuffer, cDelim, nEOLPos, cLine: " + cStr( cBuffer ) + "," + cStr( cDelim ) + "," + cStr( nEOLPos ) + "," + cStr( cLine ) )
aAdd( aLines, cLine )
cBuffer := SubStr( cBuffer, nEOLPos + LEN( cDelim ) )
IF nCount > -1
IF nHowMany >= nCount
EXIT
ENDIF
ENDIF
ENDDO
// Check last line
IF Len( cBuffer ) > 0
aAdd( aLines, cBuffer )
ENDIF
RETURN aLines
/************************************************************
* Encoding URL
*/
FUNCTION uhttpd_URLEncode( cString, lComplete )
#ifdef HB_USE_HBTIP
DEFAULT lComplete TO TRUE
RETURN TIPENCODERURL_ENCODE( cString, lComplete )
#else
LOCAL cRet := "", i, nVal, cChar
FOR i := 1 TO Len( cString )
cChar := SubStr( cString, i, 1)
DO CASE
CASE cChar == " "
cRet += "+"
CASE ( cChar >= "A" .AND. cChar <= "Z" ) .OR. ;
( cChar >= "a" .AND. cChar <= "z" ) .OR. ;
( cChar >= "0" .AND. cChar <= "9" ) .OR. ;
cChar == '.' .OR. cChar == ',' .OR. cChar == '&' .OR. ;
cChar == '/' .OR. cChar == ';' .OR. cChar == '_'
cRet += cChar
CASE IIF( !lComplete, cChar == ':' .OR. cChar == '?' .OR. cChar == '=', FALSE )
cRet += cChar
OTHERWISE
nVal := Asc( cChar )
cRet += "%" + hb_NumToHex( nVal )
ENDCASE
NEXT
RETURN cRet
#endif
/************************************************************
* Decoding URL
*/
FUNCTION uhttpd_URLDecode( cString )
#ifdef HB_USE_HBTIP
RETURN TIPENCODERURL_DECODE( cString )
#else
LOCAL cRet := "", i, cChar
FOR i := 1 TO Len( cString )
cChar := SubStr( cString, i, 1 )
DO CASE
CASE cChar == "+"
cRet += " "
CASE cChar == "%"
i ++
cRet += Chr( hb_HexToNum( SubStr( cString, i, 2 ) ) )
i ++
OTHERWISE
cRet += cChar
ENDCASE
NEXT
RETURN cRet
#endif
/*
* DateToGMT( dDate, cTime, nDayToAdd ) --> cGMTDate
*
* dDate : default DATE()
* cTime : default "00:00:00"
* nDayToAdd : default 0 - may be a negative number
*
* cGMTDate : The string return in form of "Saturday, 31-Oct-03 00:00:00 GMT"
*/
FUNCTION uhttpd_DateToGMT( dDate, cTime, nDayToAdd, nSecsToAdd )
LOCAL cStr
LOCAL cOldDateFormat := Set( _SET_DATEFORMAT, "dd-mm-yy" )
LOCAL nDay, nMonth, nYear, nDoW
LOCAL aDays := { "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" }
LOCAL aMonths := { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" }
DEFAULT dDate TO DATE()
DEFAULT cTime TO TIME()
DEFAULT nDayToAdd TO 0
DEFAULT nSecsToAdd TO 0
//Tracelog( "DateToGMT - StartingValue", dDate, cTime, nDayToAdd, nSecsToAdd )
cTime := uhttpd_AddSecondsToTime( cTime, nSecsToAdd, @nDayToAdd )
dDate += nDayToAdd
nDay := Day( dDate )
nMonth := Month( dDate )
nYear := Year( dDate)
nDoW := Dow( dDate )
cStr := aDays[ nDow ] + ", " + StrZero( nDay, 2 ) + "-" + aMonths[ nMonth ] + "-" + ;
Right( StrZero( nYear, 4 ), 2 ) + " " + cTime + " GMT"
//Tracelog( "DateToGMT", cStr )
Set( _SET_DATEFORMAT, cOldDateFormat )
RETURN cStr
/*
* AddSecondsToTime( cTime, nSecsToAdd, @nDaysAdded ) --> cNewTime
*
* cTime : default "00:00:00"
* nSecsToAdd : default 0 - may be a negative number
* nDaysAdded : (out) return how many days add (or subtract) to actual date if numbers seconds is
* more than 86400 seconds (1 day)
*
* cNewTime : The new time string
*
* Rules: time is converted to seconds from midnight, then added of nSecsToAdd. Divided of 1 day and
* then reverted to Time string
*/
FUNCTION uhttpd_AddSecondsToTime( cTime, nSecsToAdd, nDaysAdded )
LOCAL nOneDaySeconds := 86400 // 24 * 60 * 60
LOCAL cNewTime, nSecs
DEFAULT cTime TO TIME()
DEFAULT nSecsToAdd TO 0
DEFAULT nDaysAdded TO 0 // nDaysAdded can be already valued, so below i add to this value
IF nSecsToAdd <> 0
nSecs := Secs( cTime ) + nSecsToAdd
nDaysAdded += Int( nSecs / nOneDaySeconds ) // Attention! nDaysAdded can be already filled
nSecs := nSecs - nDaysAdded
cNewTime := TSTRING( nSecs )
ELSE
cNewTime := cTime
ENDIF
RETURN cNewTime
FUNCTION uhttpd_TimeDiffAsSeconds( dDateStart, dDateEnd, cTimeStart, cTimeEnd )
LOCAL aRetVal
DEFAULT dDateEnd TO DATE()
DEFAULT cTimeEnd TO TIME()
aRetVal := FT_ELAPSED( dDateStart, dDateEnd, cTimeStart, cTimeEnd )
RETURN aRetVal[ 4, 2 ]
FUNCTION uhttpd_OutputString( cString, aTranslate, lProtected )
LOCAL cHtml
DEFAULT lProtected TO FALSE
DEFAULT aTranslate TO { { '"', '&quot;' }, { ' ', '&nbsp;' } }
//TraceLog( "OutputString( cString, aTranslate, lProtected )", cString, aTranslate, lProtected )
IF lProtected
cHtml := uhttpd_HtmlSpecialChars( cString )
ELSE
cHtml := uhttpd_TranslateStrings( cString, aTranslate )
ENDIF
//TraceLog( "OutputString() = cHtml", cHtml )
RETURN cHtml
FUNCTION uhttpd_HtmlSpecialChars( cString, cQuote_style )
LOCAL aTranslations := { ;
{ '&', '&amp;' } ,;
{ '<', '&lt;' } ,;
{ '>', '&gt;' } ;
}
RETURN uhttpd_HtmlConvertChars( cString, cQuote_style, aTranslations )
FUNCTION uhttpd_HtmlConvertChars( cString, cQuote_style, aTranslations )
DEFAULT cQuote_style TO "ENT_COMPAT"
DO CASE
CASE cQuote_style == "ENT_COMPAT"
aAdd( aTranslations, { '"', '&quot;' } )
CASE cQuote_style == "ENT_QUOTES"
aAdd( aTranslations, { '"', '&quot;' } )
aAdd( aTranslations, { "'", '&#039;' } )
CASE cQuote_style == "ENT_NOQUOTES"
ENDCASE
RETURN uhttpd_TranslateStrings( cString, aTranslations )
FUNCTION uhttpd_CRLF2BR( cString )
LOCAL aTranslations := { ;
{ CRLF, '<br />' } ;
}
RETURN uhttpd_TranslateStrings( cString, aTranslations )
FUNCTION uhttpd_TranslateStrings( cString, aTranslate )
LOCAL aTran
FOR EACH aTran IN aTranslate
IF aTran[1] $ cString
cString := StrTran( cString, aTran[1], aTran[2] )
ENDIF
NEXT
RETURN cString
FUNCTION uhttpd_StrStr( cString, cSearch )
LOCAL nPos := AT( cSearch, cString )
LOCAL cVal := IIF( nPos > 0, SubStr( cString, nPos ), NIL )
RETURN cVal
FUNCTION uhttpd_StrIStr( cString, cSearch )
RETURN uhttpd_StrStr( Upper( cSearch ), Upper( cString ) )
FUNCTION uhttpd_HtmlEntities( cString, cQuote_style )
// LOCAL aTranslations := { ; // ATTENTION, this chars are visible only with OEM font
// { ' ', '&#160;' } ,; // &nbsp; Nonbreaking space
// { '­', '&#161;' } ,; // &iexcl; Inverted exclamation
// { '½', '&#162;' } ,; // &cent; Cent sign
// { 'œ', '&#163;' } ,; // &pound; Pound sterling
// { 'Ï', '&#164;' } ,; // &curren; General currency sign
// { '¾', '&#165;' } ,; // &yen; Yen sign
// { 'Ý', '&#166;' } ,; // &brvbar; or &brkbar; Broken vertical bar
// { 'õ', '&#167;' } ,; // &sect; Section sign
// { 'ù', '&#168;' } ,; // &uml; or &die; Di‘resis / Umlaut
// { '¸', '&#169;' } ,; // &copy; Copyright
// { '¦', '&#170;' } ,; // &ordf; Feminine ordinal
// { '®', '&#171;' } ,; // &laquo; Left angle quote, guillemet left
// { 'ª', '&#172;' } ,; // &not Not sign
// { 'ð', '&#173;' } ,; // &shy; Soft hyphen
// { '©', '&#174;' } ,; // &reg; Registered trademark
// { 'î', '&#175;' } ,; // &macr; or &hibar; Macron accent
// { 'ø', '&#176;' } ,; // &deg; Degree sign
// { 'ñ', '&#177;' } ,; // &plusmn; Plus or minus
// { 'ý', '&#178;' } ,; // &sup2; Superscript two
// { 'ü', '&#179;' } ,; // &sup3; Superscript three
// { 'ï', '&#180;' } ,; // &acute; Acute accent
// { 'æ', '&#181;' } ,; // &micro; Micro sign
// { 'ô', '&#182;' } ,; // &para; Paragraph sign
// { 'ú', '&#183;' } ,; // &middot; Middle dot
// { '÷', '&#184;' } ,; // &cedil; Cedilla
// { 'û', '&#185;' } ,; // &sup1; Superscript one
// { '§', '&#186;' } ,; // &ordm; Masculine ordinal
// { '¯', '&#187;' } ,; // &raquo; Right angle quote, guillemet right
// { '¬', '&#188;' } ,; // &frac14; Fraction one-fourth
// { '«', '&#189;' } ,; // &frac12; Fraction one-half
// { 'ó', '&#190;' } ,; // &frac34; Fraction three-fourths
// { '¨', '&#191;' } ,; // &iquest; Inverted question mark
// { '·', '&#192;' } ,; // &Agrave; Capital A, grave accent
// { 'µ', '&#193;' } ,; // &Aacute; Capital A, acute accent
// { '¶', '&#194;' } ,; // &Acirc; Capital A, circumflex
// { 'Ç', '&#195;' } ,; // &Atilde; Capital A, tilde
// { 'Ž', '&#196;' } ,; // &Auml; Capital A, di‘resis / umlaut
// { '<27>', '&#197;' } ,; // &Aring; Capital A, ring
// { '’', '&#198;' } ,; // &AElig; Capital AE ligature
// { '€', '&#199;' } ,; // &Ccedil; Capital C, cedilla
// { 'Ô', '&#200;' } ,; // &Egrave; Capital E, grave accent
// { '<27>', '&#201;' } ,; // &Eacute; Capital E, acute accent
// { 'Ò', '&#202;' } ,; // &Ecirc; Capital E, circumflex
// { 'Ó', '&#203;' } ,; // &Euml; Capital E, di‘resis / umlaut
// { 'Þ', '&#204;' } ,; // &Igrave; Capital I, grave accent
// { 'Ö', '&#205;' } ,; // &Iacute; Capital I, acute accent
// { '×', '&#206;' } ,; // &Icirc; Capital I, circumflex
// { 'Ø', '&#207;' } ,; // &Iuml; Capital I, di‘resis / umlaut
// { 'Ñ', '&#208;' } ,; // &ETH; Capital Eth, Icelandic
// { '¥', '&#209;' } ,; // &Ntilde; Capital N, tilde
// { 'ã', '&#210;' } ,; // &Ograve; Capital O, grave accent
// { 'à', '&#211;' } ,; // &Oacute; Capital O, acute accent
// { 'â', '&#212;' } ,; // &Ocirc; Capital O, circumflex
// { 'å', '&#213;' } ,; // &Otilde; Capital O, tilde
// { '™', '&#214;' } ,; // &Ouml; Capital O, di‘resis / umlaut
// { 'ž', '&#215;' } ,; // &times; Multiply sign
// { '<27>', '&#216;' } ,; // &Oslash; Capital O, slash
// { 'ë', '&#217;' } ,; // &Ugrave; Capital U, grave accent
// { 'é', '&#218;' } ,; // &Uacute; Capital U, acute accent
// { 'ê', '&#219;' } ,; // &Ucirc; Capital U, circumflex
// { 'š', '&#220;' } ,; // &Uuml; Capital U, di‘resis / umlaut
// { 'í', '&#221;' } ,; // &Yacute; Capital Y, acute accent
// { 'è', '&#222;' } ,; // &THORN; Capital Thorn, Icelandic
// { 'á', '&#223;' } ,; // &szlig; Small sharp s, German sz
// { '…', '&#224;' } ,; // &agrave; Small a, grave accent
// { ' ', '&#225;' } ,; // &aacute; Small a, acute accent
// { 'ƒ', '&#226;' } ,; // &acirc; Small a, circumflex
// { 'Æ', '&#227;' } ,; // &atilde; Small a, tilde
// { '„', '&#228;' } ,; // &auml; Small a, di‘resis / umlaut
// { '†', '&#229;' } ,; // &aring; Small a, ring
// { '‘', '&#230;' } ,; // &aelig; Small ae ligature
// { '‡', '&#231;' } ,; // &ccedil; Small c, cedilla
// { 'Š', '&#232;' } ,; // &egrave; Small e, grave accent
// { '‚', '&#233;' } ,; // &eacute; Small e, acute accent
// { 'ˆ', '&#234;' } ,; // &ecirc; Small e, circumflex
// { '‰', '&#235;' } ,; // &euml; Small e, di‘resis / umlaut
// { '<27>', '&#236;' } ,; // &igrave; Small i, grave accent
// { '¡', '&#237;' } ,; // &iacute; Small i, acute accent
// { 'Œ', '&#238;' } ,; // &icirc; Small i, circumflex
// { '‹', '&#239;' } ,; // &iuml; Small i, di‘resis / umlaut
// { 'Ð', '&#240;' } ,; // &eth; Small eth, Icelandic
// { '¤', '&#241;' } ,; // &ntilde; Small n, tilde
// { '•', '&#242;' } ,; // &ograve; Small o, grave accent
// { '¢', '&#243;' } ,; // &oacute; Small o, acute accent
// { '“', '&#244;' } ,; // &ocirc; Small o, circumflex
// { 'ä', '&#245;' } ,; // &otilde; Small o, tilde
// { '”', '&#246;' } ,; // &ouml; Small o, di‘resis / umlaut
// { 'ö', '&#247;' } ,; // &divide; Division sign
// { '›', '&#248;' } ,; // &oslash; Small o, slash
// { '—', '&#249;' } ,; // &ugrave; Small u, grave accent
// { '£', '&#250;' } ,; // &uacute; Small u, acute accent
// { '–', '&#251;' } ,; // &ucirc; Small u, circumflex
// { '<27>', '&#252;' } ,; // &uuml; Small u, di‘resis / umlaut
// { 'ì', '&#253;' } ,; // &yacute; Small y, acute accent
// { 'ç', '&#254;' } ,; // &thorn; Small thorn, Icelandic
// { '˜', '&#255;' } ; // &yuml; Small y, di‘resis / umlaut
// }
LOCAL aTranslations := {}
LOCAL i
FOR i := 160 TO 255
aAdd( aTranslations, { Chr( i ), "&#" + Str( i, 3 ) + ";" } )
NEXT
RETURN uhttpd_HtmlConvertChars( cString, cQuote_style, aTranslations )
PROCEDURE uhttpd_Die( cError )
LOCAL oErr, lError
IF cError <> NIL //THEN OutStd( cError )
//__OutDebug( "cError: ", cError )
//IF !oCGI:HeaderSent()
// oCGI:WriteLN( CRLF2BR( cError ), CRLF2BR( CRLF() ) )
// //oCGI:WriteLN( CRLF2BR( hb_dumpVar(TConfigure():hConfig) ) )
//ENDIF
// Generate Error
oErr := ErrorNew()
oErr:severity := ES_ERROR
oErr:genCode := EG_LIMIT
oErr:subSystem := "uhttpd_CGI"
oErr:subCode := 0
oErr:description := cError
oErr:canRetry := .F.
oErr:canDefault := .F.
oErr:fileName := ""
oErr:osCode := 0
lError := Eval( ErrorBlock(), oErr )
IF !HB_ISLOGICAL( lError ) .OR. lError
__ErrInHandler()
ENDIF
Break( oErr )
//QUIT
ELSE
QUIT
ENDIF
RETURN
FUNCTION uhttpd_HTMLSpace( n )
RETURN replicate( "&nbsp;", n ) //"&#32;"
/* FROM FT LIB */
STATIC FUNCTION FT_ELAPSED(dStart, dEnd, cTimeStart, cTimeEnd)
LOCAL nTotalSec, nCtr, nConstant, nTemp, aRetVal[4,2]
IF ! ( VALTYPE(dStart) $ 'DC' )
dStart := DATE()
ELSEIF VALTYPE(dStart) == 'C'
cTimeStart := dStart
dStart := DATE()
ENDIF
IF ! ( VALTYPE(dEnd) $ 'DC' )
dEnd := DATE()
ELSEIF VALTYPE(dEnd) == 'C'
cTimeEnd := dEnd
dEnd := DATE()
ENDIF
IF( VALTYPE(cTimeStart) != 'C', cTimeStart := '00:00:00', )
IF( VALTYPE(cTimeEnd) != 'C', cTimeEnd := '00:00:00', )
nTotalSec := (dEnd - dStart) * 86400 + ;
VAL(cTimeEnd) * 3600 + ;
VAL(SUBSTR(cTimeEnd,AT(':', cTimeEnd)+1,2)) * 60 + ;
IF(RAT(':', cTimeEnd) == AT(':', cTimeEnd), 0, ;
VAL(SUBSTR(cTimeEnd,RAT(':', cTimeEnd)+1))) - ;
VAL(cTimeStart) * 3600 - ;
VAL(SUBSTR(cTimeStart,AT(':', cTimeStart)+1,2)) * 60 - ;
IF(RAT(':', cTimeStart) == AT(':', cTimeStart), 0, ;
VAL(SUBSTR(cTimeStart,RAT(':', cTimeStart)+1)))
nTemp := nTotalSec
FOR nCtr = 1 to 4
nConstant := IF(nCtr == 1, 86400, IF(nCtr == 2, 3600, IF( nCtr == 3, 60, 1)))
aRetVal[nCtr,1] := INT(nTemp/nConstant)
aRetval[nCtr,2] := nTotalSec / nConstant
nTemp -= aRetVal[nCtr,1] * nConstant
NEXT
RETURN aRetVal
PROCEDURE uhttpd_WriteToLogFile( cString, cLog, lCreate )
LOCAL nHandle, cSep
cSep := HB_OsPathSeparator()
//DEFAULT cLog TO AppFullPath() + cSep + "logfile.log"
DEFAULT cLog TO cSep + "tmp" + cSep + "logfile.log"
DEFAULT lCreate TO FALSE
IF cLog <> NIL
IF !lCreate .AND. FILE( cLog )
nHandle := FOpen( cLog, FO_READWRITE + FO_SHARED)
ELSE
nHandle := FCreate( cLog )
// Dopo che lo creato, lo richiudo immediatamente e lo riapro in modo condiviso
// nel caso arrivasse una nuova scrittura
IF Ferror() == 0 .AND. nHandle > 0
FClose( nHandle )
nHandle := FOpen( cLog, FO_READWRITE + FO_SHARED)
ENDIF
//__OutDebug( "Create ", nHandle )
ENDIF
//cString := "PROCEDURE: " + ProcName( -2 ) + " " + cString
IF nHandle > 0
FSeek( nHandle, 0, 2 )
FWrite( nHandle, cString )
FWrite( nHandle, CRLF )
FClose( nHandle )
ENDIF
ENDIF
RETURN
/*********************************************************************************/
FUNCTION uhttpd_SplitFileName( cFile )
LOCAL hFile
LOCAL cPath, cName, cExt, cDrive, cSep
HB_FnameSplit( cFile, @cPath, @cName, @cExt, @cDrive )
hFile := { ;
"FILE" => cFile ,;
"DRIVE" => cDrive ,;
"PATH" => cPath ,;
"NAME" => cName ,;
"EXT" => cExt ,;
"FULLPATH" => NIL ,;
"FULLNAME" => cName + cExt ,;
"UNC" => NIL ;
}
cSep := HB_OsPathSeparator()
WITH OBJECT hFile
:FULLPATH := IIF( !Empty( :PATH ), IIF( !( Right( :PATH, Len( cSep ) ) == cSep ), :PATH + cSep, :PATH ), "" )
:UNC := :FULLPATH + :FULLNAME
END
RETURN hFile
FUNCTION uhttpd_AppFullPath()
LOCAL hExeFile := uhttpd_SplitFileName( HB_ARGV(0) )
LOCAL cPrgFullPath := hExeFile:FULLPATH
LOCAL cPath, cSep
cSep := HB_OsPathSeparator()
IF Right( cPrgFullPath, Len( cSep ) ) == cSep
cPath := SubStr( cPrgFullPath, 1, Len( cPrgFullPath ) - Len( cSep ) )
ELSE
cPath := cPrgFullPath
ENDIF
RETURN cPath
FUNCTION uhttpd_AppFullName()
LOCAL hExeFile := uhttpd_SplitFileName( HB_ARGV(0) )
RETURN hExeFile:FULLNAME
FUNCTION uhttpd_CStrToVal( cExp, cType )
IF ValType( cExp ) != 'C'
Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) )
ENDIF
SWITCH cType
CASE 'C'
RETURN cExp
CASE 'P'
RETURN hb_HexToNum( cExp )
CASE 'D'
IF cExp[3] >= '0' .AND. cExp[3] <= '9' .AND. cExp[5] >= '0' .AND. cExp[5] <= '9'
RETURN sToD( cExp )
ELSE
RETURN cToD( cExp )
ENDIF
CASE 'L'
RETURN IIF( cExp[1] == 'T' .OR. cExp[1] == 'Y' .OR. cExp[2] == 'T' .OR. cExp[2] == 'Y', .T., .F. )
CASE 'N'
RETURN Val( cExp )
CASE 'M'
RETURN cExp
CASE 'U'
RETURN NIL
/*
CASE 'A'
Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) )
CASE 'B'
Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) )
CASE 'O'
Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) )
*/
OTHERWISE
Throw( ErrorNew( "CSTR", 0, 3101, ProcName(), "Argument error", { cExp, cType } ) )
END
RETURN NIL
FUNCTION uhttpd_GetField( cVar, cType )
LOCAL xVal
LOCAL nPos := hb_HPos( _Request, cVar )
IF nPos > 0 //cVar IN ::h_Request:Keys
xVal := hb_HValueAt( _Request, nPos ) //::h_Request[ cVar ]
IF Empty( xVal )
xVal := NIL
ENDIF
IF cType <> NIL .AND. cType $ "NLD"
xVal := uhttpd_CStrToVal( xVal, cType )
ENDIF
ENDIF
RETURN xVal
FUNCTION uhttpd_SetField( cVar, cVal )
LOCAL xVal := uhttpd_HGetValue( _Request, cVar )
_Request[ cVar ] := cVal
RETURN xVal
FUNCTION uhttpd_HGetValue( hHash, cKey )
LOCAL nPos
LOCAL xVal
IF hHash <> NIL
xVal := IIF( ( nPos := hb_HPos( hHash, cKey )) == 0, NIL, hb_HValueAt( hHash, nPos) )
ENDIF
//RETURN IIF( cKey IN hHash:Keys, hHash[ cKey ], NIL )
RETURN xVal

104
harbour/contrib/examples/uhttpd/cookie.prg Normal file
View File

@@ -0,0 +1,104 @@
#include "common.ch"
#include "hbclass.ch"
#command IF <lexpr> THEN <*statement*> =>;
IF (<lexpr>) ; <statement> ; END
#command IF <lexpr> THEN <statement1> ELSE <statement2> =>;
IF (<lexpr>) ; <statement1> ; ELSE ; <statement2> ; END
MEMVAR _COOKIE
FUNCTION uhttpd_CookieNew( cDomain, cPath, nExpireDays, nExpireSecs )
RETURN uhttpd_Cookie():New( cDomain, cPath, nExpireDays, nExpireSecs )
CLASS uhttpd_Cookie
// Data for cookies
DATA cCookieDomain
DATA cCookiePath INIT "/"
DATA cCookieExpire
DATA nCookieExpireDays INIT 0
DATA nCookieExpireSecs INIT 7200 // 1 hour - TODO set environment constant
DATA lCookiesSent INIT FALSE
METHOD SetCookie()
METHOD DeleteCookie()
METHOD DeleteAllCookies()
METHOD GetCookie()
METHOD IsCookie( cCookieName ) INLINE ::GetCookie( cCookieName ) != NIL
METHOD IsCookies() INLINE !Empty( ::aaCookieToSet )
METHOD SetCookieDefaults()
ENDCLASS
// ------------------------------ ***************************** -----------------------------------
METHOD SetCookieDefaults( cDomain, cPath, nExpireDays, nExpireSecs ) CLASS uhttpd_Cookie
IF cDomain <> NIL THEN ::cCookieDomain := cDomain
IF cPath <> NIL THEN ::cCookiePath := cPath
IF nExpireDays <> NIL THEN ::nCookieExpireDays := nExpireDays
IF nExpireSecs <> NIL THEN ::nCookieExpireSecs := nExpireSecs
RETURN NIL
METHOD SetCookie( cCookieName, xValue, cDomain, cPath, cExpires, lSecure ) CLASS uhttpd_Cookie
LOCAL cStr
DEFAULT cDomain TO ::cCookieDomain
DEFAULT cPath TO ::cCookiePath
DEFAULT cExpires TO uhttpd_DateToGMT( Date(), Time(), ::nCookieExpireDays, ::nCookieExpireSecs )
cStr := cCookieName + "=" + uhttpd_UrlEncode( hb_cStr( xValue ) )
IF cDomain <> NIL
cStr += "; domain=" + cDomain
ENDIF
IF cPath <> NIL
cStr += "; path=" + cPath
ENDIF
IF cExpires <> NIL
cStr += "; expires=" + cExpires
ENDIF
IF ValType( lSecure ) == "L" .AND. lSecure
cStr += "; secure"
ENDIF
// Send the header
uhttpd_AddHeader( "Set-Cookie", cStr, FALSE )
RETURN NIL
METHOD DeleteCookie( cCookieName, cDomain, cPath, lSecure ) CLASS uhttpd_Cookie
LOCAL cExpires := uhttpd_DateToGMT( DATE() - 1 ) // Setting date in the past delete cookie
::SetCookie( cCookieName, "", cDomain, cPath, cExpires, lSecure )
RETURN NIL
METHOD DeleteAllCookies( cDomain, cPath, lSecure ) CLASS uhttpd_Cookie
LOCAL cCookieName
FOR EACH cCookieName IN _COOKIE:Keys
//::DeleteCookie( Substr( cCookieName, 2 ), cDomain, cPath, lSecure )
::DeleteCookie( cCookieName, cDomain, cPath, lSecure )
NEXT
RETURN NIL
METHOD GetCookie( cCookieName ) CLASS uhttpd_Cookie
LOCAL cHeader, cRet
LOCAL nPos := 1
DO WHILE TRUE
IF ( cHeader := uhttpd_GetHeader( "Set-Cookie", @nPos ) ) != NIL
IF cHeader == cCookieName
cRet := cHeader
EXIT
ELSE
nPos++
ENDIF
ELSE
EXIT
ENDIF
ENDDO
RETURN cRet

8
harbour/contrib/examples/uhttpd/hbmk_b32.bat
View File

@@ -48,13 +48,19 @@ if exist uhttpd.exe uhttpd -s
..\..\..\bin\harbour uhttpd /n /es2 /w3 /i..\..\..\include %UHTTP_GD_DEF% %UHTTP_INET_DEF%
if errorlevel 1 goto DOERROR
bcc32 -O2 -tW -d -a8 -I..\..\..\include -L..\..\..\lib uhttpd.c uhttpdc.c %UHTTP_INET_SOCKET% hbdebug.lib hbvmmt.lib hbrtl.lib gtwvt.lib gtwin.lib gtgui.lib hblang.lib hbrdd.lib hbmacro.lib hbpp.lib rddntx.lib rddcdx.lib rddfpt.lib hbcpage.lib hbsix.lib hbcommon.lib hbpcre.lib hbhsx.lib hbzlib.lib xhb.lib hbct.lib cw32mt.lib %UHTTP_GD_LIBS%
..\..\..\bin\harbour cgifunc /n /es2 /w3 /i..\..\..\include %UHTTP_GD_DEF% %UHTTP_INET_DEF%
if errorlevel 1 goto DOERROR
..\..\..\bin\harbour cookie /n /es2 /w3 /i..\..\..\include %UHTTP_GD_DEF% %UHTTP_INET_DEF%
if errorlevel 1 goto DOERROR
bcc32 -O2 -tW -d -a8 -I..\..\..\include -L..\..\..\lib uhttpd.c cgifunc.c cookie.c uhttpdc.c %UHTTP_INET_SOCKET% hbdebug.lib hbvmmt.lib hbrtl.lib gtwvt.lib gtwin.lib gtgui.lib hblang.lib hbrdd.lib hbmacro.lib hbpp.lib rddntx.lib rddcdx.lib rddfpt.lib hbcpage.lib hbsix.lib hbcommon.lib hbpcre.lib hbhsx.lib hbzlib.lib xhb.lib hbct.lib cw32mt.lib %UHTTP_GD_LIBS%
if errorlevel 1 goto DOERROR
:CLEAN
del *.obj
del *.tds
del uhttpd.c
del cgifunc.c
del cookie.c
if not exist uhttpd.exe goto :EXIT
if %UHTTP_GD_SUPPORT%.==no. goto BUILD_OK

42
harbour/contrib/examples/uhttpd/home/index.html
View File

@@ -6,19 +6,39 @@
<link rel="shortcut icon" href="favicon.ico" type="image/x-icon" />
</head>
<body>
Simple uHTTPD server demo.
<br />
<h1>Simple uHTTPD server demo</h1>
<br />
Examples:
<br />
<a href="testajax.html">Test Ajax</a>
<br>
<a href="testxmldb.html">Test Ajax XML Database</a>
<br>
<a href="counter.html">Test Ajax Counter</a>
<br>
<a href="/serverstatus">Server Status</a>
<br>
<a href="/info">Alias to /cgi-bin/info.hrb page with server variables</a>
<ul>
<li>
<a href="testajax.html">Test Ajax</a> (*)
</li>
<li>
<a href="testxmldb.html">Test Ajax XML Database</a> (*)
</li>
<li>
<a href="counter.html">Test Ajax Counter</a> (*) (**)
</li>
<li>
<a href="/serverstatus">Server Status</a>
</li>
<li>
<a href="/info">Alias to /cgi-bin/info.hrb page with server variables</a> (*)
</li>
<li>
<a href="postsample.html">Post method example</a>
</li>
<li>
<a href="/cookie">Cookie example</a> (*)
</li>
</ul>
<br />
(*) Before run these examples, please build files in /uhttpd/modules folder using bldhrb.bat
<br />
(**) This example requires LIBGD
</body>
</html>

23
harbour/contrib/examples/uhttpd/home/postsample.html Normal file
View File

@@ -0,0 +1,23 @@
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>Harbour uHTTPD Server post example</title>
<link rel="shortcut icon" href="favicon.ico" type="image/x-icon" />
</head>
<body>
<h1>Simple uHTTPD server method POST</h1>
<br />
<br />
<form name=test action="/info" method="post">
Type something: <input type="text" name="word">
<input type="submit">
</form>
Pressing button you will redirect to /info page. Look at POST and REQUEST values.
<br>You will see a "word" variable name.
<br>
<br>Return to <a href="/">Main Page</a>
</body>
</html>

9
harbour/contrib/examples/uhttpd/home/testxmldb.html
View File

@@ -74,9 +74,14 @@
</script>
</head>
<body onload="getTablePages()">
Sample XML servlet. Tested with IE6+ and Firefox 2+
<BIG>Simple XML servlet</BIG>
<br>
<br>Tested with IE6+, Firefox 2+ and Opera 9+. Not working with Google Chrome.
<br>Please note that tableservletdb.prg simulates a slow reply of 0.5 seconds.
If you want to check real speed please comment #define SIMULATE_SLOW_REPLY in source.
<br>Return to <a href="/">Main Page</a>
<br>Page&nbsp;
<br>
<br>Select a Page&nbsp;
<div style="border: 1px solid black; padding: 10px;" id="pageSection">&nbsp;</div>
<br />

2
harbour/contrib/examples/uhttpd/modules/bldhrb.bat
View File

@@ -19,7 +19,7 @@ SET HB_BIN_INSTALL=%HB_INSTALL%\bin
set HB_INC_INSTALL=include;%HB_INSTALL%\include
set HB_LIB_INSTALL=%HB_INSTALL%\lib
%HB_BIN_INSTALL%\harbour %1.prg -n -q0 -w -es2 -gh -i%HB_INC_INSTALL% %2 %3 %HARBOURFLAGS% > bldtest.log
%HB_BIN_INSTALL%\harbour %1.prg -n -q0 -w3 -es2 -gh -i%HB_INC_INSTALL% %2 %3 %HARBOURFLAGS% > bldtest.log
IF ERRORLEVEL 1 GOTO SHOWERROR

116
harbour/contrib/examples/uhttpd/modules/cookie.prg Normal file
View File

@@ -0,0 +1,116 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* uHTTPD cookie example
*
* Copyright 2009 Francesco Saverio Giudice <info / at / fsgiudice.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "common.ch"
#include "hbclass.ch"
MEMVAR _REQUEST
#xcommand TEXT INTO <v> => #pragma __cstream|<v>+=%s
//#pragma escapedstrings = on
FUNCTION HRBMAIN()
LOCAL cHtml := ""
LOCAL cCookie := uhttpd_GetField( "mycookie" )
LOCAL cAction := uhttpd_GetField( "action" )
LOCAL oCookie
//hb_ToOutDebug( "cCookie = %s, cAction = %s\n\r", hb_ValToExp( cCookie ), cAction )
DEFAULT cCookie TO ""
DEFAULT cAction TO ""
// Sample page embedded
TEXT INTO cHtml
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>Harbour uHTTPD Server cookie example</title>
<link rel="shortcut icon" href="favicon.ico" type="image/x-icon" />
</head>
<body>
<h1>Simple uHTTPD server cookie example</h1>
<br />
<br />
<form name=test action="/cgi-bin/cookie.hrb" method="post">
Type something: <input type="text" name="mycookie" value="<%COOKIE_VALUE%>">
<input type="submit">
<input type="hidden" name="action" value="gotoinfo">
</form>
Pressing button you will redirect to /info page. Look at COOKIE values.
<br>You will see a "mycookie" variable name.
<br>
<br>Return to <a href="/">Main Page</a>
</body>
</html>
ENDTEXT
IF Empty( cAction )
// Set a simple cookie
oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 )
// cleaning previous cookie
oCookie:DeleteCookie( "mycookie" )
cHtml := StrTran( cHtml, "<%COOKIE_VALUE%>", cCookie )
ELSEIF cAction == "gotoinfo"
// Set a simple cookie
oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 )
oCookie:SetCookie( "mycookie", cCookie )
uhttpd_AddHeader( "Location", "/info" )
//uhttpd_Write( "cookie set <a href='/info'>Go to info page</a>" )
RETURN NIL
ENDIF
RETURN cHtml

39
harbour/contrib/examples/uhttpd/modules/info.prg
View File

@@ -59,7 +59,7 @@
#include "common.ch"
#include "hbclass.ch"
MEMVAR _SERVER, _REQUEST, _GET, _POST
MEMVAR _SERVER, _REQUEST, _GET, _POST, _COOKIE, _HTTP_REQUEST
FUNCTION HRBMAIN()
LOCAL cHtml
@@ -70,21 +70,34 @@ FUNCTION HRBMAIN()
STATIC FUNCTION ShowServerInfo()
LOCAL cHtml := ""
//LOCAL oCookie
cHtml += "<BIG>Server Info</BIG>"
//cHtml += "<br><br>If it is first time you see this page reload it to see cookies<br><br>"
cHtml += '<br><br>Return to <a href="/">Main Page</a><br><br>'
cHtml += DisplayVars( _Server , "SERVER Vars" )
cHtml += "<br>"
cHtml += DisplayVars( _HTTP_REQUEST , "HTTP Headers" )
cHtml += "<br>"
cHtml += DisplayVars( _Get , "GET Vars" )
cHtml += "<br>"
cHtml += DisplayVars( _Post , "POST Vars" )
cHtml += "<br>"
//cHtml += DisplayVars( _Cookie , "COOKIE Vars" )
//cHtml += "<br>"
cHtml += DisplayVars( _Cookie , "COOKIE Vars" )
cHtml += "<br>"
//cHtml += DisplayVars( _Files , "FILE Vars" )
//cHtml += "<br>"
cHtml += DisplayVars( _Request, "REQUEST Vars" )
cHtml += "<br>"
//cHtml += DisplayVars( _Session, "SESSION Vars" )
//cHtml += "<br>"
// Set a simple cookie
//oCookie := uhttpd_CookieNew( "localhost", "/", 1, 0 )
//oCookie:SetCookie( "samplecookie", "test" )
//oCookie:SetCookie( "samplecookie2", "test2" )
RETURN cHtml
STATIC FUNCTION DisplayVars( hHash, cTitle )
@@ -101,12 +114,26 @@ RETURN cHtml
STATIC FUNCTION DisplayHash( hHash )
LOCAL cHtml := ""
LOCAL cKey, cSubKey
LOCAL cKey, cSubKey, xValue
FOR EACH cKey IN hHash:Keys
cHtml += "<tr>"
cHtml += "<td>" + hb_cStr( cKey ) + "</td>"
cHtml += "<td>" + hb_cStr( hHash[ cKey ] ) + "</td>"
IF HB_ISHASH( hHash[ cKey ] )
cHtml += "<td>" + hb_cStr( cKey ) + "</td>"
cHtml += "<td>-------</td>"
FOR EACH cSubKey IN hHash[ cKey ]:Keys
xValue := hHash[ cKey ][ cSubKey ]
cHtml += "<tr>"
cHtml += "<td>" + hb_cStr( cSubKey ) + "</td>"
cHtml += "<td>" + IIF( Empty( xValue ), "<i>no value</i>", hb_cStr( xValue ) ) + "</td>"
cHtml += "</tr>"
NEXT
ELSE
xValue := hHash[ cKey ]
cHtml += "<td>" + hb_cStr( cKey ) + "</td>"
cHtml += "<td>" + IIF( Empty( xValue ), "<i>no value</i>", hb_cStr( xValue ) ) + "</td>"
ENDIF
cHtml += "</tr>"
NEXT
RETURN cHtml

28
harbour/contrib/examples/uhttpd/modules/showcounter.prg
View File

@@ -65,27 +65,27 @@ MEMVAR _REQUEST // defined in uHTTPD
FUNCTION HRBMAIN()
LOCAL cHtml
LOCAL cBaseImage
//LOCAL cBaseImage
IF HB_HHasKey( _REQUEST, "w" )
cHtml := CreateCounter( AllTrim( Str( Val( _REQUEST[ "w" ] ) ) ) )
//hb_ToOutDebug( hb_sprintf( "CreateCounter = %s", cHtml ) )
IF !Empty( cHtml )
uAddHeader( "Content-Type", "image/gif" )
uAddHeader( "Pragma", "no-cache" )
uAddHeader( "Content-Disposition", "inline; filename=counter" + LTrim( Str( hb_randomint( 100 ) ) ) + ".gif" )
uWrite( cHtml )
uhttpd_AddHeader( "Content-Type", "image/gif" )
uhttpd_AddHeader( "Pragma", "no-cache" )
uhttpd_AddHeader( "Content-Disposition", "inline; filename=counter" + LTrim( Str( hb_randomint( 100 ) ) ) + ".gif" )
uhttpd_Write( cHtml )
ELSE
uAddHeader( "Content-Type", "text/html" )
uWrite( "<h1>Error: No image created</h1>" )
uhttpd_AddHeader( "Content-Type", "text/html" )
uhttpd_Write( "<h1>Error: No image created</h1>" )
ENDIF
ELSE
uAddHeader( "Content-Type", "text/html" )
uWrite( "<h1>Error: no parameters passed</h1>" )
uhttpd_AddHeader( "Content-Type", "text/html" )
uhttpd_Write( "<h1>Error: no parameters passed</h1>" )
ENDIF
@@ -95,10 +95,10 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage )
LOCAL oI, oIDigits, nWidth, nHeight, nDigits, nNumWidth, oTemp
//LOCAL black, white, blue, red, green, cyan, gray
LOCAL white
//LOCAL white
LOCAL aNumberImages := {}
LOCAL n, nValue
LOCAL cFile
//LOCAL cFile
// A value if not passed
DEFAULT cValue TO Str( hb_RandomInt( 1, 10^DISPLAY_NUM ), DISPLAY_NUM )
@@ -158,7 +158,7 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage )
CASE nWidth % 13 == 0 // 0..9 : am pm
nDigits := 13
OTHERWISE
uWrite( "Error on digits image" )
uhttpd_Write( "Error on digits image" )
ENDCASE
nNumWidth := nWidth / nDigits
@@ -178,7 +178,7 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage )
//? "Image dimensions: ", oI:Width(), oI:Height()
/* Allocate background */
white := oI:SetColor( 255, 255, 255 )
//white := oI:SetColor( 255, 255, 255 )
/* Allocate drawing color */
//black := oI:SetColor( 0, 0, 0 )
@@ -203,7 +203,7 @@ STATIC FUNCTION CreateCounter( cValue, cBaseImage )
NEXT
/* Write Final Counter Image */
cFile := "counter" + StrZero( hb_RandomInt( 1, 99 ), 2 ) + ".gif"
//cFile := "counter" + StrZero( hb_RandomInt( 1, 99 ), 2 ) + ".gif"
//oI:SaveGif( IMAGES_OUT + cFile )
/* Destroy images in memory */

14
harbour/contrib/examples/uhttpd/modules/tableservletdb.prg
View File

@@ -107,18 +107,18 @@ FUNCTION HRBMAIN()
IF !Empty( cXml )
uAddHeader("Content-Type", "text/xml")
uhttpd_AddHeader("Content-Type", "text/xml")
// cache control
uAddHeader( "Cache-Control", "no-cache, must-revalidate" )
uAddHeader( "Expires", "Mon, 26 Jul 1997 05:00:00 GMT" )
uhttpd_AddHeader( "Cache-Control", "no-cache, must-revalidate" )
uhttpd_AddHeader( "Expires", "Mon, 26 Jul 1997 05:00:00 GMT" )
uWrite( cXml )
uhttpd_Write( cXml )
ELSE
uAddHeader("Content-Type", "text/xml")
uWrite( '<?xml version="1.0" encoding="ISO-8859-1"?>' )
uWrite( '<pages><page>No Data</page></pages>' )
uhttpd_AddHeader("Content-Type", "text/xml")
uhttpd_Write( '<?xml version="1.0" encoding="ISO-8859-1"?>' )
uhttpd_Write( '<pages><page>No Data</page></pages>' )
ENDIF

1
harbour/contrib/examples/uhttpd/uhttpd.ini
View File

@@ -33,3 +33,4 @@
# --- here put aliases to real path
# (under document_root path defined above)
/info = /cgi-bin/info.hrb
/cookie = /cgi-bin/cookie.hrb

1818
harbour/contrib/examples/uhttpd/uhttpd.prg
View File

File diff suppressed because it is too large Load Diff