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

2017-09-13 14:32 UTC Viktor Szakats (vszakats users.noreply.github.com)

Browse Source 
- extras/guestbk/cgi.ch
  - extras/guestbk/guestbk.hbp
  - extras/guestbk/guestbk.txt
  * .gitattributes
  * contrib/hbgd/tests/counter.prg
  * contrib/hbhttpd/core.prg
  * contrib/hbgd/tests/digits/57chevy.gif -> contrib/hbgd/tests/imgs_in/57chevy.gif
  * contrib/hbgd/tests/digits/7seg.gif -> contrib/hbgd/tests/imgs_in/7seg.gif
  * contrib/hbgd/tests/digits/brsd.gif -> contrib/hbgd/tests/imgs_in/brsd.gif
  * contrib/hbgd/tests/digits/digib.gif -> contrib/hbgd/tests/imgs_in/digib.gif
  * contrib/hbgd/tests/digits/fdb.gif -> contrib/hbgd/tests/imgs_in/fdb.gif
  * contrib/hbgd/tests/digits/jelly.gif -> contrib/hbgd/tests/imgs_in/jelly.gif
  * contrib/hbgd/tests/digits/odb.gif -> contrib/hbgd/tests/imgs_in/odb.gif
  * contrib/hbgd/tests/digits/odw.gif -> contrib/hbgd/tests/imgs_in/odw.gif
  * contrib/hbgd/tests/digits/pdg.gif -> contrib/hbgd/tests/imgs_in/pdg.gif
  * contrib/hbgd/tests/digits/pdw.gif -> contrib/hbgd/tests/imgs_in/pdw.gif
  * contrib/hbhttpd/tests/tpl/_main.tpl -> contrib/hbhttpd/tests/tpl/_main.html
  * contrib/hbhttpd/tests/tpl/app/account/edit.tpl -> contrib/hbhttpd/tests/tpl/app/account/edit.html
  * contrib/hbhttpd/tests/tpl/app/account.tpl -> contrib/hbhttpd/tests/tpl/app/account.html
  * contrib/hbhttpd/tests/tpl/app/cart.tpl -> contrib/hbhttpd/tests/tpl/app/cart.html
  * contrib/hbhttpd/tests/tpl/app/login.tpl -> contrib/hbhttpd/tests/tpl/app/login.html
  * contrib/hbhttpd/tests/tpl/app/logout.tpl -> contrib/hbhttpd/tests/tpl/app/logout.html
  * contrib/hbhttpd/tests/tpl/app/main.tpl -> contrib/hbhttpd/tests/tpl/app/main.html
  * contrib/hbhttpd/tests/tpl/app/register.tpl -> contrib/hbhttpd/tests/tpl/app/register.html
  * contrib/hbhttpd/tests/tpl/app/shopping.tpl -> contrib/hbhttpd/tests/tpl/app/shopping.html
  * extras/gtwvw/docs/funclist.txt -> contrib/gtwvw/doc/funclist.txt
  * extras/gtwvw/docs/gtwvw.txt -> contrib/gtwvw/doc/gtwvw.txt
  * extras/gtwvw/docs/whatsnew.txt -> contrib/gtwvw/doc/ChangeLog.txt
  * extras/gtwvw/gtwvw.hbc -> contrib/gtwvw/gtwvw.hbc
  * extras/gtwvw/gtwvw.hbx -> contrib/gtwvw/gtwvw.hbx
  * extras/gtwvw/gtwvwd.c -> contrib/gtwvw/gtwvwd.c
  * extras/gtwvw/hbgtwvw.h -> contrib/gtwvw/hbgtwvw.h
  * extras/gtwvw/hbole.h -> contrib/gtwvw/hbole.h
  * extras/gtwvw/tests/_wvwmous.prg -> contrib/gtwvw/tests/_wvwmous.prg
  * extras/gtwvw/tests/def2.bmp -> contrib/gtwvw/tests/def2.bmp
  * extras/gtwvw/tests/dia_excl.ico -> contrib/gtwvw/tests/dia_excl.ico
  * extras/gtwvw/tests/drawimg.prg -> contrib/gtwvw/tests/drawimg.prg
  * extras/gtwvw/tests/ebtest7.prg -> contrib/gtwvw/tests/eb7.prg
  * extras/gtwvw/tests/hbmk.hbm -> contrib/gtwvw/tests/hbmk.hbm
  * extras/gtwvw/tests/vouch1.bmp -> contrib/gtwvw/tests/vouch1.bmp
  * extras/gtwvw/tests/vouch1.gif -> contrib/gtwvw/tests/vouch1.gif
  * extras/gtwvw/wvt2wvw.ch -> contrib/gtwvw/wvt2wvw.ch
  * extras/gtwvw/wvwcheck.c -> contrib/gtwvw/checkbox.c
  * extras/gtwvw/wvwdraw.c -> contrib/gtwvw/wvwdraw.c
  * extras/gtwvw/wvwedit.c -> contrib/gtwvw/editbox.c
  * extras/gtwvw/wvwfuncs.c -> contrib/gtwvw/wvwutils.c
  * extras/gtwvw/wvwmenu.c -> contrib/gtwvw/menubar.c
  * extras/gtwvw/wvwpush.c -> contrib/gtwvw/pushbut.c
  * extras/gtwvw/wvwstbar.c -> contrib/gtwvw/statbar.c
  * extras/gtwvw/wvwtbar.c -> contrib/gtwvw/toolbar.c
  * extras/guestbk/guestbk.html -> tests/guestbk.html
  * extras/hbdoc/hbdoc.css -> contrib/hbdoc/hbdoc.css
  * extras/gtwvw/gtwvw.hbp -> contrib/gtwvw/gtwvw.hbp
  * extras/gtwvw/tests/cbtest1.prg -> contrib/gtwvw/tests/cb1.prg
  * extras/gtwvw/tests/cbtest6.prg -> contrib/gtwvw/tests/cb6.prg
  * extras/gtwvw/tests/inpfocus.prg -> contrib/gtwvw/tests/inpfocus.prg
  * extras/gtwvw/tests/maincoor.prg -> contrib/gtwvw/tests/maincoor.prg
  * extras/gtwvw/tests/maximize.prg -> contrib/gtwvw/tests/maximize.prg
  * extras/gtwvw/tests/prog0.prg -> contrib/gtwvw/tests/prog0.prg
  * extras/gtwvw/tests/prog1.prg -> contrib/gtwvw/tests/prog1.prg
  * extras/gtwvw/tests/prog2.prg -> contrib/gtwvw/tests/prog2.prg
  * extras/gtwvw/tests/readme.txt -> contrib/gtwvw/tests/readme.txt
  * extras/gtwvw/tests/wvwtest9.prg -> contrib/gtwvw/tests/demo.prg
  * extras/guestbk/_cgi.prg -> tests/cgi.prg
  * extras/guestbk/_inifile.prg -> tests/inifile.prg
  * extras/guestbk/guestbk.ini -> tests/guestbk.ini
  * extras/guestbk/guestbk.prg -> tests/guestbk.prg
  * extras/hbdoc/_genbase.prg -> contrib/hbdoc/_base.prg
  * extras/hbdoc/_genhtml.prg -> contrib/hbdoc/_html.prg
  * extras/hbdoc/_gentxt.prg -> contrib/hbdoc/_txt.prg
  * extras/hbdoc/_genxml.prg -> contrib/hbdoc/_xml.prg
  * extras/hbdoc/hbdoc.hbp -> contrib/hbdoc/hbdoc.hbp
  * extras/hbdoc/hbdoc.prg -> contrib/hbdoc/hbdoc.prg
    * more file/dir rename sync with 3.4 fork, plus some related file content
This commit is contained in:
Viktor Szakats
2017-09-13 14:33:46 +00:00
parent 7ba5a41867
commit e4751cd9e9
76 changed files with 300 additions and 360 deletions
Download Patch File Download Diff File Expand all files Collapse all files

369
tests/cgi.prg Normal file
View File

@@ -0,0 +1,369 @@
/*
* Copyright (C) 1999 Eddie Runia
*
* 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 program; see the file LICENSE.txt. If not, write to
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/).
*
* 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.
*
*/
/* 1999-05-30 First implementation.
*
* Tips: - Use ShowResults to make dynamic html (to test dynamic
* results, put the exe file on CGI-BIN dir or equivalent);
* - Use SaveToFile to make static html page
*
* 1999-05-31 Initial CGI functionality.
* 1999-06-01 Translated %nn to correct chars.
* 1999-06-02 Dynamic TAG matching routines (inspired on Delphi).
* First attempt to convert Delphi's ISAPI dll of WebSites'
* Function List
* 1999-07-29 Changed QOut() calls to OutStd() calls.
*/
#include "fileio.ch"
#include "hbclass.ch"
#define CGI_SERVER_SOFTWARE 1
#define CGI_SERVER_NAME 2
#define CGI_GATEWAY_INTERFACE 3
#define CGI_SERVER_PROTOCOL 4
#define CGI_SERVER_PORT 5
#define CGI_REQUEST_METHOD 6
#define CGI_HTTP_ACCEPT 7
#define CGI_HTTP_USER_AGENT 8
#define CGI_HTTP_REFERER 9
#define CGI_PATH_INFO 10
#define CGI_PATH_TRANSLATED 11
#define CGI_SCRIPT_NAME 12
#define CGI_QUERY_STRING 13
#define CGI_REMOTE_HOST 14
#define CGI_REMOTE_ADDR 15
#define CGI_REMOTE_USER 16
#define CGI_AUTH_TYPE 17
#define CGI_CONTENT_TYPE 18
#define CGI_CONTENT_LENGTH 19
#define CGI_ANNOTATION_SERVER 20
#define IF_BUFFER 65535
FUNCTION ParseString( cString, cDelim, nRet )
LOCAL cBuf, aElem, nPosFim, nSize, i
nSize := Len( cString ) - Len( StrTran( cString, cDelim ) ) + 1
aElem := Array( nSize )
cBuf := cString
FOR i := 1 TO nSize
nPosFim := At( cDelim, cBuf )
IF nPosFim > 0
aElem[ i ] := SubStr( cBuf, 1, nPosFim - 1 )
ELSE
aElem[ i ] := cBuf
ENDIF
cBuf := SubStr( cBuf, nPosFim + 1, Len( cBuf ) )
NEXT
RETURN aElem[ nRet ]
CREATE CLASS THTML
VAR cTitle // Page Title
VAR cBody // HTML Body Handler
VAR cBGColor // Background Color
VAR cLinkColor // Link Color
VAR cvLinkColor // Visited Link Color
VAR cContent // Page Content Handler
VAR aCGIContents
VAR aQueryFields
VAR cHTMLFile
VAR aReplaceTags
METHOD New()
METHOD SetTitle( cTitle )
METHOD AddLink( cLinkTo, cLinkName )
METHOD AddHead( cDescr )
METHOD AddPara( cPara, cAlign )
METHOD Generate()
METHOD ShowResult()
METHOD SaveToFile( cFile )
METHOD ProcessCGI()
METHOD GetCGIParam( nParam )
METHOD QueryFields( cQueryName )
METHOD SetHTMLFile( cFile )
METHOD AddReplaceTag( cTag, cReplaceText )
END CLASS
METHOD New() CLASS THTML
::cTitle := "Untitled"
::cBGColor := "#FFFFFF"
::cLinkColor := "#0000FF"
::cvLinkColor := "#FF0000"
::cContent := ""
::cBody := ""
::aCGIContents := {}
::aQueryFields := {}
::aReplaceTags := {}
::cHTMLFile := ""
RETURN Self
METHOD SetTitle( cTitle ) CLASS THTML
::cTitle := cTitle
RETURN Self
METHOD AddLink( cLinkTo, cLinkName ) CLASS THTML
::cBody := ::cBody + ;
"<a href='" + cLinkTo + "'>" + cLinkName + "</a>"
RETURN Self
METHOD AddHead( cDescr ) CLASS THTML
::cBody += "<h1>" + cDescr + "</h1>"
RETURN NIL
METHOD AddPara( cPara, cAlign ) CLASS THTML
::cBody := ::cBody + ;
"<p align='" + cAlign + "'>" + hb_eol() + ;
cPara + hb_eol() + ;
"</p>"
RETURN Self
METHOD Generate() CLASS THTML
LOCAL cFile, i, hFile, nPos, cRes := ""
#if 0
LOCAL lFlag := .F.
#endif
// Is this a meta file or hand generated script?
IF Empty( ::cHTMLFile )
::cContent := ;
"<html><head>" + hb_eol() + ;
"<title>" + ::cTitle + "</title>" + hb_eol() + ;
"<body link='" + ::cLinkColor + "' " + ;
"vlink='" + ::cvLinkColor + "'>" + + hb_eol() + ;
::cBody + hb_eol() + ;
"</body></html>"
ELSE
::cContent := ""
// Does cHTMLFile exists?
IF ! hb_FileExists( ::cHTMLFile )
::cContent := "<h1>Server Error</h1><p><i>No such file: " + ;
::cHTMLFile
ELSE
// Read from file
hFile := FOpen( ::cHTMLFile, FO_READ )
cFile := Space( IF_BUFFER )
DO WHILE ( nPos := FRead( hFile, @cFile, IF_BUFFER ) ) > 0
cFile := hb_BLeft( cFile, nPos )
cRes += cFile
cFile := Space( IF_BUFFER )
ENDDO
FClose( hFile )
// Replace matched tags
i := 1
::cContent := cRes
/* TODO: Replace this DO WHILE with FOR..NEXT */
DO WHILE i <= Len( ::aReplaceTags )
::cContent := StrTran( ::cContent, ;
"<#" + ::aReplaceTags[ i, 1 ] + ">", ::aReplaceTags[ i, 2 ] )
i++
ENDDO
/* TODO: Clear remaining (not matched) tags */
#if 0
cRes := ""
FOR i := 1 TO Len( ::cContent )
IF SubStr( ::cContent, i, 1 ) == "<" .AND. ;
SubStr( ::cContent, i + 1, 1 ) == "#"
lFlag := .T.
ELSEIF SubStr( ::cContent, i, 1 ) == ">" .AND. lFlag
lFlag := .F.
ELSEIF ! lFlag
cRes += SubStr( ::cContent, i, 1 )
ENDIF
NEXT
::cContent := cRes
#endif
ENDIF
ENDIF
RETURN Self
METHOD ShowResult() CLASS THTML
OutStd( ;
"HTTP/1.0 200 OK" + hb_eol() + ;
"CONTENT-TYPE: TEXT/HTML" + hb_eol() + hb_eol() + ;
::cContent )
RETURN Self
METHOD SaveToFile( cFile ) CLASS THTML
LOCAL hFile := FCreate( cFile )
FWrite( hFile, ::cContent )
FClose( hFile )
RETURN Self
METHOD ProcessCGI() CLASS THTML
LOCAL cQuery
LOCAL cBuff := ""
LOCAL nBuff := 0
LOCAL i
IF Empty( ::aCGIContents )
::aCGIContents := { ;
GetEnv( "SERVER_SOFTWARE" ), ;
GetEnv( "SERVER_NAME" ), ;
GetEnv( "GATEWAY_INTERFACE" ), ;
GetEnv( "SERVER_PROTOCOL" ), ;
GetEnv( "SERVER_PORT" ), ;
GetEnv( "REQUEST_METHOD" ), ;
GetEnv( "HTTP_ACCEPT" ), ;
GetEnv( "HTTP_USER_AGENT" ), ;
GetEnv( "HTTP_REFERER" ), ;
GetEnv( "PATH_INFO" ), ;
GetEnv( "PATH_TRANSLATED" ), ;
GetEnv( "SCRIPT_NAME" ), ;
GetEnv( "QUERY_STRING" ), ;
GetEnv( "REMOTE_HOST" ), ;
GetEnv( "REMOTE_ADDR" ), ;
GetEnv( "REMOTE_USER" ), ;
GetEnv( "AUTH_TYPE" ), ;
GetEnv( "CONTENT_TYPE" ), ;
GetEnv( "CONTENT_LENGTH" ), ;
GetEnv( "ANNOTATION_SERVER" ) }
cQuery := ::GetCGIParam( CGI_QUERY_STRING )
IF ! Empty( cQuery )
::aQueryFields := {}
FOR i := 1 TO Len( cQuery ) + 1
IF i > Len( cQuery ) .OR. SubStr( cQuery, i, 1 ) == "&"
AAdd( ::aQueryFields, { ;
SubStr( cBuff, 1, At( "=", cBuff ) - 1 ), ;
StrTran( SubStr( cBuff, At( "=", cBuff ) + 1, ;
Len( cBuff ) - At( "=", cBuff ) + 1 ), "+", " " ) } )
cBuff := ""
ELSE
IF SubStr( cQuery, i, 1 ) == "%"
cBuff += Chr( hb_HexToNum( SubStr( cQuery, i + 1, 2 ) ) )
nBuff := 3
ENDIF
IF nBuff == 0
cBuff += SubStr( cQuery, i, 1 )
ELSE
nBuff--
ENDIF
ENDIF
NEXT
ENDIF
ENDIF
RETURN Self
METHOD GetCGIParam( nParam ) CLASS THTML
::ProcessCGI()
IF nParam > 20 .OR. nParam < 1
OutErr( "Invalid CGI parameter" )
RETURN NIL
ENDIF
RETURN ::aCGIContents[ nParam ]
METHOD QueryFields( cQueryName ) CLASS THTML
LOCAL cRet := ""
LOCAL nRet
::ProcessCGI()
nRet := AScan( ::aQueryFields, ;
{| x | Upper( x[ 1 ] ) == Upper( cQueryName ) } )
IF nRet > 0
cRet := ::aQueryFields[ nRet, 2 ]
ENDIF
RETURN cRet
METHOD SetHTMLFile( cFile ) CLASS THTML
::cHTMLFile := cFile
RETURN Self
METHOD AddReplaceTag( cTag, cReplaceText ) CLASS THTML
AAdd( ::aReplaceTags, { cTag, cReplaceText } )
RETURN Self

30
tests/guestbk.html Normal file
View File

@@ -0,0 +1,30 @@
<html>
<head>
<title>The Harbour Guestbook</title>
<meta name="Author" content="" />
<meta name="Keywords" content="" />
<meta name="Description" content="" />
</head>
<!-- Harbour Guestbook Webpage -->
<!-- Copyright (C) 1999 by Felipe G. Coury -->
<body bgcolor="#FFFFFF">
<center><b>Harbour GuestBook Script</b></center>
<hr>
<center>
<form name="GuestBook" action="/cgi-bin/guestbk.exe" method="GET">
<table>
<tr><td><font size=2><b>Name:</b></td><td><input name="Name" type="text" size="60"></td></tr>
<tr><td><font size=2><b>City/State/Country:</td><td><input name="City" TYPE="text" size="20"><input name="State" type="text" size="20"><input name="Country" type="text" size="20"></td></tr>
<tr><td><font size=2><b>E-Mail:</td><td><input name="EMail" type="text" size="30"></td></tr>
<tr><td><font size=2><b>Homepage:</td><td><input name="Homepage" type="text" size="40"></td></tr>
<tr><td valign="top"><font size=2><b>Comments:</td><td><textarea name="Comments" rows="5" cols="60"></textarea></td></tr>
</table>
<input type="Submit" value=" Submit Entry ">&nbsp;<input type="Reset" value=" Reset Data "><br />
<input type="Hidden" name="Oper" value="A">
</center>
</form>
<hr>
<#Entries>
</body>
</html>

56
tests/guestbk.ini Normal file
View File

@@ -0,0 +1,56 @@
; The Harbour Guestbook Script Configuration file
; Copyright (C) 1999 Felipe G. Coury
; 1. Section [Header]
;
; This section defines the Guestbook fields and color look.
; DataFields=<n> n is the number of fields on guestbook
; DataFieldn=<fieldname> defines the name of the nth field of guestbook
; EvenLine=<color> color of even lines on guestbook
; OddLine=<color> color of odd lines on guestbook
[Header]
DataFields=7
DataField1=Name
DataField2=City
DataField3=State
DataField4=Country
DataField5=EMail
DataField6=Homepage
DataField7=Comments
EvenLine=#f0f0f0
OddLine=#000000
; 2. Section [Format]
; Formats each guestbook entry.
; FormatLines=<n> number of lines per entry
; FormatLinen=<format> format of the nth line of the entry. You can
; use metatags for replacing its content with the
; correspondent field value. Ex.:
; Format1=Name: <b><#Name></b>
; Format2=<a href="<#URL>"><#URL></a>
; Formats one line with "Name:" and the content
; of the "Name" field in bold and the other
; with a link to the "URL" field. The fields
; within metatags must be defined in the [Header]
; section. In addition to those tags you can use
; <#DateTime> tag, which will be expanded to the
; entry date on the format "Month DD, YYYY".
[Format]
FormatLines=3
Format1=<b><#Comments></b>
Format2=<a href="<#Homepage>"><#Name></a> &lt;<a href="mailto:<#EMail>"><#EMail></a>>
Format3=<#City>, <#State> <#Country> - <#DateTime>
; 3. Section [Entries]
; This section is not a configuration section. The Guestbook itself controls
; it adding entries here. Should not be modified.
[Entries]
Entries=1
Name1=Felipe G. Coury
City1=Campinas
State1=SP
Country1=Brazil
EMail1=fcoury@flexsys-ci.com
Homepage1=https://example.org/
Comments1=This is Harbour Guestbook. Powered by Harbour. Leave your message after the beep!!!&ltg>
DateTime1=1999-07-25 12:00:00

169
tests/guestbk.prg Normal file
View File

@@ -0,0 +1,169 @@
/*
* This file contains source for a script of a Guestbook
*
* Copyright (C) 1999 Felipe G. Coury <fcoury@creation.com.br>
*
* 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 program; see the file LICENSE.txt. If not, write to
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/).
*
* 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.
*
*/
/* How to create and test the Harbour Guestbook
Build this using hbmk2. Put the resulting executable
and .html files on a script-enabled directory
and call guestbk executable via WebBrowser.
The best thing about this guestbook is its highly
configurable architecture. Please review guestbk.ini
for configuration options and further explanation.
That's it!
PS: If you don't have a WebServer, I will be pleased to
demonstrate it to you. Just contact me via ICQ, my
UIN is #19504786. Thanks! */
#define _WWW_ROOT_DIR_ hb_DirSepAdd( hb_DirSepToOS( "/www/root/" ) )
PROCEDURE Main()
LOCAL oIni := TIniFile():New( _WWW_ROOT_DIR_ + "guestbk.ini" )
LOCAL oHTML := THtml():New()
LOCAL cOddColor, cEvenColor
LOCAL cCode, i, j, l, cField, nEntry, cColor
LOCAL aEntries, aLine, cLine
oHTML:ProcessCGI()
IF oHTML:QueryFields( "Oper" ) == "A" // Add Entry
nEntry := oIni:ReadNumber( "Entries", "Entries", 0 ) + 1
oIni:WriteNumber( "Entries", "Entries", nEntry )
// Reads all "Header" fields from CGI
FOR i := 1 TO oIni:ReadNumber( "Header", "DataFields", 0 )
cField := oIni:ReadString( "Header", "DataField" + hb_ntos( i ), "" )
oIni:WriteString( "Entries", cField + hb_ntos( nEntry ), ;
StrTran( StrTran( oHTML:QueryFields( cField ), Chr( 13 ) ), Chr( 10 ), "<br />" ) )
NEXT
// Write fields to .ini file
oIni:WriteString( "Entries", "DateTime" + hb_ntos( nEntry ), ;
CMonth( Date() ) + " " + hb_ntos( Day( Date() ) ) + ", " + ;
hb_ntos( Year( Date() ) ) + " " + Time() )
oIni:UpdateFile()
oHTML:cContent := '<html><head><meta http-equiv="Refresh" ' + ;
'content="0;url=/cgi-bin/guestbk.exe"></head>' + ;
'<body></body></html>'
oHTML:ShowResult()
ELSE
// Sets the metahtml file
oHTML:SetHTMLFile( _WWW_ROOT_DIR_ + "guestbk.html" )
// Retrieves odd and even entries color
cOddColor := oIni:ReadString( "Header", "OddColor", "#FFFFFF" )
cEvenColor := oIni:ReadString( "Header", "EvenColor", "#F0F0F0" )
cCode := ""
i := oIni:ReadNumber( "Entries", "Entries", 0 )
aEntries := {}
// Preprocess entries and stores in aEntries
DO WHILE i > 0
aLine := {}
FOR j := 1 TO oIni:ReadNumber( "Header", "DataFields", 0 )
cField := oIni:ReadString( "Header", "DataField" + hb_ntos( j ), "" )
AAdd( aLine, { cField, ;
oIni:ReadString( "Entries", cField + hb_ntos( i ), "" ) } )
NEXT
AAdd( aEntries, aLine )
i--
ENDDO
cCode := ""
// Formats each line according to the INI file
FOR i := 1 TO Len( aEntries )
cCode += "<table width=100% cellspacing=0>" + hb_eol()
cColor := iif( Mod( i, 2 ) == 0, cEvenColor, cOddColor )
FOR j := 1 TO oIni:ReadNumber( "Format", "FormatLines", 0 )
cCode += "<tr><td bgcolor='" + cColor + "'>"
cLine := oIni:ReadString( "Format", "Format" + hb_ntos( j ), "" )
FOR l := 1 TO Len( aEntries[ i ] )
cLine := StrTran( cLine, "<#" + aEntries[ i ][ l ][ 1 ] + ">", ;
aEntries[ i ][ l ][ 2 ] )
NEXT
cLine := StrTran( cLine, "<#DateTime>", ;
oIni:ReadString( "Entries", "DateTime" + hb_ntos( Len( aEntries ) - i + 1 ), "" ) )
cCode += cLine + "</td></tr>" + hb_eol()
NEXT
cCode += "</table>" + hb_eol()
NEXT
// Generates the output
oHTML:AddReplaceTag( "Entries", cCode )
oHTML:Generate()
oHTML:ShowResult()
ENDIF
RETURN
#if defined( __HBSCRIPT__HBSHELL )
SET PROCEDURE TO "cgi.prg"
SET PROCEDURE TO "inifile.prg"
#endif

340
tests/inifile.prg Normal file
View File

@@ -0,0 +1,340 @@
/*
* Copyright (C) 1999 Matthew Hamilton
*
* 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 program; see the file LICENSE.txt. If not, write to
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301 USA (or visit https://www.gnu.org/licenses/).
*
* 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 "fileio.ch"
#include "hbclass.ch"
CREATE CLASS TIniFile
VAR FileName
VAR Contents
METHOD New( cFileName )
METHOD ReadString( cSection, cIdent, cDefault )
METHOD WriteString( cSection, cIdent, cString )
METHOD ReadNumber( cSection, cIdent, nDefault )
METHOD WriteNumber( cSection, cIdent, nNumber )
METHOD ReadDate( cSection, cIdent, dDefault )
METHOD WriteDate( cSection, cIdent, dDate )
METHOD ReadBool( cSection, cIdent, lDefault )
METHOD WriteBool( cSection, cIdent, lBool )
METHOD DeleteKey( cSection, cIdent )
METHOD EraseSection( cSection )
METHOD ReadSection( cSection )
METHOD ReadSections()
METHOD UpdateFile()
END CLASS
METHOD New( cFileName ) CLASS TIniFile
LOCAL lDone, hFile, cFile, cLine, cIdent, nPos
LOCAL CurrArray
IF Empty( cFileName )
// raise an error?
OutErr( "No filename passed to TIniFile():New()" )
RETURN NIL
ELSE
::FileName := cFilename
::Contents := {}
CurrArray := ::Contents
IF hb_FileExists( cFileName )
hFile := FOpen( cFilename, FO_READ )
ELSE
hFile := FCreate( cFilename )
ENDIF
cLine := ""
lDone := .F.
DO WHILE ! lDone
cFile := Space( 256 )
lDone := ( FRead( hFile, @cFile, 256 ) <= 0 )
cFile := StrTran( cFile, Chr( 13 ) ) // so we can just search for Chr( 10 )
// prepend last read
cFile := cLine + cFile
DO WHILE ! Empty( cFile )
IF ( nPos := At( Chr( 10 ), cFile ) ) > 0
cLine := Left( cFile, nPos - 1 )
cFile := SubStr( cFile, nPos + 1 )
IF ! Empty( cLine )
DO CASE
CASE Left( cLine, 1 ) == "[" // new section
IF ( nPos := At( "]", cLine ) ) > 1
cLine := SubStr( cLine, 2, nPos - 2 )
ELSE
cLine := SubStr( cLine, 2 )
ENDIF
AAdd( ::Contents, { cLine, { /* this will be CurrArray */ } } )
CurrArray := ::Contents[ Len( ::Contents ) ][ 2 ]
CASE Left( cLine, 1 ) == ";" // preserve comments
AAdd( CurrArray, { NIL, cLine } )
OTHERWISE
IF ( nPos := At( "=", cLine ) ) > 0
cIdent := Left( cLine, nPos - 1 )
cLine := SubStr( cLine, nPos + 1 )
AAdd( CurrArray, { cIdent, cLine } )
ELSE
AAdd( CurrArray, { cLine, "" } )
ENDIF
ENDCASE
cLine := "" // to stop prepend later on
ENDIF
ELSE
cLine := cFile
cFile := ""
ENDIF
ENDDO
ENDDO
FClose( hFile )
ENDIF
RETURN Self
METHOD ReadString( cSection, cIdent, cDefault ) CLASS TIniFile
LOCAL cResult := cDefault
LOCAL i, j, cFind
IF Empty( cSection )
cFind := Lower( cIdent )
j := AScan( ::Contents, {| x | HB_ISSTRING( x[ 1 ] ) .AND. Lower( x[ 1 ] ) == cFind .AND. HB_ISSTRING( x[ 2 ] ) } )
IF j > 0
cResult := ::Contents[ j ][ 2 ]
ENDIF
ELSE
cFind := Lower( cSection )
i := AScan( ::Contents, {| x | HB_ISSTRING( x[ 1 ] ) .AND. Lower( x[ 1 ] ) == cFind } )
IF i > 0
cFind := Lower( cIdent )
j := AScan( ::Contents[ i ][ 2 ], {| x | HB_ISSTRING( x[ 1 ] ) .AND. Lower( x[ 1 ] ) == cFind } )
IF j > 0
cResult := ::Contents[ i ][ 2 ][ j ][ 2 ]
ENDIF
ENDIF
ENDIF
RETURN cResult
METHOD PROCEDURE WriteString( cSection, cIdent, cString ) CLASS TIniFile
LOCAL i, j, cFind
IF Empty( cIdent )
OutErr( "Must specify an identifier" )
ELSEIF Empty( cSection )
cFind := Lower( cIdent )
j := AScan( ::Contents, {| x | HB_ISSTRING( x[ 1 ] ) .AND. Lower( x[ 1 ] ) == cFind .AND. HB_ISSTRING( x[ 2 ] ) } )
IF j > 0
::Contents[ j ][ 2 ] := cString
ELSE
AAdd( ::Contents, NIL )
AIns( ::Contents, 1 )
::Contents[ 1 ] := { cIdent, cString }
ENDIF
ELSE
cFind := Lower( cSection )
IF ( i := AScan( ::Contents, {| x | HB_ISSTRING( x[ 1 ] ) .AND. Lower( x[ 1 ] ) == cFind .AND. HB_ISARRAY( x[ 2 ] ) } ) ) > 0
cFind := Lower( cIdent )
j := AScan( ::Contents[ i ][ 2 ], {| x | HB_ISSTRING( x[ 1 ] ) .AND. Lower( x[ 1 ] ) == cFind } )
IF j > 0
::Contents[ i ][ 2 ][ j ][ 2 ] := cString
ELSE
AAdd( ::Contents[ i ][ 2 ], { cIdent, cString } )
ENDIF
ELSE
AAdd( ::Contents, { cSection, { { cIdent, cString } } } )
ENDIF
ENDIF
RETURN
METHOD ReadNumber( cSection, cIdent, nDefault ) CLASS TIniFile
RETURN Val( ::ReadString( cSection, cIdent, Str( nDefault ) ) )
METHOD PROCEDURE WriteNumber( cSection, cIdent, nNumber ) CLASS TIniFile
::WriteString( cSection, cIdent, hb_ntos( nNumber ) )
RETURN
METHOD ReadDate( cSection, cIdent, dDefault ) CLASS TIniFile
RETURN hb_SToD( ::ReadString( cSection, cIdent, DToS( dDefault ) ) )
METHOD PROCEDURE WriteDate( cSection, cIdent, dDate ) CLASS TIniFile
::WriteString( cSection, cIdent, DToS( dDate ) )
RETURN
METHOD ReadBool( cSection, cIdent, lDefault ) CLASS TIniFile
LOCAL cDefault := iif( lDefault, ".T.", ".F." )
RETURN ::ReadString( cSection, cIdent, cDefault ) == ".T."
METHOD PROCEDURE WriteBool( cSection, cIdent, lBool ) CLASS TIniFile
::WriteString( cSection, cIdent, iif( lBool, ".T.", ".F." ) )
RETURN
METHOD PROCEDURE DeleteKey( cSection, cIdent ) CLASS TIniFile
LOCAL i, j
cSection := Lower( cSection )
i := AScan( ::Contents, {| x | HB_ISSTRING( x[ 1 ] ) .AND. Lower( x[ 1 ] ) == cSection } )
IF i > 0
cIdent := Lower( cIdent )
j := AScan( ::Contents[ i ][ 2 ], {| x | HB_ISSTRING( x[ 1 ] ) .AND. Lower( x[ 1 ] ) == cIdent } )
hb_ADel( ::Contents[ i ][ 2 ], j, .T. )
ENDIF
RETURN
METHOD PROCEDURE EraseSection( cSection ) CLASS TIniFile
LOCAL i
IF Empty( cSection )
DO WHILE ( i := AScan( ::Contents, {| x | HB_ISSTRING( x[ 1 ] ) .AND. HB_ISSTRING( x[ 2 ] ) } ) ) > 0
hb_ADel( ::Contents, i, .T. )
ENDDO
ELSE
cSection := Lower( cSection )
IF ( i := AScan( ::Contents, {| x | HB_ISSTRING( x[ 1 ] ) .AND. Lower( x[ 1 ] ) == cSection .AND. HB_ISARRAY( x[ 2 ] ) } ) ) > 0
hb_ADel( ::Contents, i, .T. )
ENDIF
ENDIF
RETURN
METHOD ReadSection( cSection ) CLASS TIniFile
LOCAL i, j, aSection := {}
IF Empty( cSection )
FOR i := 1 TO Len( ::Contents )
IF HB_ISSTRING( ::Contents[ i ][ 1 ] ) .AND. HB_ISSTRING( ::Contents[ i ][ 2 ] )
AAdd( aSection, ::Contents[ i ][ 1 ] )
ENDIF
NEXT
ELSE
cSection := Lower( cSection )
IF ( i := AScan( ::Contents, {| x | HB_ISSTRING( x[ 1 ] ) .AND. x[ 1 ] == cSection .AND. HB_ISARRAY( x[ 2 ] ) } ) ) > 0
FOR j := 1 TO Len( ::Contents[ i ][ 2 ] )
IF ::Contents[ i ][ 2 ][ j ][ 1 ] != NIL
AAdd( aSection, ::Contents[ i ][ 2 ][ j ][ 1 ] )
ENDIF
NEXT
ENDIF
ENDIF
RETURN aSection
METHOD ReadSections() CLASS TIniFile
LOCAL i, aSections := {}
FOR i := 1 TO Len( ::Contents )
IF HB_ISARRAY( ::Contents[ i ][ 2 ] )
AAdd( aSections, ::Contents[ i ][ 1 ] )
ENDIF
NEXT
RETURN aSections
METHOD PROCEDURE UpdateFile() CLASS TIniFile
LOCAL i, j
LOCAL hFile := FCreate( ::Filename )
FOR i := 1 TO Len( ::Contents )
IF ::Contents[ i ][ 1 ] == NIL
FWrite( hFile, ::Contents[ i ][ 2 ] + hb_eol() )
ELSEIF HB_ISARRAY( ::Contents[ i ][ 2 ] )
FWrite( hFile, "[" + ::Contents[ i ][ 1 ] + "]" + hb_eol() )
FOR j := 1 TO Len( ::Contents[ i ][ 2 ] )
IF ::Contents[ i ][ 2 ][ j ][ 1 ] == NIL
FWrite( hFile, ::Contents[ i ][ 2 ][ j ][ 2 ] + hb_eol() )
ELSE
FWrite( hFile, ::Contents[ i ][ 2 ][ j ][ 1 ] + "=" + ::Contents[ i ][ 2 ][ j ][ 2 ] + hb_eol() )
ENDIF
NEXT
FWrite( hFile, hb_eol() )
ELSEIF HB_ISSTRING( ::Contents[ i ][ 2 ] )
FWrite( hFile, ::Contents[ i ][ 1 ] + "=" + ::Contents[ i ][ 2 ] + hb_eol() )
ENDIF
NEXT
FClose( hFile )
RETURN