DECLARE FUNCTION evaluate% ()
DECLARE SUB StrTok (Params$(), CountParams%, Delimiter$, Tokens$)
DECLARE SUB parseoptval (record$, opt$, value$, Delimiter$)
DECLARE FUNCTION getrecord$ ()
DECLARE FUNCTION CGIEdit$ (x$)
DECLARE FUNCTION ReadCGI$ () 'as string

'GLOBAL outfile$

'global Query_Method as string
'
'   BLDDB - Builds a comma delimited flat file from data entered
'       in an HTML form.
'
'   by Thomas Wm. Madron
'
'   Copyright 1998 by Enterprise-Wide Computing, Inc.
'
'   For information write info@ewc-inc.com
'
'   Notes:
'
'       1.  The data file that is written must be written to a
'           directory that can be written by anyone, such as /tmp,
'           or one that is owned by the userid under which the
'           web server is running (often, under Unix systems,
'           a user named "nobody").  On Win95/98 machines it will
'           write anywhere.  On WinNT machines the permissions
'           issue is the same as on Unix except that directory
'           names may differ.
'
'   Call the main function
'
'FUNCTION PBMAIN () AS LONG
outfile$ = ""
a% = evaluate%
'END function
END

FUNCTION CGIEdit$ (x$) STATIC
'
'   Edits the special characters used in strings generated by
'   an HTML form.
'
'   The plus sign (+) is used as a standin for a space.
'   Other special characters are translated into their two
'       character HEX ascii codes, prefaced with a percentage
'       (%) sign.  If the decimal equivalent of the ascii code
'       is >= 32 (space) and <= 126 (tilde (~)), then the actual
'       character is substituted.  If the character is anything
'       else, a space (32) is substituted.  Finer distinctions
'       could, of course, be written into the function.
'   An ampersand (%) is used as a field delimiter.  This is left
'       asis and must be handled elsewhere.
'
    STATIC rec$, i%, ii%, a$, b$, c%
    rec$ = x$
    i% = 1
    DO
	  ii% = INSTR(i%, rec$, "%")
	  IF ii% > 0 THEN
		a$ = LEFT$(rec$, ii% - 1)
		b$ = MID$(rec$, ii% + 3)
		c% = VAL("&H" + MID$(rec$, ii% + 1, 2))
		IF c% >= 32 AND c% <= 126 THEN
		   rec$ = a$ + CHR$(c%) + b$
		ELSE
		   rec$ = a$ + " " + b$
		END IF
		i% = i% + 1
	  ELSE
		i% = i% + 1
		ii% = INSTR(i%, rec$, "+")
		IF ii% > 0 THEN
			 MID$(rec$, ii%, 1) = " "
		ELSE
		   EXIT DO
		END IF
	  END IF
    LOOP
    CGIEdit$ = rec$
END FUNCTION

FUNCTION evaluate%

DIM Params$(1 TO 100), rec$(1 TO 100), ptmp$(1 TO 50)

q$ = CHR$(34)
Delimiter$ = "~"
Tokens$ = COMMAND$
CALL StrTok(Params$(), CountParams%, Delimiter$, Tokens$)
IF CountParams% > 0 THEN
    FOR i% = 1 TO CountParams%
	  opt$ = UCASE$(LEFT$(LTRIM$(Params$(i%)), 1))
	  value$ = LTRIM$(RTRIM$(MID$(Params$(i%), 2)))
	   SELECT CASE opt$
'           [place other case statements here]
		  CASE "?", "H" ' help
			GOSUB syntax
		  CASE "O" ' output file spec
			outfile$ = value$
		  CASE ELSE
			'continue
	  END SELECT
    NEXT i%
'ELSE ' [if required remove first single quote]
    'GOSUB errormsg ' [if required remove first single quote]
END IF
'
'   Get and parse stdin from form.
'
record$ = ReadCGI$   ' getrecord$

record$ = CGIEdit$(record$)

'record$ = CGIEdit$(record$)
'tmpfile$ = "/home/httpd/html/ecmin/tst.log"
'tmpfile$ = "\home\httpd\html\ecmin\tst.log"
'open tmpfile$ for append as #5
'print #5, record$
'close #5

Delimiter$ = "&"
CALL StrTok(Params$(), CountParams%, Delimiter$, record$)
nf% = 0 ' number of fields counter
nphn% = 0 ' number of phone numbers compiled

'FOR i% = 1 TO CountParams%
knt% = 0
i% = 0
DO
	i% = i% + 1
	IF i% > CountParams% THEN EXIT DO
    ' In the html form there must be at least one hidden type following
    ' the definition of all fields.  It must be named "NFIELD" and its
    ' value must be the number of preceding data fields:  "NFIELD=nn":
    '
    '   <INPUT TYPE="HIDDEN" NAME="NFIELD" VALUE="nn">  REQUIRED!
    '
    ' Other, optional hidden types are allowed (but optional).  All these
    ' hidden fields must be placed following the data fields, but before
    ' the submit button.  The optional hidden types are:
    '
    '   <INPUT TYPE="HIDDEN" NAME="REQUIRED" VALUE="n1,n2,n3,n4,..nn">, where
    '       n1, n2, etc. are the required field numbers from the numbered
    '       fields.
    '   <INPUT TYPE="HIDDEN" NAME="GOTO" VALUE="someurl"> and
    '       <INPUT TYPE="HIDDEN" NAME="BNAME" VALUE="buttonname">, where
    '       "someurl" is a URL that is loaded when the button on the
    '       thankyou page is pressed, and "buttonname" is the label
    '       for the button.  If these two are omitted, then a navigational
    '       button will not be displayed.
    '   <INPUT TYPE="HIDDEN" NAME="PHONEna" VALUE="p1,p2,p3">, where
    '       n (in PHONEna)=a sequential number distinguishing one (compiled)
    '           phone number from another.
    '       A common way of collecting phone
    '       numbers is to break them up into three separate subfields.  And
    '       there may be more than a single phone number collected so there
    '       may be more than one derived phone field.  PHONEn MUST be numbered
    '       sequentially (i.e., 1,2,3, NOT 1,5,7 OR 2,3,1).  PHONE numbers may
    '       be voice phones, FAX phones, or DATA phones.  They will be placed
    '       in the output datarecord, at the end of all the numbered data fields,
    '       in the order in which they were encountered.  If phone numbers are
    '       placed in the HTML document, and if they need to be compiled,
    '       then they must be named PHONEn, FAXn, or DATAn.  They are all
    '       made equivalent by the program.
    '
    ' Other specialized fields may be added in the future.
    '
    tmp$ = Params$(i%)
    CALL parseoptval(tmp$, opt$, value$, "=")
	value$ = CGIEdit$(value$)
    opt$ = UCASE$(opt$)
    SELECT CASE opt$
		CASE "NFIELD"
		  NFIELD% = VAL(value$)
		CASE "GOTO"
		  urltarget$ = value$
		CASE "BNAME"
		  buttonname$ = value$
		CASE "REQUIRED"
		  	CALL StrTok(ptmp$(), np%, ",", value$)
			IF np% > 0 THEN
				FOR j% = 1 TO np%
					k% = VAL(ptmp$(j%))
					IF rec$(k%) = "" THEN
						GOSUB norequired
					END IF
				NEXT j%
			END IF
		CASE "OUTFILE"
			if outfile$ = "" then
				outfile$ = value$
			end if
		CASE "SUBMIT", "SU", "SUB", "SUBM", "SUBMI"
			' exit select
		CASE ELSE
			'   For fields that are to be saved in a file, then the data
			'   must be in the following format:
			'   OPTION = VALUE, where
			'   OPTION = n,OPTION, where
			'   n = desired order of the output data.
			'   "OPTION" in this case refers to the NAME parameter in an HTML
			'   INPUT statement.
			'   If n = 0, or there is not preceding number, then the field
			'   is ignored and not output to the data file.  A forms field
			'   to be saved will, therefore, have a format similar to the
			'   following (in this case "lastname" is the first saved field):
			'       <INPUT NAME="1,lastname" TYPE="TEXT" COLS=20 SIZE="20" ALIGN=left>
			'   It is VERY important that the range of n be
			'   1 to (the number of fields to be saved).
			CALL parseoptval(opt$, f$, opt$, ",")
		    fxnum% = VAL(f$)
			IF fxnum% > 0 THEN
				fx% = fxnum%
				opt2$ = UCASE$(opt$)
			ELSE
				opt2$ = UCASE$(f$)
			END IF
			IF LEFT$(opt2$, 5) = "PHONE" THEN opt2$ = "PHONE"
			IF LEFT$(opt2$, 4) = "DATA" THEN opt2$ = "DATA"
			IF LEFT$(opt2$, 3) = "FAX" THEN opt2$ = "FAX"
			SELECT CASE opt2$
				CASE "PHONE", "FAX", "DATA"
					knt% = knt% + 1
					SELECT CASE knt%
						CASE 1
							phone$ = value$ + "-"
						CASE 2
							phone$ = phone$ + value$ + "-"
						CASE 3
							phone$ = phone$ + value$
							rec$(fx%) = q$ + phone$ + q$
							phone$ = ""
							knt% = 0
						CASE ELSE
							' exit select
					END SELECT
				CASE ELSE
					IF fx% > 0 THEN
						rec$(fx%) = q$ + value$ + q$
					END IF
			END SELECT
    END SELECT
LOOP UNTIL i% > CountParams%

'gosub test

nf% = fx%
' Build and save output record
tmp$ = ""
FOR i% = 1 TO NFIELD% - 1
	tmp$ = tmp$ + rec$(i%) + ","
NEXT i%
tmp$ = tmp$ + rec$(NFIELD%)

'gosub test

IF outfile$ <> "" THEN
	OPEN outfile$ FOR APPEND AS #2
	'LOCK #2
	PRINT #2, tmp$
	print #2, record$
	'UNLOCK #2
	CLOSE #2
else
	gosub errormsg
END IF

GOSUB thankyou

EXIT FUNCTION 'END

syntax:
	PRINT "<pre>"
    PRINT "Enterprise-Wide Computing, Inc."
    PRINT "Copyright 1998 by Enterprise-Wide Computing, Inc."
    PRINT "For information email info@ewc-inc.com"
    PRINT ""
    PRINT "Syntax:  blddb [~?|H]~o outputfilespec (~o is required)"
    PRINT ""
    PRINT "In the html form there must be at least one hidden type following"
    PRINT "the definition of all fields.  It must be named " + "NFIELD" + " and its"
    PRINT "value must be the number of preceding data fields:  NFIELD = nn"
    PRINT ""
    PRINT "  <INPUT TYPE=" + q$ + "HIDDEN" + q$ + " NAME=" + q$ + "NFIELD" + q$ + " VALUE=" + q$ + "nn" + q$ + ">  REQUIRED!"
    PRINT ""
    PRINT "Other, optional hidden types are allowed (but optional).  All these"
    PRINT "hidden fields must be placed following the data fields, but before"
    PRINT "the submit button.  The optional hidden types are:"
    PRINT ""
    PRINT "  <INPUT TYPE=" + q$ + "HIDDEN" + q$ + " NAME=" + q$ + "REQUIRED" + q$ + " VALUE=" + q$ + "n1,n2,n3,n4,..nn" + q$ + ">, where"
    PRINT "      n1, n2, etc. are the required field numbers from the numbered"
    PRINT "      fields."
    PRINT "  <INPUT TYPE=" + q$ + "HIDDEN" + q$ + " NAME=" + q$ + "GOTO" + q$ + " VALUE=" + q$ + "someurl" + q$ + "> and"
    PRINT "      <INPUT TYPE=" + q$ + "HIDDEN" + q$ + " NAME=" + q$ + "BNAME" + q$ + " VALUE=" + q$ + "buttonname" + q$ + ">, where"
    PRINT "      " + q$ + "someurl" + q$ + " is a URL that is loaded when the button on the"
    PRINT "      thankyou page is pressed, and " + q$ + "buttonname" + q$ + " is the label"
    PRINT "      for the button.  If these two are omitted, then a navigational"
    PRINT "      button will not be displayed."
    PRINT "  <INPUT TYPE=" + q$ + "HIDDEN" + q$ + " NAME=" + q$ + "PHONEna" + q$ + " VALUE=" + q$ + "p1, p2, p3" + q$ + ">, where"
    PRINT "      n (in PHONEna)=a sequential number distinguishing one (compiled)"
    PRINT "          phone number from another."
    PRINT "      A common way of collecting phone"
    PRINT "      numbers is to break them up into three separate subfields.  And"
    PRINT "      there may be more than a single phone number collected so there"
    PRINT "      may be more than one derived phone field.  PHONEn MUST be numbered"
    PRINT "      sequentially (i.e., 1,2,3, NOT 1,5,7 OR 2,3,1).  PHONE numbers may"
    PRINT "      be voice phones, FAX phones, or DATA phones.  They will be placed"
    PRINT "      in the output datarecord, at the end of all the numbered data fields,"
    PRINT "      in the order in which they were encountered.  If phone numbers are"
    PRINT "      placed in the HTML document, and if they need to be compiled,"
    PRINT "      then they must be named PHONEn, FAXn, or DATAn.  They are all"
    PRINT "      made equivalent by the program."
    PRINT ""
    PRINT "Other specialized fields may be added in the future."
    PRINT ""
    PRINT "To page this output use 'blddb /? | more'"
    PRINT "</pre>"
    EXIT FUNCTION
RETURN

test:
    PRINT "Content-Type: text/html"
    PRINT ""
    PRINT "<html>"
    PRINT "<head><title>Test</title></head>"
    PRINT "<body bgcolor=white>"
    PRINT "<center><h2>Test!</h2></center>"
    PRINT "record$ = "+record$+"<br>"
	PRINT "<p>outfile$ = "+outfile$+"<br>"
    PRINT "</body></html>"
    EXIT FUNCTION
RETURN

errormsg:
    PRINT "Content-Type: text/html"
    PRINT ""
    PRINT "<html>"
    PRINT "<head><title>Error Message</title></head>"
    PRINT "<body bgcolor=white>"
    PRINT "<center><h2>No output filespec given!</h2></center>"
    PRINT "</body></html>"
    EXIT FUNCTION
RETURN

thankyou:
    PRINT "Content-Type: text/html"
    PRINT ""
    PRINT "<html>"
    PRINT "<head><title>Thank You</title></head>"
    PRINT "<body bgcolor=white>"
    PRINT "<center>"
    PRINT "<h2>Thank You!</h2>"
    PRINT "<h3>Your information has been saved</h3>"
    PRINT "<h3>You will hear from us soon</h3>"
    IF urltarget$ > "" THEN
	  PRINT "<div align=center>"
	  PRINT "<form>"
	  PRINT "<!-- this script and many more are available online from -->"
	  PRINT "<!-- the javascript source!! http://javascriptsource.com -->"
	  PRINT "<b><small>"
	  PRINT "<input type=" + q$ + "button" + q$ + " value=" + q$ + buttonname$ + q$
	  PRINT "onclick=" + q$ + "window.location = '" + urltarget$ + "'" + q$ + ">"
	  PRINT "</small></b>"
	  PRINT "</form>"
	  PRINT "</div>"
    END IF
    PRINT "</center>"
    PRINT "</body>"
    PRINT "</html>"
    EXIT FUNCTION 'END
RETURN

norequired:
    PRINT "Content-Type: text/html"
    PRINT ""
	PRINT "<HTML>"
	PRINT "<BODY BGCOLOR=" + q$ + "#FFFFFF" + q$ + ">"
	PRINT "  <CENTER>"
	PRINT "    <H1>Oops!</H1>"
	PRINT "    <B>You did not complete all of the required fields<BR>"
	PRINT "       Please press the button below to return to the form</B>"
	PRINT "    <div align=center>"
	PRINT "    <form>"
	PRINT "    <!-- this script and many more are available online from -->"
	PRINT "    <!-- the javascript source!! http://javascriptsource.com -->"
	PRINT "    <b><small>"
	PRINT "    <input type=" + q$ + "button" + q$ + " value=" + q$ + "  Try Again  " + q$ + " onclick=" + q$ + "history.go(-1)" + q$ + ">"
	PRINT "    </small></b>"
	PRINT "    </form>"
	PRINT "    </div>"
	PRINT "  </CENTER>"
	PRINT "</BODY>"
	PRINT "</HTML>"
	EXIT FUNCTION
RETURN

END FUNCTION

FUNCTION ReadCGI$() ' AS STRING
'
' 	Read data from the CGI script
'
  	'LOCAL Temp AS STRING
	static Temp$
	opt$ = ENVIRON$("REQUEST_METHOD")
	SELECT CASE opt$
		CASE "GET", "PUT", "HEAD"
			ReadCGI$ = ENVIRON$("QUERY_STRING")
		CASE "POST"
			length% = val(ENVIRON$("CONTENT_LENGTH"))
			for i% = 1 to length%
				y$ = inkey$
				Temp$ = Temp$ + y$
			next i%
      		ReadCGI$ = Temp$
		CASE ELSE   'assume the command line
			ReadCGI$ = COMMAND$
	END SELECT
END FUNCTION

'FUNCTION getrecord$
'    getrecord$ = ReadCGI$
'END FUNCTION

SUB parseoptval (record$, opt$, value$, Delimiter$) STATIC
    STATIC ii%, LenDelim%
    LenDelim% = LEN(Delimiter$)
    ii% = INSTR(record$, Delimiter$)
    IF ii% > 0 THEN
	 SELECT CASE ii%
	   CASE 1
		 opt$ = ""
	   CASE ELSE
		 opt$ = LTRIM$(RTRIM$(LEFT$(record$, ii% - 1)))
	 END SELECT
	 value$ = LTRIM$(RTRIM$(MID$(record$, ii% + LenDelim%)))
    ELSEIF ii% = 0 THEN
	 IF LEN(record$) > 0 THEN
	   opt$ = LTRIM$(RTRIM$(record$))
	 ELSE
	   opt$ = ""
	 END IF
	 value$ = ""
    END IF
END SUB

    SUB StrTok (Params$(), CountParams%, Delimiter$, Tokens$) STATIC
REM
REM Version 2.0 - allows for delimiters > 1; does NOT eliminate
REM               leading or trailing spaces from tokens.
REM
REM Purpose: To parse a list of tokens AND RETURN them
REM in Params$(i).
REM
REM Comment: Similar in purpose TO the C FUNCTION StrTok, this
REM procedure differs only in the fact that all tokens
REM are returned at once in an array rather than one at
REM a time. The number of tokens is returned in
REM CountParams%. On input, a single Delimiter$ must
REM be specified OR an error message will be returned; AND
REM one OR more Tokens must be contained in Token$,
REM separated by Delimiter$. Spaces can also be used
REM independently of Delimiter$ TO make the INPUT more
REM readable.
REM
    STATIC a$, ii%, b$
    CountParams% = 0
    LenDelim% = LEN(Delimiter$)
    IF Tokens$ = "" THEN
	  EXIT SUB
    END IF
    IF Delimiter$ = "" THEN
	  PRINT "* * * * * Delimiter not Specified * * * * *"
	  EXIT SUB
    END IF
    a$ = Tokens$
    DO
	  IF LEFT$(a$, LenDelim%) = Delimiter$ THEN
	   a$ = MID$(a$, LenDelim% + 1)
	  ELSE
	   GOTO exitloop
	   REM exit LOOP
	  END IF
    LOOP
exitloop:
    DO
	  ii% = INSTR(a$, Delimiter$)
	  IF ii% > 0 THEN
	   CountParams% = CountParams% + 1
	   b$ = LEFT$(a$, ii% - 1)
	   Params$(CountParams%) = b$
	   a$ = MID$(a$, ii% + LenDelim%)
	  ELSE
	   CountParams% = CountParams% + 1
	   Params$(CountParams%) = a$
	  END IF
    LOOP UNTIL ii% = 0
    END SUB

'FUNCTION ReadCGI$
'    ReadCGI$ = getrecord$
'END FUNCTION