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

19991007-19:40 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-10-09 10:07:23 +00:00
parent 4c1f0a1e44
commit 33193764bf
24 changed files with 964 additions and 129 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
harbour/ChangeLog
View File

@@ -1,3 +1,27 @@
19991007-19:40 GMT+1 Victor Szel <info@szelvesz.hu>
* tests/mankala.prg -> samples/misc/mankala.prg
tests/guess.prg -> samples/misc/guess.prg
tests/Makefile
* Sample type of tests moved to /samples directory
* samples/hscript/guest*.* -> samples/guestbk/*.*
* Separated hscript and guestbk.
* samples/hscript/*.bat
samples/guestbk/*.bat
+ Borland build batch files updated, standardized.
! Fixed some issues, hb_OSNewLine() usage added, some RTL function
names updated, minor fixes applied, now both works with the GNU make
system (tested with MINGW32)
+ samples/Makefile
samples/guestbk/Makefile
samples/hscript/Makefile
samples/misc/Makefile
+ GNU make files added for the samples.
They are currently not invoked by the mainstream make process, but
can be invoked manually.
* tests/testcgi.prg
% Got rid of s_cNewLine, so the HTML class no longer requires this
variable.
19991008-20:00 CET Eddie Runia <eddie@runia.com>
* include/extend.h
uiPrevCls added to BASEARRAY
@@ -52,7 +76,6 @@
* removed symbols.obj from compiler - I thought it needed it, but not so.
* shortened filelist for Harbour.exe to $**
>>>>>>> 1.1163
19991007-17:00 GMT+2 Ryszard Glab <rglab@imid.med.pl>
*source/compiler/harbour.y

12
harbour/samples/Makefile Normal file
View File

@@ -0,0 +1,12 @@
#
# $Id$
#
ROOT = ../
DIRS=\
guestbk \
hscript \
misc \
include $(ROOT)config/dir.cf

24
harbour/samples/guestbk/Makefile Normal file
View File

@@ -0,0 +1,24 @@
#
# $Id$
#
ROOT = ../../
PRG_SOURCES=\
guestbk.prg \
inifiles.prg \
testcgi.prg \
PRG_MAIN=guestbk.prg
LIBS=\
runner \
tools \
debug \
rdd \
vm \
rdd \
rtl \
pp \
include $(TOP)$(ROOT)config/bin.cf

3
harbour/samples/hscript/bldguest.bat → harbour/samples/guestbk/bld_b32.bat
View File

@@ -1,4 +1,7 @@
@echo off
rem
rem $Id$
rem
..\..\bin\harbour /n guestbk
..\..\bin\harbour /n ..\..\tests\inifiles

36
harbour/samples/guestbk/cgi.ch Normal file
View File

@@ -0,0 +1,36 @@
/*
* $Id$
*/
// CGI.ch
//+
// Harbour project
//
//
// 99.05.31 initial posting.
//
//
//-
#define CGI_SERVER_SOFTWARE 01
#define CGI_SERVER_NAME 02
#define CGI_GATEWAY_INTERFACE 03
#define CGI_SERVER_PROTOCOL 04
#define CGI_SERVER_PORT 05
#define CGI_REQUEST_METHOD 06
#define CGI_HTTP_ACCEPT 07
#define CGI_HTTP_USER_AGENT 08
#define CGI_HTTP_REFERER 09
#define CGI_PATH_INFO 10
#define CGI_PATH_TRANSLATED 11
#define CGI_SCRIPT_NAME 12
#define CGI_QUERY_STRING 13
#define CGI_REMOTE_HOST 14
#define CGI_REMOTE_ADDR 15
#define CGI_REMOTE_USER 16
#define CGI_AUTH_TYPE 17
#define CGI_CONTENT_TYPE 18
#define CGI_CONTENT_LENGTH 19
#define CGI_ANNOTATION_SERVER 20

0
harbour/samples/hscript/guestbk.htm → harbour/samples/guestbk/guestbk.htm
View File

0
harbour/samples/hscript/guestbk.ini → harbour/samples/guestbk/guestbk.ini
View File

6
harbour/samples/hscript/guestbk.prg → harbour/samples/guestbk/guestbk.prg
View File

@@ -1,6 +1,8 @@
/*
* $Id$
*
*/
/*
Harbour Project source code
This file contains source for a script of a Guestbook
@@ -32,7 +34,7 @@
*/
FUNCTION GuestMain()
FUNCTION Main()
LOCAL oIni := TIniFile():New( "c:\inetpub\wwwroot\guestbk.ini" )
LOCAL oHTML := THTML():New()

0
harbour/samples/hscript/guestbk.txt → harbour/samples/guestbk/guestbk.txt
View File

311
harbour/samples/guestbk/inifiles.prg Normal file
View File

@@ -0,0 +1,311 @@
//
// $Id$
//
#define CRLF (Chr(13) + Chr(10))
function TIniFile()
static oClass
if oClass == nil
oClass := TClass():New( 'TINIFILE' ) // starts a new class definition
oClass:AddData( 'FileName' ) // define this class objects datas
oClass:AddData( 'Contents' )
oClass:AddMethod( 'New', @New() ) // define this class objects methods
oClass:AddMethod( 'ReadString', @ReadString() )
oClass:AddMethod( 'WriteString', @WriteString() )
oClass:AddMethod( 'ReadNumber', @ReadNumber() )
oClass:AddMethod( 'WriteNumber', @WriteNumber() )
oClass:AddMethod( 'ReadDate', @ReadDate() )
oClass:AddMethod( 'WriteDate', @WriteDate() )
oClass:AddMethod( 'ReadBool', @ReadBool() )
oClass:AddMethod( 'WriteBool', @WriteBool() )
oClass:AddMethod( 'ReadSection', @ReadSection() )
oClass:AddMethod( 'ReadSections', @ReadSections() )
oClass:AddMethod( 'DeleteKey', @DeleteKey() )
oClass:AddMethod( 'EraseSection', @EraseSection() )
oClass:AddMethod( 'UpdateFile', @UpdateFile() )
oClass:Create() // builds this class
endif
return oClass:Instance() // builds an object of this class
static function New(cFileName)
local Self := QSelf()
local Done, 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 File(cFileName)
hFile := fopen(cFilename, 0)
else
hFile := fcreate(cFilename)
endif
cLine := ''
Done := .f.
while !Done
cFile := space(256)
Done := (fread(hFile, @cFile, 256) <= 0)
cFile := strtran(cFile, chr(10), '') // so we can just search for CHR(13)
// prepend last read
cFile := cLine + cFile
while !empty(cFile)
if (nPos := at(chr(13), cFile)) > 0
cLine := left(cFile, nPos - 1)
cFile := substr(cFile, nPos + 1)
if !empty(cLine)
if 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]
elseif Left(cLine, 1) == ';' // preserve comments
AAdd( CurrArray, { NIL, cLine } )
else
if (nPos := At('=', cLine)) > 0
cIdent := Left(cLine, nPos - 1)
cLine := SubStr(cLine, nPos + 1)
AAdd( CurrArray, { cIdent, cLine } )
else
AAdd( CurrArray, { cLine, '' } )
endif
endif
cLine := '' // to stop prepend later on
endif
else
cLine := cFile
cFile := ''
endif
end
end
fclose(hFile)
endif
return Self
static function ReadString(cSection, cIdent, cDefault)
local Self := QSelf()
local cResult := cDefault
local i, j, cFind
if Empty(cSection)
cFind := lower(cIdent)
j := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind .and. ValType(x[2]) == 'C'} )
if j > 0
cResult := ::Contents[j][2]
endif
else
cFind := lower(cSection)
i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind} )
if i > 0
cFind := lower(cIdent)
j := AScan( ::Contents[i][2], {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind} )
if j > 0
cResult := ::Contents[i][2][j][2]
endif
endif
endif
return cResult
static procedure WriteString(cSection, cIdent, cString)
local Self := QSelf()
local i, j, cFind
if Empty(cIdent)
outerr('Must specify an identifier')
elseif Empty(cSection)
cFind := lower(cIdent)
j := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind .and. ValType(x[2]) == 'C'} )
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| valtype(x[1]) == 'C' .and. lower(x[1]) == cFind .and. ValType(x[2]) == 'A'})) > 0
cFind := lower(cIdent)
j := AScan( ::Contents[i][2], {|x| valtype(x[1]) == 'C' .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
static function ReadNumber(cSection, cIdent, nDefault)
local Self := QSelf()
return Val( ::ReadString(cSection, cIdent, str(nDefault)) )
static procedure WriteNumber(cSection, cIdent, nNumber)
local Self := QSelf()
::WriteString( cSection, cIdent, alltrim(str(nNumber)) )
return
static function ReadDate(cSection, cIdent, dDefault)
local Self := QSelf()
return SToD( ::ReadString(cSection, cIdent, DToS(dDefault)) )
static procedure WriteDate(cSection, cIdent, dDate)
local Self := QSelf()
::WriteString( cSection, cIdent, DToS(dDate) )
return
static function ReadBool(cSection, cIdent, lDefault)
local Self := QSelf()
local cDefault := Iif( lDefault, '.t.', '.f.' )
return ::ReadString(cSection, cIdent, cDefault) == '.t.'
static procedure WriteBool(cSection, cIdent, lBool)
local Self := QSelf()
::WriteString( cSection, cIdent, Iif(lBool, '.t.', '.f.') )
return
static procedure DeleteKey(cSection, cIdent)
local Self := QSelf()
local i, j
cSection := lower(cSection)
i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cSection} )
if i > 0
cIdent := lower(cIdent)
j := AScan( ::Contents[i][2], {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cIdent} )
ADel( ::Contents[i][2], j )
ASize( ::Contents[i][2], Len(::Contents[i][2]) - 1 )
endif
return
static procedure EraseSection(cSection)
local Self := QSelf()
local i
if Empty(cSection)
while (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. ValType(x[2]) == 'C'})) > 0
ADel( ::Contents, i )
ASize( ::Contents, len(::Contents) - 1 )
end
else
cSection := lower(cSection)
if (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. lower(x[1]) == cSection .and. ValType(x[2]) == 'A'})) > 0
ADel( ::Contents, i )
ASize( ::Contents, Len(::Contents) - 1 )
endif
endif
return
static function ReadSection(cSection)
local Self := QSelf()
local i, j, aSection := {}
if Empty(cSection)
for i := 1 to len(::Contents)
if valtype(::Contents[i][1]) == 'C' .and. valtype(::Contents[i][2]) == 'C'
aadd(aSection, ::Contents[i][1])
endif
next
else
cSection := lower(cSection)
if (i := AScan( ::Contents, {|x| valtype(x[1]) == 'C' .and. x[1] == cSection .and. ValType(x[2]) == 'A'})) > 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
static function ReadSections()
local Self := QSelf()
local i, aSections := {}
for i := 1 to Len(::Contents)
if ValType(::Contents[i][2]) == 'A'
AAdd(aSections, ::Contents[i][1])
endif
next
return aSections
static procedure UpdateFile()
local Self := QSelf()
local i, j, hFile
hFile := fcreate(::Filename)
for i := 1 to Len(::Contents)
if ::Contents[i][1] == NIL
fwrite(hFile, ::Contents[i][2] + Chr(13) + Chr(10))
elseif ValType(::Contents[i][2]) == 'A'
fwrite(hFile, '[' + ::Contents[i][1] + ']' + Chr(13) + Chr(10))
for j := 1 to Len(::Contents[i][2])
if ::Contents[i][2][j][1] == NIL
fwrite(hFile, ::Contents[i][2][j][2] + Chr(13) + Chr(10))
else
fwrite(hFile, ::Contents[i][2][j][1] + '=' + ::Contents[i][2][j][2] + Chr(13) + Chr(10))
endif
next
fwrite(hFile, Chr(13) + Chr(10))
elseif ValType(::Contents[i][2]) == 'C'
fwrite(hFile, ::Contents[i][1] + '=' + ::Contents[i][2] + Chr(13) + Chr(10))
endif
next
fclose(hFile)
return

385
harbour/samples/guestbk/testcgi.prg Normal file
View File

@@ -0,0 +1,385 @@
//
// $Id$
//
/*
*
* TestCGI.PRG
* Harbour Test of a CGI/HTML-Generator class.
*
* 1999/05/30 First implementation.
*
* Tips: - Use ShowResults to make dynamic html (to test dynamic
* results, put the exe file on CGI-BIN dir or equivalent);
* - Use SaveToFile to make static html page
*
* 1999/05/31 Initial CGI functionality.
* 1999/06/01 Translated %nn to correct chars.
* 1999/06/02 Dynamic TAG matching routines (inspired on Delphi).
* First attempt to convert Delphi's ISAPI dll of WebSites'
* Function List
* (See http://www.flexsys-ci.com/harbour-project/functions.htm)
* 1999/06/11 List can be viewed online at
* http://www.flexsys-ci.com/cgi-bin/testcgi.exe
* 1999/07/29 Changed qOut() calls to OutStd() calls.
*
**/
#include "cgi.ch"
#include "harbour.ch"
#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
i := 1
FOR i := 1 TO nSize
nPosFim := at( cDelim, cBuf )
IF nPosFim > 0
aElem[i] := substr( cBuf, 1, nPosFim - 1 )
ELSE
aElem[i] := cBuf
ENDIF
cBuf := substr( cBuf, nPosFim + 1, len( cBuf ) )
NEXT i
RETURN( aElem[ nRet ] )
FUNCTION Hex2Dec( cHex )
LOCAL aHex := { { "0", 00 }, ;
{ "1", 01 }, ;
{ "2", 02 }, ;
{ "3", 03 }, ;
{ "4", 04 }, ;
{ "5", 05 }, ;
{ "6", 06 }, ;
{ "7", 07 }, ;
{ "8", 08 }, ;
{ "9", 09 }, ;
{ "A", 10 }, ;
{ "B", 11 }, ;
{ "C", 12 }, ;
{ "D", 13 }, ;
{ "E", 14 }, ;
{ "F", 15 } }
LOCAL nRet
LOCAL nRes
nRet := ascan( aHex, { |x| upper( x[1] ) = upper( left( cHex, 1 ) ) } )
nRes := aHex[nRet, 2] * 16
nRet := ascan( aHex, { |x| upper( x[1] ) = upper( right( cHex, 1 ) ) } )
nRes += aHex[nRet, 2]
RETURN( nRes )
/*-------------------------------------------------------------------------*/
FUNCTION THTML
STATIC oClass
IF oClass == NIL
oClass = TClass():New( "THTML" )
oClass:AddData( "cTitle" ) // Page Title
oClass:AddData( "cBody" ) // HTML Body Handler
oClass:AddData( "cBGColor" ) // Background Color
oClass:AddData( "cLinkColor" ) // Link Color
oClass:AddData( "cvLinkColor" ) // Visited Link Color
oClass:AddData( "cContent" ) // Page Content Handler
oClass:AddData( "aCGIContents" )
oClass:AddData( "aQueryFields" )
oClass:AddData( "cHTMLFile" )
oClass:AddData( "aReplaceTags" )
oClass:AddMethod( "New", @New() ) // New Method
oClass:AddMethod( "SetTitle", @SetTitle() ) // Set Page Title
oClass:AddMethod( "AddHead", @AddHead() ) // Add <H1> Header
oClass:AddMethod( "AddLink", @AddLink() ) // Add Hyperlink
oClass:AddMethod( "AddPara", @AddPara() ) // Add Paragraph
oClass:AddMethod( "SaveToFile", @SaveToFile() ) // Saves Content to File
oClass:AddMethod( "ShowResult", @ShowResult() ) // Show Result - SEE Fcn
oClass:AddMethod( "Generate", @Generate() ) // Generate HTML
oClass:AddMethod( "SetHTMLFile",@SetHTMLFile() ) // Sets source HTML file
oClass:AddMethod( "ProcessCGI", @ProcessCGI() )
oClass:AddMethod( "GetCGIParam", @GetCGIParam() )
oClass:AddMethod( "QueryFields", @QueryFields() )
oClass:AddMethod( "AddReplaceTag", @AddReplaceTag() )
oClass:Create()
ENDIF
RETURN( oClass:Instance() )
STATIC FUNCTION New()
LOCAL Self := QSelf()
::cTitle := "Untitled"
::cBGColor := "#FFFFFF"
::cLinkColor := "#0000FF"
::cvLinkColor := "#FF0000"
::cContent := ""
::cBody := ""
::aCGIContents := {}
::aQueryFields := {}
::aReplaceTags := {}
::cHTMLFile := ""
RETURN( Self )
STATIC FUNCTION SetTitle( cTitle )
LOCAL Self := QSelf()
::cTitle := cTitle
RETURN( Self )
STATIC FUNCTION AddLink( cLinkTo, cLinkName )
LOCAL Self := QSelf()
::cBody := ::cBody + ;
"<A HREF='" + cLinkTo + "'>" + cLinkName + "</A>"
RETURN( Self )
STATIC FUNCTION AddHead( cDescr )
LOCAL Self := QSelf()
// Why this doesn't work?
// ::cBody += ...
// ???
::cBody := ::cBody + ;
"<H1>" + cDescr + "</H1>"
RETURN( NIL )
STATIC FUNCTION AddPara( cPara, cAlign )
LOCAL Self := QSelf()
::cBody := ::cBody + ;
"<P ALIGN='" + cAlign + "'>" + hb_OSNewLine() + ;
cPara + hb_OSNewLine() + ;
"</P>"
RETURN( Self )
STATIC FUNCTION Generate()
LOCAL Self := QSelf()
LOCAL cFile, i, hFile, nPos, cRes := ""
LOCAL lFlag := .f.
// Is this a meta file or hand generated script?
IF empty( ::cHTMLFile )
::cContent := ;
"<HTML><HEAD>" + hb_OSNewLine() + ;
"<TITLE>" + ::cTitle + "</TITLE>" + hb_OSNewLine() + ;
"<BODY link='" + ::cLinkColor + "' " + ;
"vlink='" + ::cvLinkColor + "'>" + + hb_OSNewLine() + ;
::cBody + hb_OSNewLine() + ;
"</BODY></HTML>"
ELSE
::cContent := ""
// Does cHTMLFile exists?
IF !File( ::cHTMLFile )
::cContent := "<H1>Server Error</H1><P><I>No such file: " + ;
::cHTMLFile
ELSE
// Read from file
hFile := fOpen( ::cHTMLFile, 0 )
cFile := space( IF_BUFFER )
DO WHILE (nPos := fRead( hFile, @cFile, IF_BUFFER )) > 0
cFile := left( cFile, nPos )
cRes += cFile
cFile := space( IF_BUFFER )
ENDDO
fClose( hFile )
// Replace matched tags
i := 1
::cContent := cRes
/* TODO: Replace this DO WHILE with FOR..NEXT */
DO WHILE i <= len( ::aReplaceTags )
::cContent := strtran( ::cContent, ;
"<#" + ::aReplaceTags[i, 1] + ">", ::aReplaceTags[i, 2] )
i++
ENDDO
/* TODO: Clear remaining (not matched) tags */
/*
cRes := ""
FOR i := 1 TO len( ::cContent )
IF substr( ::cContent, i, 1 ) == "<" .AND. ;
substr( ::cContent, i + 1, 1 ) == "#"
lFlag := .t.
ELSEIF substr( ::cContent, i, 1 ) == ">" .AND. lFlag
lFlag := .f.
ELSEIF !lFlag
cRes += substr( ::cContent, i, 1 )
ENDIF
NEXT i
::cContent := cRes
*/
ENDIF
ENDIF
RETURN( Self )
STATIC FUNCTION ShowResult()
LOCAL Self := QSelf()
OutStd( ;
"HTTP/1.0 200 OK" + hb_OSNewLine() + ;
"CONTENT-TYPE: TEXT/HTML" + hb_OSNewLine() + hb_OSNewLine() + ;
::cContent )
RETURN( Self )
STATIC FUNCTION SaveToFile( cFile )
LOCAL Self := QSelf()
LOCAL hFile := fCreate( cFile )
fWrite( hFile, ::cContent )
fClose( hFile )
RETURN( Self )
STATIC FUNCTION ProcessCGI()
LOCAL Self := QSelf()
LOCAL cQuery := ""
LOCAL cBuff := ""
LOCAL nBuff := 0
LOCAL i
IF empty( ::aCGIContents )
::aCGIContents := { ;
GetEnv( "SERVER_SOFTWARE" ), ;
GetEnv( "SERVER_NAME" ), ;
GetEnv( "GATEWAY_INTERFACE" ), ;
GetEnv( "SERVER_PROTOCOL" ), ;
GetEnv( "SERVER_PORT" ), ;
GetEnv( "REQUEST_METHOD" ), ;
GetEnv( "HTTP_ACCEPT" ), ;
GetEnv( "HTTP_USER_AGENT" ), ;
GetEnv( "HTTP_REFERER" ), ;
GetEnv( "PATH_INFO" ), ;
GetEnv( "PATH_TRANSLATED" ), ;
GetEnv( "SCRIPT_NAME" ), ;
GetEnv( "QUERY_STRING" ), ;
GetEnv( "REMOTE_HOST" ), ;
GetEnv( "REMOTE_ADDR" ), ;
GetEnv( "REMOTE_USER" ), ;
GetEnv( "AUTH_TYPE" ), ;
GetEnv( "CONTENT_TYPE" ), ;
GetEnv( "CONTENT_LENGTH" ), ;
GetEnv( "ANNOTATION_SERVER" ) ;
}
cQuery := ::GetCGIParam( CGI_QUERY_STRING )
IF !empty( cQuery )
::aQueryFields := {}
FOR i := 1 TO len( cQuery ) + 1
IF i > len( cQuery ) .OR. substr( cQuery, i, 1 ) == "&"
aadd( ::aQueryFields, ;
{ substr( cBuff, 1, at( "=", cBuff ) - 1 ), ;
strtran( substr( cBuff, at( "=", cBuff ) + 1, ;
len( cBuff ) - at( "=", cBuff ) + 1 ), "+", " " ) } )
cBuff := ""
ELSE
IF substr( cQuery, i, 1 ) = "%"
cBuff += chr( Hex2Dec( substr( cQuery, i + 1, 2 ) ) )
nBuff := 3
ENDIF
IF nBuff = 0
cBuff += substr( cQuery, i, 1 )
ELSE
nBuff--
ENDIF
ENDIF
NEXT
ENDIF
ENDIF
RETURN( Self )
STATIC FUNCTION GetCGIParam( nParam )
LOCAL Self := QSelf()
::ProcessCGI()
IF nParam > 20 .OR. nParam < 1
outerr( "Invalid CGI parameter" )
RETURN( NIL )
ENDIF
RETURN( ::aCGIContents[nParam] )
STATIC FUNCTION QueryFields( cQueryName )
LOCAL Self := QSelf()
LOCAL cRet := ""
LOCAL nRet
::ProcessCGI()
nRet := aScan( ::aQueryFields, ;
{ |x| upper( x[1] ) = upper( cQueryName ) } )
IF nRet > 0
cRet := ::aQueryFields[nRet, 2]
ENDIF
RETURN( cRet )
STATIC FUNCTION SetHTMLFile( cFile )
LOCAL Self := QSelf()
::cHTMLFile := cFile
RETURN( Self )
STATIC FUNCTION AddReplaceTag( cTag, cReplaceText )
LOCAL Self := QSelf()
aAdd( ::aReplaceTags, { cTag, cReplaceText } )
RETURN( Self )

22
harbour/samples/hscript/Makefile Normal file
View File

@@ -0,0 +1,22 @@
#
# $Id$
#
ROOT = ../../
PRG_SOURCES=\
hscript.prg \
PRG_MAIN=hscript.prg
LIBS=\
runner \
tools \
debug \
rdd \
vm \
rdd \
rtl \
pp \
include $(TOP)$(ROOT)config/bin.cf

27
harbour/samples/hscript/bld32exe.bat
View File

@@ -1,27 +0,0 @@
@echo off
IF A%1 == A GOTO :SINTAX
IF A%2 == A GOTO :NOOUTPUT
echo -O2 -e%2.exe -I..\..\include ..\..\source\vm\hvm.c %1.c > b32.bc
echo ..\..\libs\b32\harbour.lib ..\..\libs\b32\terminal.lib >> b32.bc
echo ..\..\libs\b32\hbgt.lib >> b32.bc
bcc32 @b32.bc
del b32.bc
GOTO :END
:NOOUTPUT
echo -O2 -e%1.exe -I..\..\include ..\..\source\vm\hvm.c %1.c > b32.bc
echo ..\..\libs\b32\harbour.lib ..\..\libs\b32\terminal.lib >> b32.bc
echo ..\..\libs\b32\hbgt.lib >> b32.bc
echo ..\runner.obj >> b32.bc
bcc32 @b32.bc
del b32.bc
GOTO :END
:SINTAX
ECHO syntax: BuildExe Harbour_Output_Filename [Exe_Output_Filename]
ECHO Use Harbour_Output_Filename and Exe_Output_Filename without extensions
ECHO\
:END

8
harbour/samples/hscript/bld_b32.bat Normal file
View File

@@ -0,0 +1,8 @@
@echo off
rem
rem $Id$
rem
..\..\bin\harbour hscript /n /i..\..\include
bcc32 -ehscript.exe -O2 -I..\..\include -L..\..\lib\b32 -v harbour.lib terminal.lib hbpp.lib hbgt.lib rdd.lib hscript.c
rem del hscript.c

10
harbour/samples/hscript/dir.hs
View File

@@ -32,11 +32,11 @@ FUNCTION Main()
FOR i := 1 TO len( aDir )
%>
<TR>
<TD><% OutStr( aDir[i,1] ) %></TD>
<TD><% OutStr( aDir[i,2] ) %></TD>
<TD><% OutStr( aDir[i,3] ) %></TD>
<TD><% OutStr( aDir[i,4] ) %></TD>
<TD><% OutStr( aDir[i,5] ) %></TD>
<TD><% OutStd( aDir[i,1] ) %></TD>
<TD><% OutStd( aDir[i,2] ) %></TD>
<TD><% OutStd( aDir[i,3] ) %></TD>
<TD><% OutStd( aDir[i,4] ) %></TD>
<TD><% OutStd( aDir[i,5] ) %></TD>
</TR>
<%
NEXT

10
harbour/samples/hscript/hb32.bat
View File

@@ -1,10 +0,0 @@
@echo off
REM From .PRG to .C = Harbour
..\..\bin\harbour %1.prg /n /i..\..\include
if errorlevel 1 goto end
REM From .C to .EXE = BuildExe
call BLD32EXE %1 %2
:end

118
harbour/samples/hscript/hscript.prg
View File

@@ -1,48 +1,50 @@
/*
* $Id$
*
* HScript.PRG
* HarbourScript translation engine
*
*
* Copyright (C) 1999 Felipe Coury <fcoury@flexsys-ci.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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
* 1999/06/13 First implementation.
* 1999/06/24 Enhanced tag matching routines.
* 1999/07/26 Corrections to CGI output, qOut() -> OutStd().
*
**/
* $Id$
*/
#include "CGI.ch"
/*
* HScript.PRG
* HarbourScript translation engine
*
*
* Copyright (C) 1999 Felipe Coury <fcoury@flexsys-ci.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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
* 1999/06/13 First implementation.
* 1999/06/24 Enhanced tag matching routines.
* 1999/07/26 Corrections to CGI output, qOut() -> OutStd().
*
*/
#include "hbextern.ch"
#include "cgi.ch"
#define IF_BUFFER 65535
#ifdef __HARBOUR__
#define NewLine chr(10)
#else
#define NewLine chr(13)
#endif
REQUEST DIRECTORY
REQUEST GETENV
REQUEST ASORT
FUNCTION Main( cScript )
@@ -75,14 +77,14 @@ FUNCTION Main( cScript )
IF empty( cScriptName )
IF !empty( GetEnv( "SERVER_NAME" ) )
OutStd( "content-type: text/html" + NewLine )
OutStd( NewLine )
OutStd( "<HTML><BODY><H1>Server Error</H1><P>" + NewLine )
OutStd( "Must specify scriptname using hscript.exe?script=<scriptname>" + NewLine )
OutStd( "</BODY></HTML>" + NewLine )
OutStd( "content-type: text/html" + hb_OSNewLine() )
OutStd( hb_OSNewLine() )
OutStd( "<HTML><BODY><H1>Server Error</H1><P>" + hb_OSNewLine() )
OutStd( "Must specify scriptname using hscript.exe?script=<scriptname>" + hb_OSNewLine() )
OutStd( "</BODY></HTML>" + hb_OSNewLine() )
ELSE
OutStd( "Please give .hs name" + NewLine )
OutStd( "Please give .hs name" + hb_OSNewLine() )
ENDIF
@@ -92,9 +94,9 @@ FUNCTION Main( cScript )
// Script not found
IF !file( cScriptName )
IF !empty( GetEnv( "SERVER_NAME" ) )
OutStd( "CONTENT-TYPE: text/html" + NewLine )
OutStd( "CONTENT-TYPE: text/html" + hb_OSNewLine() )
ENDIF
OutStd( "<H1>Server Error</H1><P>Script not found: " + cScriptName + NewLine )
OutStd( "<H1>Server Error</H1><P>Script not found: " + cScriptName + hb_OSNewLine() )
EXIT
ENDIF
@@ -122,7 +124,7 @@ FUNCTION Main( cScript )
// Abre script
IF i > 1
//cTrans += " ; "
cTrans += NewLine
cTrans += hb_OSNewLine()
ENDIF
IF i + 1 < nLen
cTrans += "OutStd( '"
@@ -142,7 +144,7 @@ FUNCTION Main( cScript )
lOpen := .f.
IF i < nLen
// cTrans += " ; "
cTrans += NewLine
cTrans += hb_OSNewLine()
ENDIF
ENDIF
@@ -174,13 +176,13 @@ FUNCTION Main( cScript )
fClose( hFile )
// Creates the temporary HRB, erases the PRG
__Run( cHarbourDir + "harbour.exe " + cFile + " /q /n /gHRB /o" + ;
left( cHarbourDir, len( cHarbourDir ) - 1 ) )
__Run( cHarbourDir + "harbour.exe " + cFile + " /q /n /gh /o" + ;
left( cHarbourDir, len( cHarbourDir ) - 1 ) + "\" )
fErase( cFile )
// Runs using Tugboat
cFile := strtran( upper( cFile ), ".PRG", ".HRB" )
HB_Run( cFile )
cFile := strtran( upper( cFile ), ".PRG", ".hrb" )
__hrbRun( cFile )
// Erases the HRB file
fErase( cFile )
@@ -203,14 +205,14 @@ FUNCTION ParseString( cString, cDelim, nRet )
FOR i := 1 TO nSize
nPosFim := at( cDelim, cBuf )
IF nPosFim > 0
IF nPosFim > 0
aElem[i] := substr( cBuf, 1, nPosFim - 1 )
ELSE
aElem[i] := cBuf
ENDIF
cBuf := substr( cBuf, nPosFim + 1, len( cBuf ) )
NEXT i
RETURN( aElem[ nRet ] )

2
harbour/samples/hscript/makehs.bat
View File

@@ -1,2 +0,0 @@
@echo off
call hb32 hscript

13
harbour/samples/hscript/makehtm.bat
View File

@@ -1,12 +1,17 @@
@echo off
rem
rem $Id$
rem
IF NOT EXIST hscript.exe GOTO :missing
:start
SET HARBOUR_DIR=\HARBOUR\BIN\
SET HARBOURDIR=.\
hscript hello.hs >hello.htm
hscript multiply.hs >multiply.htm
hscript dir.hs >dir.htm
hscript hello.hs > hello.htm
hscript multiply.hs > multiply.htm
hscript dir.hs > dir.htm
hscript ugly.hs > ugly.htm
cls
echo Ready to go!

47
harbour/samples/misc/Makefile Normal file
View File

@@ -0,0 +1,47 @@
#
# $Id$
#
ROOT = ../../
LIBS=\
tools \
debug \
rtl \
rdd \
vm \
rdd \
rtl \
pp \
runner \
ifeq ($(PM),)
PM := $(pm)
endif
ifeq ($(PM),) # PM not defined = build all files
PRG_SOURCES=\
guess.prg \
mankala.prg \
PRG_HEADERS=\
C_SOURCES=\
C_HEADERS=\
include $(TOP)$(ROOT)config/test.cf
else #PM defined = build specified file
ifneq ($(findstring .prg,$(PM)),)
PRG_MAIN := $(PM)
else
ifneq ($(findstring .PRG,$(PM)),)
PRG_MAIN := $(PM)
else
PRG_MAIN := $(PM).prg
endif
endif
include $(TOP)$(ROOT)config/bin.cf
endif

6
harbour/tests/guess.prg → harbour/samples/misc/guess.prg
View File

@@ -1,6 +1,6 @@
//
// $Id$
//
/*
* $Id$
*/
//
// Guess a number

6
harbour/tests/mankala.prg → harbour/samples/misc/mankala.prg
View File

@@ -1,6 +1,6 @@
//
// $Id$
//
/*
* $Id$
*/
//
// Mankala. The first Harbour board game.

2
harbour/tests/Makefile
View File

@@ -71,7 +71,6 @@ PRG_SOURCES=\
fornext2.prg \
fortest.prg \
funcarr.prg \
guess.prg \
hardcr.prg \
hello.prg \
ifelse.prg \
@@ -87,7 +86,6 @@ PRG_SOURCES=\
longdev.prg \
longstr.prg \
longstr2.prg \
mankala.prg \
mathtest.prg \
memfile.prg \
memvar.prg \

20
harbour/tests/testcgi.prg
View File

@@ -28,15 +28,11 @@
#include "cgi.ch"
#define IF_BUFFER 65535
STATIC s_cNewLine
FUNCTION Main()
LOCAL oHTML := THTML():New()
LOCAL hFile, nPos, cString, cBuf, i, cTable, cLine
s_cNewLine := HB_OSNewLine()
oHTML:SetHTMLFile( "function.cfm" )
hFile := fOpen( "list.txt", 0 )
@@ -246,8 +242,8 @@ STATIC FUNCTION AddPara( cPara, cAlign )
LOCAL Self := QSelf()
::cBody := ::cBody + ;
"<P ALIGN='" + cAlign + "'>" + s_cNewLine + ;
cPara + s_cNewLine + ;
"<P ALIGN='" + cAlign + "'>" + HB_OSNewLine() + ;
cPara + HB_OSNewLine() + ;
"</P>"
RETURN( Self )
@@ -261,11 +257,11 @@ STATIC FUNCTION Generate()
// Is this a meta file or hand generated script?
IF empty( ::cHTMLFile )
::cContent := ;
"<HTML><HEAD>" + s_cNewLine + ;
"<TITLE>" + ::cTitle + "</TITLE>" + s_cNewLine + ;
"<HTML><HEAD>" + HB_OSNewLine() + ;
"<TITLE>" + ::cTitle + "</TITLE>" + HB_OSNewLine() + ;
"<BODY link='" + ::cLinkColor + "' " + ;
"vlink='" + ::cvLinkColor + "'>" + + s_cNewLine + ;
::cBody + s_cNewLine + ;
"vlink='" + ::cvLinkColor + "'>" + + HB_OSNewLine() + ;
::cBody + HB_OSNewLine() + ;
"</BODY></HTML>"
ELSE
::cContent := ""
@@ -325,8 +321,8 @@ STATIC FUNCTION ShowResult()
LOCAL Self := QSelf()
OutStd( ;
"HTTP/1.0 200 OK" + s_cNewLine + ;
"CONTENT-TYPE: TEXT/HTML" + s_cNewLine + s_cNewLine + ;
"HTTP/1.0 200 OK" + HB_OSNewLine() + ;
"CONTENT-TYPE: TEXT/HTML" + HB_OSNewLine() + HB_OSNewLine() + ;
::cContent )
RETURN( Self )