****************************************************************
* Description.. Standard HTTP API Functions *
* Program Name. F.HTTPSTD *
* Author....... Bradley V. Stone *
* BVS/Tools - www.bvstools.com *
* *
* Compile with QHTTPSVR/QZHBCGI service program *
****************************************************************
H NOMAIN
****************************************************************
****************************************************************
* Global Definitions *
****************************************************************
D WPError DS
D EBytesP 1 4B 0 INZ(40)
D EBytesA 5 8B 0
D EMsgID 9 15
D EReserverd 16 16
D EData 17 56
****************************************************************
* Prototypes *
****************************************************************
D #WrStout PR
D PR_WrStout 1024 VALUE
*
D #RdStin PR
D PR_RcvRec 1024
D PR_RcvLen 9B 0
D PR_RcvRecLen 9B 0
*
D #GetEnv PR
D PR_EnvRec 1024
D PR_EnvName 64 VALUE
D PR_RcvEnvLen 9B 0
*
D #CvtDB PR 1024
D PR_RcvRec 1024
D PR_RcvFile 20 VALUE
*
D #PutEnv PR
D PR_RcvRec 1024
*
D #CGIParse PR 1024
D PR_CmdStr 64 VALUE
*//////////////////////////////////////////////////////////////*
* (#WrStout) Write HTML to Web Page *
*//////////////////////////////////////////////////////////////*
P #WrStout B EXPORT
*--------------------------------------------------------------*
D #WrStout PI
D WrtDta 1024 VALUE
*
D WrtDtaLen S 9B 0
*--------------------------------------------------------------*
C ' ' CHECKR WrtDta:1024 WrtDtaLen
*
C CALLB 'QtmhWrStout'
C PARM WrtDta
C PARM WrtDtaLen
C PARM WPError
*--------------------------------------------------------------*
P #WrStout E
*//////////////////////////////////////////////////////////////*
* (#RdStin) Read Standard Input *
*//////////////////////////////////////////////////////////////*
P #RdStin B EXPORT
*--------------------------------------------------------------*
D #RdStin PI
D RcvRec 1024
D RcvLen 9B 0
D RcvRecLen 9B 0
*
*--------------------------------------------------------------*
C CALLB 'QtmhRdStin'
C PARM RcvRec
C PARM RcvLen
C PARM RcvRecLen
C PARM WPError
*--------------------------------------------------------------*
P #RdStin E
*//////////////////////////////////////////////////////////////*
* (#GetEnv) Get Environment Variables *
*//////////////////////////////////////////////////////////////*
P #GetEnv B EXPORT
*--------------------------------------------------------------*
D #GetEnv PI
D EnvRec 1024
D EnvName 64 VALUE
D EnvRecLen 9B 0
*
D EnvLen S 9B 0 INZ(%size(EnvRec))
D EnvNameLen S 9B 0
*--------------------------------------------------------------*
C ' ' CHECKR EnvName:64 EnvNameLen
*
C CALLB 'QtmhGetEnv'
C PARM EnvRec
C PARM EnvLen
C PARM EnvRecLen
C PARM EnvName
C PARM EnvNameLen
C PARM WPError
*--------------------------------------------------------------*
P #GetEnv E
*//////////////////////////////////////////////////////////////*
* (#CvtDB) Convert to DB for enviroment variables. *
*//////////////////////////////////////////////////////////////*
P #CvtDB B EXPORT
*--------------------------------------------------------------*
D #CvtDB PI 1024
D RcvRec 1024
D RcvFile 20 VALUE
*
*
D OutString S 1024
D CvtLen S 9B 0 INZ(%size(OutString))
D CvtLenAv S 9B 0
D CvtStat S 9B 0
D RcvLen S 9B 0
*--------------------------------------------------------------*
C ' ' CHECKR RcvRec:1024 RcvLen
*
C CALLB 'QtmhCvtDb'
C PARM RcvFile
C PARM RcvRec
C PARM RcvLen
C PARM OutString
C PARM CvtLen
C PARM CvtLenAv
C PARM CvtStat
C PARM WPError
*
C RETURN OutString
*--------------------------------------------------------------*
P #CvtDB E
*//////////////////////////////////////////////////////////////*
* (#PutEnv) Put Environment Variable *
*//////////////////////////////////////////////////////////////*
P #PutEnv B EXPORT
*--------------------------------------------------------------*
D #PutEnv PI
D RcvRec 1024
*
D RcvLen S 9B 0 INZ(%size(RcvRec))
*--------------------------------------------------------------*
C CALLB 'QtmhPutEnv'
C PARM RcvRec
C PARM RcvLen
C PARM WPError
*--------------------------------------------------------------*
P #PutEnv E
*//////////////////////////////////////////////////////////////*
* (#CGIParse) Parse CGI Variables *
*//////////////////////////////////////////////////////////////*
P #CGIParse B EXPORT
*--------------------------------------------------------------*
D #CGIParse PI 1024
D CmdStr 64 VALUE
*
D Output S 1024
D TgtBuf S 1024
D ParseFmt S 8 INZ('CGII0200')
D RespLen S 9B 0
D TgtBufLen S 9B 0 INZ(%size(TgtBuf))
D pos S 4 0
*--------------------------------------------------------------*
C eval CmdStr = %trim(CmdStr) + X'00'
C eval TgtBuf = ' '
*
C CALLB 'QzhbCgiParse'
C PARM CmdStr
C PARM ParseFmt
C PARM TgtBuf
C PARM TgtBufLen
C PARM RespLen
C PARM WPError
*
* Scan for more than one end of line character. This means multiple
* values are being returned and we shouldn't truncate the value. Only do this
* if the "-value" command is used. Use SCAN because we could be returning
* on of multiple values for a variable (ie. "-3 -value field" will return the
* third occurence of field.)
*
C '-value' SCAN CmdStr 97
*
C if (*IN97) and (RespLen > 0)
C X'25' SCAN TgtBuf:1 pos 98
*
C if (*IN98) and (pos < %size(TgtBuf))
C eval pos = (pos + 1)
C X'25' SCAN TgtBuf:pos 99
C else
C eval *IN99 = *OFF
C endif
*
C if (*IN98) and (not *IN99)
C eval RespLen = (RespLen - 1)
C endif
*
C endif
*
C if (RespLen > 0)
C eval Output = %subst(TgtBuf:1:RespLen)
C else
C eval Output = ' '
C endif
*
C RETURN Output
*--------------------------------------------------------------*
P #CGIParse E
|