#DEFINE CRLF CHR(13)+CHR(10)
#DEFINE WWWCAPTION_LOC 'WWW 数据服务程序'
#DEFINE NOFXTOOLS_LOC	'没有找到 FOXTOOLS.FLL'
#DEFINE NOIDC_LOC	"没有指定 .IDC 文件。服务程序不能继续执行。"
#DEFINE IDCNOTFOUND1_LOC	"指定的 .IDC 文件 ("
#DEFINE IDCNOTFOUND2_LOC	") 没有找到。服务程序不能继续执行。"
#DEFINE IDCBADDATA1_LOC ") 包含的数据不正确或不能被访问。没有找到模板输入项。服务程序不能继续执行。"
#DEFINE IDCBADDATA2_LOC	") 包含的数据不正确或不能被访问。没有找到 SQL 语句输入项。服务程序不能继续执行。"
#DEFINE BADSQL_LOC "不能理解由 IDC 文件提供的 SQL 语句。服务程序不能继续执行。"
#DEFINE NOSQL1_LOC	'SQL 语句的 FROM 子句中的表 ['
#DEFINE NOSQL2_LOC	'] 没有找到。<BR>指定的表的路径必须在数据服务程序的 VFPIS.INI 的 PATH 中指定。<BR>'+CRLF+'SQL 字串: <HR>'
#DEFINE BADCMD_LOC	'命令错误。<BR>请与系统管理员联系。<BR>'+CRLF+'SQL 字串: <HR>'
#DEFINE BADCONN1_LOC	"联结到"
#DEFINE BADCONN2_LOC	" 作为 "
#DEFINE BADCONN3_LOC	" 不能生成。服务程序不能继续执行。"
#DEFINE NOTEMPLATE_LOC '没有找到模板文件。服务程序不能继续执行。'
#DEFINE BADTEMPLATE1_LOC	'模板文件 ('
#DEFINE BADTEMPLATE2_LOC	') 不能打开。服务程序不能继续执行。'
#DEFINE BADTEMPLATE3_LOC	") 包含不匹配的 BeginDetail/EndDetail 结构。服务程序不能继续执行。"
#DEFINE BADTEMPLATE4_LOC	"说明行 "
#DEFINE BADTEMPLATE5_LOC	" 包含不匹配的符号结构。服务程序不能继续执行。"
#DEFINE BADTEMPLATE6_LOC	"模板文件包含有不正确的 IF 结构。服务程序不能继续执行。"
#DEFINE BADTEMPLATE7_LOC	" 包含不匹配的 If/EndIf 结构。服务程序不能继续执行。"
#DEFINE NODATASTREAM_LOC	"试图创建数据流时发生错误。服务程序不能继续执行。"
#DEFINE NOMATCHES_LOC		"没有发现匹配项。"
#DEFINE RETURNED_LOC		"返回"
#DEFINE FAILEDSEARCH_LOC	"FoxPro 搜索失败"
#DEFINE FALSE_LOC	"FALSE"
#DEFINE TRUE_LOC	"TRUE"
#DEFINE ERROCCUR_LOC	"错误发生于 :  "
#DEFINE ERRMESS_LOC		"错误消息  : "
#DEFINE ERRNUM_LOC		"错误号    :  "
#DEFINE ERRPROC_LOC		"过程名    :  "
#DEFINE ERRLINE_LOC		"行号      :  "
#DEFINE ERRALIAS_LOC	"别名      :  "
#DEFINE ERRREC_LOC		"记录号    :  "


LOCAL lcProgram,lcFullPath,lnAtPos,lcFoxTools,lcError,lcFileName
LOCAL lcScreenIcon,lcScreenCaption,lcSetPath,lnSelect
PRIVATE gcINIFile,gcHTTPRoot,gcScriptRoot,gcSemaphoreRoot,gcPath

SET TALK OFF
SET ESCAPE OFF
SET COLLATE TO 'MACHINE'
SET COMPATIBLE OFF
SET CONFIRM ON
SET DECIMALS TO 9
SET EXACT OFF
SET EXCLUSIVE OFF
SET MEMOWIDTH TO 1024
SET MULTILOCKS ON
SET POINT TO '.'
SET SAFETY OFF
SET UDFPARMS TO VALUE
SET MESSAGE TO ' '
lcProgram=SYS(16)
lnAtPos=RATC('\',lcProgram)
lcFullPath=LEFTC(lcProgram,lnAtPos)
CD (lcFullPath)
lcFoxTools='foxtools.fll'
IF NOT FILE(lcFoxTools)
	lcFoxTools=HOME()+lcFoxTools
ENDIF
IF NOT FILE(lcFoxTools)
	=MESSAGEBOX(NOFXTOOLS_LOC,16,_screen.Caption)
	RETURN .F.
ENDIF
ON ERROR
ERASE ERROR.txt
SET LIBRARY TO (lcFoxTools) ADDITIVE

lnSelect=SELECT()
lcSetPath=SET('PATH')
lcOnError=ON('ERROR')
lcScreenIcon=_screen.Icon
_screen.Icon='net13.ico'
lcScreenCaption=_screen.Caption
_screen.Caption=WWWCAPTION_LOC 

gcINIFile="vfpis.ini"
gcHTTPRoot=""
gcScriptRoot=""
gcSemaphoreRoot=FULLPATH('\temp\')
ON ERROR =.F.
MD (gcSemaphoreRoot)
ON ERROR
gcPath=""

ON ERROR DO ErrorHandler WITH ERROR(),MESSAGE(),PROGRAM(),LINENO(),MESSAGE(1)

*Read the initialization file and set up root paths.  If the
*INI file doesn't exist or is empty, ask the user to set one up.

IF FILE(gcINIFile)
	=readini(gcINIFile)
ENDIF
IF EMPTY(gcHTTPRoot)
	DO FORM SpecRoot
ENDIF
IF EMPTY(gcScriptRoot)
	gcScriptRoot=gcHTTPRoot
ENDIF
SET PATH TO (gcPath)
CLOSE ALL DATABASES
CLOSE ALL
lcFileName=LOWER(FULLPATH('querylog.dbf',lcProgram))
IF NOT FILE(lcFileName)
	CREATE TABLE (lcFileName) (TimeStamp T, IDCFile C(32), Parameters M)
	USE
ENDIF
USE (lcFileName) ALIAS QueryLog EXCLUSIVE

DO FORM server
CLOSE ALL DATABASES
CLOSE ALL
SELECT (lnSelect)
IF NOT EMPTY(lcScreenCaption)
	_screen.Caption=lcScreenCaption
ENDIF
IF NOT EMPTY(lcScreenIcon)
	_screen.Icon=lcScreenIcon
ENDIF
SET MESSAGE TO
SET PATH TO (lcSetPath)
IF EMPTY(lcError)
	ON ERROR
ELSE
	ON ERROR &lcError
ENDIF

RETURN



FUNCTION executeprocess(tcFileName)
LOCAL lcDataFile,lcAckFile,lnDFH,lnAFH,lcParameter

	lcDataFile=gcSemaphoreRoot+JustStem(ALLTRIM(tcFileName))+".dat"
	lcAckFile=gcSemaphoreRoot+JustStem(ALLTRIM(tcFileName))+".ack"
	lnDFH=FOPEN(lcDataFile)
	lcParameter=""
	IF lnDFH > 0
		DO WHILE NOT FEOF(lnDFH)
			lcParameter=lcParameter+FREAD(lnDFH,1000)
		ENDDO
		=FCLOSE(lnDFH)
		STRTOFILE(GenPage(lcParameter),lcDataFile)
		* Create Acknowledgement file
		STRTOFILE(" ",lcAckFile)
	ELSE
		* Error opening data file
	ENDIF
ENDFUNC


* HTML Page Generation Program
* This program takes a SQL Query, and several other parameters and
* generates an output document in HTML which can be used by a WWW
* Browser.
* This function goes for bulletproof simple error handling when it is interpreting
* an .HTX file.  If it runs into a logical error, it will simply attempt to continue.
****************
FUNCTION genpage(cParameters)

	LOCAL lnAtPos,lcFileName,lcAlias
	LOCAL lFailure, cResultPage, lcError, lnSelect
	LOCAL cSQLStatement, cKeyColumn, cDescriptColumn, ;
		cBackgroundImg, iCount, cTmpString, cPrevNext, ;
		IDCFile, lcTemplate, lcLine, lcTmpLine, ;
		lcLineCopy, lFailure, cExecSQLString, lhTemplate, llDone, ;
		llGetNewLine, lcTmpExp, lcExp1, lcExp2, lcOperator, lcIfStatement, ;
		lcTrueStatement, lcFalseStatement, lcHTMLPath, lcIDCFile, ;
		lcDefErr, llDefaultError, lcReturnData, llReturnData

	*These symbols, we want available in the sub programs.  They will all be available,
	*along with all of the parsed in environment variables, to the functions that execute
	*conditionals and detail lines.  This allows those functions to simply utilize their
	*environment.

	PRIVATE laEnvVariables, lnEnvVariables, IDC_DataSource, IDC_Template, ;
		IDC_SQLStatement, IDC_DefaultParameters, IDC_Expires, IDC_MaxFieldSize, ;
		IDC_Password, IDC_RequiredParameters, IDC_Username, laDefaultParameters, ;
		laRequiredParameters, CurrentRecord, laTables, CommandSuccess, ;
		lnRecordsReturned, IDC_MaxRecords

	CommandSuccess="FALSE"
	lcAlias=''

	*Parse out all of the environment variables and HTML variables that are
	*sent to us via the CGI script (contained in cParameters) and place them
	*in an array for ease of reference.  The variables are placed in an array
	*as VARIABLE_NAME, VALUE pairs.
	lnEnvVariables=0
	DIMENSION laEnvVariables[1,2]

	IF LEFT(cParameters,1)=='&'
		cParameters=ALLTRIM(SUBSTR(cParameters,2))
	ENDIF

	lnEnvVariables=ParseVars(cParameters,@laEnvVariables,.T.)

	*Parse out the contents of QUERY_STRING if it is not empty.
	IF NOT EMPTY(getparam("QUERY_STRING"))
		lnEnvVariables=ParseVars(getparam("QUERY_STRING"),@laEnvVariables)
	ENDIF

	*Find out if the user has turned off default error processing for the
	*executable command.
	lcDefErr=getparam("DefError")
	IF UPPER(ALLT(lcDefErr))=="OFF"
		llDefaultError=.F.
	ELSE
		llDefaultError=.T.
	ENDIF

	*Find out if the user would like the data back as a block of data.
	lcReturnData=getparam("ReturnAsFile")
	IF UPPER(ALLT(lcReturnData))=="ON"
		llReturnData=.T.
	ELSE
		llReturnData=.F.
	ENDIF

	*Build an absolute path representing where the calling HTML page was located.
	lcHTMLPath=BldPath()

	*Get pointer to .IDC file via passed in HTML parameter
	lcIDCFile=getparam("IDCFile")
	IF NOT EMPTY(lcIDCFile)
		m.IDCFile=LOWER(FULLPATH(lcIDCFile))
		IF NOT FILE(m.IDCFile)
			m.IDCFile=LOWER(FULLPATH(gcScriptRoot+lcIDCFile))
			IF NOT FILE(IDCFile)
				m.IDCFile=LOWER(FULLPATH(lcHTMLPath+lcIDCFile))
				IF NOT FILE(m.IDCFile)
					m.IDCFile=LOWER(FULLPATH(gcHTTPRoot+lcIDCFile))
				ENDIF
			ENDIF
		ENDIF
		m.IDCFile=LOWER(FULLPATH(m.IDCFile))
	ENDIF

	*Append query log
	lnSelect=SELECT()
	SELECT QueryLog
	IF RECCOUNT()>=1000
		ZAP
	ENDIF
	INSERT INTO QueryLog (TimeStamp, IDCFile, Parameters) ;
			VALUES (DATETIME(), lcIDCFile, cParameters)
	SELECT 0

	IF EMPTY(m.IDCFile)
		=Cleanup()
		RETURN errorpage(NOIDC_LOC)
	ENDIF
	IF NOT FILE(m.IDCFile)
		=Cleanup()
		RETURN errorpage(IDCNOTFOUND1_LOC+lcIDCFile+IDCNOTFOUND2_LOC)
	ENDIF

	*Verify required IDC information
	IDC_DataSource=parmsub(getidcp(m.IDCFile,"DataSource"))
	IDC_Template=parmsub(getidcp(m.IDCFile,"Template"))
	IF EMPTY(IDC_Template)
		=Cleanup()
		RETURN errorpage(IDCNOTFOUND1_LOC+IDCFile+IDCBADDATA1_LOC)
	ENDIF
	IDC_SQLStatement=parmsub(getidcp(m.IDCFile,"SQLStatement"))
	IF EMPTY(IDC_SQLStatement)
		=Cleanup()
		RETURN errorpage(IDCNOTFOUND1_LOC+IDCFile+IDCBADDATA2_LOC)
	ENDIF
	DIMENSION laDefaultParameters(1,2)
	IDC_DefaultParameters=getidcp(m.IDCFile,"DefaultParameters",@laDefaultParameters)
	IDC_MaxRecords=VAL(parmsub(getidcp(m.IDCFile,"MaxRecords")))
	IDC_UserName=parmsub(getidcp(m.IDCFile,"UserName"))
	IDC_Password=parmsub(getidcp(m.IDCFile,"Password"))
	IDC_Expires=parmsub(getidcp(m.IDCFile,"Expires"))
	IDC_MaxFieldSize=parmsub(getidcp(m.IDCFile,"MaxFieldSize"))
	DIMENSION laRequiredParameters(1,2)
	IDC_RequiredParameters=getidcp(m.IDCFile,"RequiredParameters",@laRequiredParameters)
	lcSQLStatement=IDC_SQLStatement
	lcTemplate=IDC_Template

	*Save server settings
	lcError = ON('ERROR')

	*Initialize result page
	cResultPage = 'Content-Type: text/html'+CRLF+CRLF

	lFailure = .F.

	*Check to see whether we will be accessing an ODBC datasource or native data
	IF EMPTY(IDC_DataSource)
		*NATIVE DATA
		cExecSQLString=lcSQLStatement
		IF EMPTY(cExecSQLString)
			=Cleanup()
			RETURN errorpage(BADSQL_LOC)
		ENDIF

		*Execute SQL String and trap for a failure
		_TALLY=0
		lFailure = .F.
		cSQLStatement=cExecSQLString
		*Convert string to UPPERCASE, TRIM, and remove TABs for easy
		*syntax checking.
		cExecSQLString=UPPER(ALLTRIM(STRTRAN(cExecSQLString,CHR(9),' ')))
		*Special case the general SELECT statement without an INTO (the default
		*for Wizard generated stuff.)
		IF cExecSQLString="SELECT " AND ATC(" INTO ",cExecSQLString)=0
			* cExecSQLString needs to carry through the case sensitivity of the
			* original SQL SELECT
			cExecSQLString = cSQLStatement + " INTO CURSOR TempResult"
		ELSE
			IF cExecSQLString="SELECT " OR;
					cExecSQLString="DELETE " OR;
					cExecSQLString="INSERT " OR;
					cExecSQLString="UPDATE " OR;
					cExecSQLString="ALTER TABLE " OR;
					cExecSQLString="CREATE CURSOR " OR;
					cExecSQLString="CREATE TABLE "
				* cExecSQLString needs to carry through the case sensitivity of the
				* original SQL SELECT
				cExecSQLString = cSQLStatement
			ELSE
				lFailure = .T.
			ENDIF
		ENDIF
		* At this point, if there has been some error evaluating the SQL statement,
		* or if the SQL statement is not one of the above valid types, the lFailure
		* flag is set, and the SQL statement will not be executed.
		IF NOT lFailure
			lnAtPos=ATC(' FROM ',cExecSQLString)
			IF lnAtPos>0
				lcAlias=ALLTRIM(SUBSTR(cExecSQLString,lnAtPos+6))
				lnAtPos=AT(' ',lcAlias)
				IF lnAtPos>0
					lcAlias=ALLTRIM(LEFT(lcAlias,lnAtPos-1))
				ENDIF
				IF LEFT(lcAlias,1)=="'" OR LEFT(lcAlias,1)=='"' OR ;
						LEFT(lcAlias,1)=='['
					lcAlias=EVALUATE(lcAlias)
				ENDIF
				lcAlias=UPPER(lcAlias)
				lcFileName=LOWER(lcAlias)
				lnAtPos=AT('.',lcAlias)
				IF lnAtPos>0
					lcAlias=ALLTRIM(LEFT(lcAlias,lnAtPos-1))
				ENDIF
				IF NOT '.'$lcFileName
					lcFileName=lcFileName+'.dbf'
				ENDIF
				lcFileName=LOWER(lcFileName)
				IF NOT FILE(lcFileName)
					=Cleanup()
					RETURN errorpage(NOSQL1_LOC+lcFileName+NOSQL2_LOC+cSQLStatement)
				ENDIF
			ENDIF
			ON ERROR lFailure = .T.
			&cExecSQLString
			ON ERROR &lcError
			IF USED(lcAlias)
				USE IN (lcAlias)
			ENDIF
		ENDIF


		IF lFailure = .T.
			IF llDefaultError
				=Cleanup()
				RETURN errorpage(BADCMD_LOC+cSQLStatement)
			ELSE
				CommandSuccess="FALSE"
			ENDIF
		ELSE
			CommandSuccess="TRUE"
		ENDIF

		lnRecordsReturned=_TALLY
		IF lnRecordsReturned = 0
			CurrentRecord=0
		ELSE
			CurrentRecord=1
			IF llReturnData
				RETURN makedata()
			ENDIF
		ENDIF

	ELSE
		cExecSQLString=lcSQLStatement
		IF EMPTY(cExecSQLString)
			=Cleanup()
			RETURN errorpage(BADSQL_LOC)
		ENDIF

		lnConn=SQLCONNECT(IDC_DataSource,IDC_Username,IDC_Password)
		IF lnConn <= 0
			=Cleanup()
			RETURN errorpage(BADCONN1_LOC+IDC_DataSource+BADCONN2_LOC+IDC_Username+BADCONN3_LOC)
		ENDIF

		*Execute SQL String and trap for a failure
		cSQLStatement=cExecSQLString

		lnExecRet=0
		DO WHILE lnExecRet=0
			lnExecRet = SQLEXEC(lnConn,cSQLStatement,'TempResult')
		ENDDO

		IF lnExecRet < 0
			lFailure = .T.
		ENDIF

		=SQLDISCONNECT(lnConn)

		IF lFailure = .T.
			IF llDefaultError
				=Cleanup()
				RETURN errorpage(BADCMD_LOC+cSQLStatement)
			ELSE
				CommandSuccess="FALSE"
			ENDIF
		ELSE
			CommandSuccess="TRUE"
		ENDIF

		lnRecordsReturned=RECCOUNT('TempResult')
		IF lnRecordsReturned = 0
			CurrentRecord=0
		ELSE
			CurrentRecord=1
			IF llReturnData
				=Cleanup()
				RETURN makedata()
			ENDIF
		ENDIF

	ENDIF

	*Create HTML return page from .HTX and data

	*Verify the existence of the Template (.HTX) file.  It must be next to the .IDC file,
	*pathed relative to the .IDC file, or in the Script root.
	lcTmpFile=lcTemplate
	lcTemplate=addbs(justpath(m.IDCFile))+lcTemplate
	IF NOT FILE(lcTemplate)
		lcTemplate=gcScriptRoot+lcTmpFile
		IF NOT FILE(lcTemplate)
			=Cleanup()
			RETURN errorpage(NOTEMPLATE_LOC)
		ENDIF
	ENDIF

	lhTemplate=FOPEN(lcTemplate)
	IF lhTemplate < 0
		=Cleanup()
		RETURN errorpage(BADTEMPLATE1_LOC+lcTemplate+BADTEMPLATE2_LOC)
	ENDIF

	llGetNewLine=.T.

	DO WHILE NOT FEOF(lhTemplate)
		IF llGetNewLine
			lcLine=FGETS(lhTemplate)
		ELSE
			*Toggle GetNewLine back to True
			llGetNewLine=.T.
		ENDIF
		lcLineCopy=UPPER(lcLine)
		DO CASE
			*The BeginDetail structure is linear, but must be repeated for
			*each record in the return set.  IFs can be nested within a Detail
			*section, so, once the detail section is loaded, it must be parsed
			*for IFs.  However
		CASE "<%BEGINDETAIL%>" $ lcLineCopy
			*If the BEGINDETAIL is not at the beginning of the line, put the
			*prefix into the Result page.  Then work on the detail chunk.
			IF lcLineCopy != "<%BEGINDETAIL%>"
				cResultPage=cResultPage+SUBSTR(lcLine,1,AT("<%BEGINDETAIL%>",lcLineCopy)-1)
				lcLine=SUBSTR(lcLine,AT("<%BEGINDETAIL%>",lcLineCopy)+15)+CRLF
			ELSE
				*If there's stuff after the BEGINDETAIL symbol, stuff it into the lcLine
				IF LEN(lcLine)>LEN("<%BEGINDETAIL%>")
					lcLine=SUBSTR(lcLine,16)
				ELSE
					lcLine=""
				ENDIF
			ENDIF
			llDone=.F.
			IF NOT EMPTY(lcLine)
				IF "<%ENDDETAIL%>" $ UPPER(lcLine)
					lcTmpLine=lcLine
					IF UPPER(lcTmpLine)!="<%ENDDETAIL%>"
						lcLine=SUBSTR(lcTmpLine,1,AT("<%ENDDETAIL%>",UPPER(lcTmpLine))-1)
					ENDIF
					IF LEN(lcTmpLine)>LEN("<%ENDDETAIL%>")
						lcSuffix=SUBSTR(lcTmpLine,AT("<%ENDDETAIL%>",UPPER(lcTmpLine))+13)
					ELSE
						lcSuffix=""
					ENDIF
					llDone=.T.
				ENDIF
			ENDIF
			DO WHILE NOT llDone AND NOT FEOF(lhTemplate)
				lcTmpLine=FGETS(lhTemplate)
				IF NOT("<%ENDDETAIL%>" $ UPPER(lcTmpLine))
					*Add to the block until you hit an ENDDETAIL
					lcLine=lcLine+lcTmpLine+CRLF
				ELSE
					*Add everything up to the beginning of the ENDDETAIL and store everything
					*afterward in lcSuffix for processing later.
					IF UPPER(lcTmpLine)!="<%ENDDETAIL%>"
						lcLine=lcLine+SUBSTR(lcTmpLine,1,AT("<%ENDDETAIL%>",UPPER(lcTmpLine))-1)
					ENDIF
					IF LEN(lcTmpLine)>LEN("<%ENDDETAIL%>")
						lcSuffix=SUBSTR(lcTmpLine,AT("<%ENDDETAIL%>",UPPER(lcTmpLine))+13)
					ELSE
						lcSuffix=""
					ENDIF
					llDone=.T.
				ENDIF
			ENDDO
			IF NOT llDone
				*Error: Mismatched Begin/EndDetail, close template file and exit
				=FCLOSE(lhTemplate)
				=Cleanup()
				RETURN errorpage(BADTEMPLATE1_LOC+lcTemplate+BADTEMPLATE3_LOC)
			ENDIF
			IF lnRecordsReturned > 0
				lcDetailExec=''
				DO WHILE AT("<%",lcLine) > 0
					lcDetailExec=lcDetailExec+'"'+STRTRAN(SUBSTR(lcLine,1,AT("<%",lcLine)-1),'"','"+["]+"')+'"+'
					lcLine=SUBSTR(lcLine,AT("<%",lcLine))
					IF UPPER(lcLine)="<%IF "
						*Process the IF structure into an IIF
						*Trim the IF and ENDIF symbols.
						lcIfStatement=SUBSTR(lcLine,6,AT("<%ENDIF%>",UPPER(lcLine))-6)
						*Strip out Expression 1, Expression 2, and the Operator
						lcExp1=ALLT(SUBSTR(lcIfStatement,1,AT(" ",lcIfStatement)-1))
						lcIfStatement=ALLT(SUBSTR(lcIfStatement,AT(" ",lcIfStatement)))
						lcOperator=ALLT(SUBSTR(lcIfStatement,1,AT(" ",lcIfStatement)-1))
						lcIfStatement=ALLT(SUBSTR(lcIfStatement,AT(" ",lcIfStatement)))
						lcExp2=ALLT(SUBSTR(lcIfStatement,1,AT("%>",lcIfStatement)-1))
						lcIfStatement=SUBSTR(lcIfStatement,AT("%>",lcIfStatement)+2)
						IF NOT('"'$lcExp1 OR "'"$lcExp1 OR '['$lcExp1)
							lcExp1=UPPER(lcExp1)
							lcExp1=STRTRAN(lcExp1,"IDC.","IDC_")
						ENDIF
						IF NOT('"'$lcExp2 OR "'"$lcExp2 OR '['$lcExp2)
							lcExp2=UPPER(lcExp2)
							lcExp2=STRTRAN(lcExp2,"IDC.","IDC_")
						ENDIF
						lcOperator=UPPER(lcOperator)
						DO CASE
						CASE lcOperator="CONTAINS"
							lcTmpExp=lcExp2
							lcExp2=lcExp1
							lcExp1=lcTmpExp
							lcOperator="$"
						CASE lcOperator="EQ"
							lcOperator="="
						CASE lcOperator="GT"
							lcOperator=">"
						CASE lcOperator="LT"
							lcOperator="<"
						ENDCASE
						IF "<%ELSE%>"$UPPER(lcIfStatement)
							lcTrueStatement=SUBSTR(lcIfStatement,1,AT("<%ELSE%>",UPPER(lcIfStatement))-1)
							lcIfStatement=SUBSTR(lcIfStatement,AT("<%ELSE%>",UPPER(lcIfStatement))+8)
							lcFalseStatement=lcIfStatement
							lcFalseStatement=STRTRAN(lcFalseStatement,'"','"+["]+"')
						ELSE
							lcTrueStatement=lcIfStatement
							lcFalseStatement=""
						ENDIF
						lcTrueStatement=STRTRAN(lcTrueStatement,'"','"+["]+"')
						lcIIF='IIF('+lcExp1+lcOperator+lcExp2+',"'+lcTrueStatement+'","'+lcFalseStatement+'")+'
						lcDetailExec=lcDetailExec+lcIIF
						IF LEN(lcLine)>AT("<%ENDIF%>",UPPER(lcLine))+9
							lcLine=SUBSTR(lcLine,AT("<%ENDIF%>",UPPER(lcLine))+9)
						ELSE
							lcLine=""
						ENDIF
					ELSE
						*This is a symbol structure.  If it is valid, extract the symbol and place it into
						*the executable line.
						IF AT("%>",lcLine)=0
							=FCLOSE(lhTemplate)
							=Cleanup()
							RETURN errorpage(BADTEMPLATE4_LOC+lcTemplate+BADTEMPLATE5_LOC)
						ENDIF
						lcSymbol=SUBSTR(lcLine,3,AT("%>",lcLine)-3)
						lcDetailExec=lcDetailExec+'EXPTOC('+ALLT(lcSymbol)+')+'
						IF LEN(lcLine)>LEN(lcSymbol)+4
							lcLine=SUBSTR(lcLine,AT("%>",lcLine)+2)
						ELSE
							lcLine=""
						ENDIF
					ENDIF
				ENDDO
				lcDetailExec=lcDetailExec+'"'+STRTRAN(lcLine,'"','"+["]+"')+'"'
				=DetailEx(lcDetailExec,@laEnvVariables,@cResultPage)
			ENDIF
			*If the suffix has stuff to process, then don't get a new file line, start with the suffix.
			IF NOT EMPTY(lcSuffix)
				llGetNewLine=.F.
				lcLine=lcSuffix
			ENDIF
		CASE "<%IF" $ lcLineCopy
			IF lcLineCopy != "<%IF "
				cResultPage=cResultPage+SUBSTR(lcLine,1,AT("<%IF ",lcLineCopy)-1)
				lcLine=SUBSTR(lcLine,AT("<%IF ",lcLineCopy)+5)+CRLF
			ELSE
				IF LEN(lcLine)>LEN("<%IF ")
					lcLine=SUBSTR(lcLine,5)
				ELSE
					=FCLOSE(lhTemplate)
					=Cleanup()
					RETURN errorpage(BADTEMPLATE6_LOC)
				ENDIF
			ENDIF
			llDone=.F.
			DO WHILE NOT llDone AND NOT FEOF(lhTemplate)
				lcTmpLine=FGETS(lhTemplate)
				IF NOT("<%ENDIF%>" $ UPPER(lcTmpLine))
					lcLine=lcLine+lcTmpLine+CRLF
				ELSE
					*Add everything up to the beginning of the ENDIF and store everything
					*afterward in lcSuffix for processing later.
					IF UPPER(lcTmpLine)!="<%ENDIF%>"
						lcLine=lcLine+SUBSTR(lcTmpLine,1,AT("<%ENDIF%>",UPPER(lcTmpLine))-1)
					ENDIF
					IF LEN(lcTmpLine)>LEN("<%ENDIF%>")
						lcSuffix=SUBSTR(lcTmpLine,AT("<%ENDIF%>",UPPER(lcTmpLine))+9)
					ELSE
						lcSuffix=""
					ENDIF
					llDone=.T.
				ENDIF
			ENDDO
			IF NOT llDone
				*Error: Mismatched If/Endif, close template file and exit
				=FCLOSE(lhTemplate)
				=Cleanup()
				RETURN errorpage(BADTEMPLATE1_LOC+lcTemplate+BADTEMPLATE7_LOC)
			ENDIF
			*At this point, the entire structure between the <%IF and the <%ENDIF%> non inclusive is
			*in lcLine.  This will include the conditional parameters and an <%ELSE%> if such a thing exists.
			*In addition, everything after the structure will be contained in lcSuffix.
			lcIfStatement=LTRIM(lcLine)
			*Strip out Expression 1, Expression 2, and the Operator
			lcExp1=ALLT(SUBSTR(lcIfStatement,1,AT(" ",lcIfStatement)-1))
			lcIfStatement=ALLT(SUBSTR(lcIfStatement,AT(" ",lcIfStatement)))
			lcOperator=ALLT(SUBSTR(lcIfStatement,1,AT(" ",lcIfStatement)-1))
			lcIfStatement=ALLT(SUBSTR(lcIfStatement,AT(" ",lcIfStatement)))
			lcExp2=ALLT(SUBSTR(lcIfStatement,1,AT("%>",lcIfStatement)-1))
			lcIfStatement=SUBSTR(lcIfStatement,AT("%>",lcIfStatement)+2)
			*If the expressions aren't character literals, make them uppercase
			*for case insensitivity.  Also check to see if they reference IDC.
			*variables at this point.
			IF NOT('"'$lcExp1 OR "'"$lcExp1 OR '['$lcExp1)
				lcExp1=UPPER(lcExp1)
				lcExp1=STRTRAN(lcExp1,"IDC.","IDC_")
			ENDIF
			IF NOT('"'$lcExp2 OR "'"$lcExp2 OR '['$lcExp2)
				lcExp2=UPPER(lcExp2)
				lcExp2=STRTRAN(lcExp2,"IDC.","IDC_")
			ENDIF
			lcOperator=UPPER(lcOperator)
			DO CASE
			CASE lcOperator="CONTAINS"
				lcTmpExp=lcExp2
				lcExp2=lcExp1
				lcExp1=lcTmpExp
				lcOperator="$"
			CASE lcOperator="EQ"
				lcOperator="="
			CASE lcOperator="GT"
				lcOperator=">"
			CASE lcOperator="LT"
				lcOperator="<"
			ENDCASE
			IF "<%ELSE%>"$UPPER(lcIfStatement)
				lcTrueStatement=SUBSTR(lcIfStatement,1,AT("<%ELSE%>",UPPER(lcIfStatement))-1)
				lcIfStatement=SUBSTR(lcIfStatement,AT("<%ELSE%>",UPPER(lcIfStatement))+8)
				lcFalseStatement=lcIfStatement
			ELSE
				lcTrueStatement=lcIfStatement
				lcFalseStatement=""
			ENDIF
			IF EvalCond(lcExp1+lcOperator+lcExp2,@laEnvVariables)
				lcLine=lcTrueStatement+lcSuffix
			ELSE
				lcLine=lcFalseStatement+lcSuffix
			ENDIF
			IF NOT EMPTY(lcLine)
				llGetNewLine=.F.
			ENDIF
		OTHERWISE
			cResultPage=cResultPage+lcLine+CRLF
		ENDCASE
	ENDDO
	IF lnRecordsReturned=0
		cResultPage=cResultPage+NOMATCHES_LOC+CRLF
	ENDIF

	*Append query log
	lnSelect=SELECT()
	SELECT QueryLog
	INSERT INTO QueryLog (TimeStamp, IDCFile, Parameters) ;
			VALUES (DATETIME(), lcIDCFile, RETURNED_LOC)
	SELECT 0

	=FCLOSE(lhTemplate)

	=Cleanup()
	RETURN cResultPage

PROCEDURE Cleanup()
	LOCAL lnCount

	IF USED('TempResult')
		USE IN TempResult
	ENDIF

PROCEDURE errorpage (lcErrorMessage)
	LOCAL cResultPage
	cResultPage = 'Content-Type: text/html'+CRLF+CRLF

	cResultPage = cResultPage + ;
		'<html><head><title>'+FAILEDSEARCH_LOC+'</title></head>'+ ;
		CRLF
	cResultPage = cResultPage + ;
		'<body>'+CRLF
	cResultPage = cResultPage + ;
		'<h1>'+FAILEDSEARCH_LOC+'</h1>'+CRLF

	cResultPage = cResultPage + ;
		' '+ALLT(lcErrorMessage)+'<hr></body></html>'+CRLF

	RETURN cResultPage

FUNCTION FormFld(FldValue)
	FldValue=STRTRAN(FldValue,CRLF,"<BR>")
	IF RIGHT(FldValue,4)="<BR>"
		FldValue=SUBSTR(FldValue,1,LEN(FldValue)-4)
	ENDIF
	RETURN FldValue

FUNCTION MakeData
	LOCAL cResultPage,cFileName,nFH,nFSize
	cResultPage="<Content-type:text/plain>"+CRLF
	cFileName=SYS(3)+'.TXT'
	SELECT TempResult
	IF IDC_MaxRecords > 0
		LIST NEXT IDC_MaxRecords TO FILE (cFileName) NOCONSOLE
	ELSE
		LIST TO FILE (cFileName) NOCONSOLE
	ENDIF
	nFH=FOPEN(cFileName)

	IF nFH > 0
		nFSize=FSEEK(nFH,0,2)
		=FSEEK(nFH,0,0)
		cResultPage=cResultPage+FREAD(nFH,nFSize)
	ELSE
		RETURN ErrorPage(NODATASTREAM_LOC)
	ENDIF
	=FCLOSE(nFH)
	ERASE (cFileName)
	RETURN cResultPage



FUNCTION bldpath
	LOCAL lcPath, lcRefer, lcSubPath

	lcPath=gcHTTPRoot

	lcRefer=getparam("HTTP_REFERER")
	IF NOT EMPTY(lcRefer)
		lcRefer=STRTRAN(lcRefer,"//","")
		lcRefer=STRTRAN(lcRefer,"/","\")
		lcRefer=SUBSTR(lcRefer,AT("\",lcRefer)+1)
		lcRefer=LEFT(lcRefer,RAT("\",lcRefer))
	ENDIF

	lcPath=lcPath+lcRefer

	RETURN lcPath



FUNCTION DetailEx(lcDetailLine,laSymbolTable,cResultPage)
	EXTERNAL ARRAY laSymbolTable
	LOCAL lnMaxRecords,lnCount

	IF IDC_MaxRecords > 0
		lnMaxRecords=MIN(IDC_MaxRecords,lnRecordsReturned)
	ELSE
		lnMaxRecords=lnRecordsReturned
	ENDIF

	*Execute IIF with local environment
	lcDetailLine=STRTRAN(lcDetailLine,CRLF,"")

	SELECT TempResult

	lnCount=0
	SCAN REST
		IF lnCount>=lnMaxRecords
			EXIT
		ENDIF
		lnCount=lnCount+1
		cResultPage=cResultPage+EVALUATE(lcDetailLine)+CRLF
		CurrentRecord=CurrentRecord+1
	ENDSCAN

	IF CurrentRecord > 0
		CurrentRecord=1
	ENDIF

	RETURN



	*This function takes a conditional statement and evaluates it based on the
	*entire environment state at this time.

FUNCTION EvalCond(lcConditional,laSymbolTable)
	EXTERNAL ARRAY laSymbolTable

	RETURN EVALUATE(lcConditional)



FUNCTION exptoc(eExprVal)

	DO CASE
	CASE ISNULL(eExprVal)
		RETURN 'NULL'
	CASE TYPE('eExprVal') $ 'CM'
		RETURN ALLTRIM(eExprVal)
	CASE TYPE('eExprVal') $ 'NFYB'
		RETURN ALLTRIM(STR(eExprVal))
	CASE TYPE('eExprVal') $ 'L'
		RETURN ALLTRIM(IIF(eExprVal,TRUE_LOC,FALSE_LOC))
	CASE TYPE('eExprVal') $ 'D'
		RETURN ALLTRIM(DTOC(eExprVal))
	CASE TYPE('eExprVal') $ 'T'
		RETURN ALLTRIM(TTOC(eExprVal))
	OTHERWISE
		RETURN '*****'
	ENDCASE



	* Function GETIDCP (Get IDC Parameters)
	* Fetches requested parameter from the IDC file and returns the
	* value as a character string.  This function has a polymorphic
	* return type: in the case where the DefaultParameters parameter is
	* fetched, the function returns a numeric value indicating how many
	* default parameters were fetched.  The parameters and values are stored
	* in the passed-by-reference array as a parameter,value pair.
	* Errors result in the null string being returned.

FUNCTION getidcp(cIDCFile,cParameter,aDefArray)

	IF PARAMETERS()<2
		RETURN ""
	ENDIF

	llFound=.F.

	cParameter=ALLT(cParameter)
	cIDCFile=ALLT(cIDCFile)

	lhIDC=FOPEN(cIDCFile)

	IF lhIDC < 0
		RETURN ""
	ENDIF

	DO WHILE NOT llFound AND NOT FEOF(lhIDC)
		lcLine=FGETS(lhIDC)
		IF NOT EMPTY(lcLine)
			lcLineTok=UPPER(STRTRAN(lcLine," ",""))
			IF (UPPER(cParameter)+":")$lcLineTok
				llFound=.T.
			ENDIF
		ENDIF
	ENDDO

	IF NOT llFound
		=FCLOSE(lhIDC)
		RETURN ""
	ENDIF

	llDone=.F.
	DO WHILE NOT llDone AND NOT FEOF(lhIDC)
		lcAddLine=ALLT(FGETS(lhIDC))
		IF LEFT(lcAddLine,1) = "+"
			lcLine=lcLine+" "+ALLT(SUBSTR(lcAddLine,2))
		ELSE
			llDone=.T.
		ENDIF
	ENDDO

	=FCLOSE(lhIDC)

	*Add filler so AT will never fail.
	lcLine=lcLine+" "

	lcValue=LTRIM(SUBSTR(lcLine,AT(":",lcLine)+1))

	IF UPPER(cParameter)="DEFAULTPARAMETERS" OR UPPER(cParameter)="REQUIREDPARAMETERS"
		lnParameters=0
		DO WHILE AT("=",lcValue)>0
			* Add filler so loop works in 0 case
			lcValue=lcValue+", "
			lnParameters=lnParameters+1
			DIMENSION aDefArray(lnParameters,2)
			aDefArray(lnParameters,1)=ALLT(SUBSTR(lcValue,1,AT("=",lcValue)-1))
			aDefArray(lnParameters,2)=ALLT(SUBSTR(lcValue,AT("=",lcValue)+1,AT(",",lcValue)-(AT("=",lcValue)+1)))
			lcValue=SUBSTR(lcValue,AT(",",lcValue)+1)
		ENDDO
		RETURN lnParameters
	ENDIF

	RETURN lcValue



FUNCTION getparam
	LPARAMETER cVar
	EXTERNAL ARRAY laEnvVariables

	LOCAL nLocation, llDone, nFrom

	llDone=.F.
	nFrom=1

	*Find the given variable in the first column of the environment variables array if
	*it's there at all.
	DO WHILE llDone=.F.
		nLocation=ASCAN(laEnvVariables,cVar,nFrom)
		IF nLocation=0
			llDone=.T.
		ELSE
			IF ASUBSCRIPT(laEnvVariables,nLocation,2) = 1
				llDone=.T.
			ELSE
				nFrom=nLocation+1
			ENDIF
		ENDIF
	ENDDO

	IF nLocation > 0
		RETURN laEnvVariables[ASUBSCRIPT(laEnvVariables,nLocation+1,1),ASUBSCRIPT(laEnvVariables,nLocation+1,2)]
	ELSE
		RETURN ""
	ENDIF



FUNCTION GetToken(INSTR,innum,insep)
	**  GetToken.
	**	Parameters:
	**	1) Input string to be parsed.
	**  2) Number of token to return.
	**	3) The delimiter that seperates tokens.  (Default ",")
	PRIVATE ALL

	IF PARAM() < 2
		RETURN ""
	ENDIF

	IF PARAM() < 3
		insep = ","
	ENDIF

	maxnum = OCCURS(insep,INSTR)

	DO CASE
	CASE innum <= 0
		rval = ""
	CASE maxnum = 0 AND innum = 1
		rval = INSTR
	CASE maxnum = 0 AND innum > 1
		rval = ""
	CASE maxnum > 0 AND innum = 1
		rval = SUBSTR(INSTR,1,ATC(insep,INSTR)-1)
	CASE innum = maxnum + 1 AND LEN(INSTR) < ATC(insep,INSTR,maxnum)+1
		rval = ""
	CASE innum = maxnum + 1
		start = ATC(insep,INSTR,maxnum)+1
		stop = LEN(INSTR)
		rval = SUBSTR(INSTR,start,stop-start+1)
	CASE innum < maxnum + 1
		start = ATC(insep,INSTR,innum-1)+1
		stop = ATC(insep,INSTR,innum)-1
		rval = SUBSTR(INSTR,start,stop-start+1)
	CASE innum > maxnum + 1
		rval = ""

	ENDCASE
	RETURN rval



FUNCTION isnum(lcNumber)

	IF EMPTY(lcNumber)
		RETURN .F.
	ENDIF

	lcNumber=UPPER(lcNumber)

	*Make sure there's not more than one of each E,-, and .

	IF STRTRAN(lcNumber,".","",1,1)!=STRTRAN(lcNumber,".","")
		RETURN .F.
	ENDIF
	IF STRTRAN(lcNumber,"E","",1,1)!=STRTRAN(lcNumber,"E","")
		RETURN .F.
	ENDIF
	IF STRTRAN(lcNumber,"-","",1,1)!=STRTRAN(lcNumber,"-","")
		RETURN .F.
	ENDIF

	IF CHRTRAN(lcNumber,"0123456789.E-",REPL(CHR(0),13))==REPL(CHR(0),LEN(lcNumber))
		RETURN .T.
	ELSE
		RETURN .F.
	ENDIF



FUNCTION parmsub(lcRootString)
	EXTERNAL ARRAY laEnvVariables

	lcFilledString=lcRootString

	*Iterate through for each possible environment variable.  Faster than parsing everything out.

	FOR nCnt=1 TO lnEnvVariables
		lcFilledString=STRTRAN(lcFilledString,"%"+ALLT(laEnvVariables[nCnt,1])+"%",laEnvVariables[nCnt,2])
	ENDFOR

	RETURN lcFilledString



FUNCTION ParseVars(cParameters,laEnvVariables,llCreate)

	LOCAL nVCount, cToken

	IF EMPTY(cParameters)
		RETURN 0
	ENDIF

	IF llCreate
		nVCount=1
	ELSE
		nVCount=ALEN(laEnvVariables,1)+1
	ENDIF
	cToken=GETTOKEN(cParameters,1,"&")
	DO WHILE NOT EMPTY(cToken)
		DIMENSION laEnvVariables[nVCount,2]
		laEnvVariables[nVCount,1]=ALLT(SUBSTR(cToken,1,ATC("=",cToken)-1))
		IF ATC("=",cToken)=LEN(cToken)
			laEnvVariables[nVCount,2]=""
		ELSE
			cToken = SUBSTR(cToken,ATC("=",cToken)+1)
			cToken = StripASCII(cToken)
			laEnvVariables[nVCount,2] = STRTRAN(cToken,"+"," ")
		ENDIF
		nVCount=nVCount+1
		cToken=GETTOKEN(cParameters,nVCount,"&")
	ENDDO

	nVCount=nVCount-1

	RETURN nVCount

FUNCTION StripASCII
	LPARAMETER clString
	* clString is ASCII, but could contain hex of DBCS
	LOCAL m.cstr, m.nextflag, m.lastflag, m.numflags
	
	m.nextflag = AT_C("%",m.clString)
	IF m.nextflag = 0
		*  If no % symbol, do not need to modify string.
		RETURN m.clString
	ENDIF
	
	m.cStr = ""
	m.lastflag = 1
	m.numflags = 1
	DO WHILE .T.
		*  Get text before current % flag.
		m.cStr = m.cStr + ;
				SUBSTR(m.clString,m.lastflag, m.nextflag - m.lastflag) + ;
				CHR(EVALUATE("0x" + SUBSTR(m.clString,m.nextflag + 1,2)))
		m.lastflag = m.nextflag + 3	&& skip past item.
		m.numflags = m.numflags + 1
		m.nextflag = AT_C("%", m.clString, m.numflags)
		IF m.nextflag = 0
			m.cStr = m.cStr + SUBSTR(m.clString, m.lastflag)
			EXIT
		ENDIF
	ENDDO
	RETURN m.cStr


FUNCTION readini(filename)

	PRIVATE pcfg,prdline,ptoken,pvalue

	pcfg = FOPEN(filename)

	IF pcfg < 0
		RETURN .F.
	ENDIF

	DO WHILE NOT(FEOF(pcfg))
		prdline = FGETS(pcfg)
		IF NOT EMPTY(prdline)
			ptoken = UPPER(ALLTRIM(SUBSTR(prdline,1,AT("=",prdline)-1)))
			pvalue = UPPER(ALLTRIM(SUBSTR(prdline,AT("=",prdline)+1)))
			DO CASE
			CASE ptoken == "HTTPROOT"
				gcHTTPRoot = pvalue
			CASE ptoken == "SCRIPTROOT"
				gcScriptRoot = pvalue
			CASE ptoken == "SEMAPHORE"
				gcSemaphoreRoot = pvalue
			CASE ptoken == "PATH"
				gcPath = pvalue
			ENDCASE
		ENDIF
	ENDDO

	=FCLOSE(pcfg)

	RETURN .T.



FUNCTION runspec
	gcINIFile='is.ini'
	gcHTTPRoot=""
	gcScriptRoot=""

	DO FORM specroot
	RETURN



FUNCTION ErrorHandler(tnErrorNo,tcMsg,tcProgramName,tnLineNo,tcCodeLine)
LOCAL laDir[1]

	IF ADIR(laDir,'error.txt')>0
		IF laDir[2]>65535 OR (DATE()-laDir[3])>14
			ERASE error.txt
		ENDIF
	ENDIF
	SET TEXTMERGE OFF
	SET TEXTMERGE TO ERROR ADDITIVE
	SET TEXTMERGE ON NOSHOW
	
	\<<ERROCCUR_LOC>><<DATETIME()>>
	\<<ERRMESS_LOC>><<tcMsg>>
	\<<ERRNUM_LOC>><<tnErrorNo>>
	\<<ERRPROC_LOC>><<PROPER(tcProgramName)>>
	\<<ERRLINE_LOC>><<tnLineNo>>
	IF NOT EMPTY(ALIAS())
	\<<ERRALIAS_LOC>>[<<ALIAS()>>]
	\<<ERRREC_LOC>><<RECNO()>>
	ENDIF
	\<<tcCodeLine>>
	\
	\
	SET TEXTMERGE OFF
	SET TEXTMERGE TO
ENDFUNC