**************************************************************************
* Simple ILE RPG program AS/400 Interet Connection Short Comment
*
*
**************************************************************************
FFEEDB O A E DISK
FHTMLFILE IF E DISK
**************************************************************************
*Variables for the CGI interface APIs
*These are used for APIStdIn
DInData S 2048A INZ
DInDataLn S 9B 0 INZ(2048)
DInActLn S 9B 0
*These are for the APICvtDB
**************************************************************************
DDBFileName S 20A INZ('COMMENTDS *LIBL ')
**************************************************************************
DDBBuff S 2048A INZ
DDBBuffLn S 9B 0 INZ(2048)
DDBDSLn S 9B 0 INZ
DDBActLn S 9B 0 INZ
DDBRespCd S 9B 0 INZ
*These are used for APIStdOut
DOutBuff S 2048A INZ
DOutBuffLn S 9B 0 INZ(2048)
**************************************************************************
*Externally described data structure. Used for Parsing
*Need a different one in each CGI-BIN you write
DCOMMENTDS E DS
**************************************************************************
* Data structure for error reporting. Copied from QSYSINC/QRPGLESRC(QUSEC
DQUSEC DS
D* Qus EC
D QUSBPRV 1 4B 0 INZ(16)
D* Bytes Provided
D QUSBAVL 5 8B 0
D* Bytes Available
D QUSEI 9 15
D* Exception Id
D QUSERVED 16 16
D* Reserved
D*QUSED01 17 17
D*
D* Varying length
**************************************************************************
*Constants for names of CGI APIs
DAPIStdIn C 'QtmhRdStin'
DAPIStdOut C 'QtmhWrStout'
DAPICvtDB C 'QtmhCvtDb'
DAPIEnVar C 'QtmhGetEnv'
*Compile-time array for HTML Output
DHTMLO S 80 DIM(21) PERRCD(1) CTDATA
DHTMLAR1 S 1 DIM(50)
DHTMLAR2 S 1 DIM(80)
DARR1 S 30 DIM(9)
DCOMARR S 42 DIM(5)
DWRKARR1 S 1 DIM(2048)
DWRKARR2 S 1 DIM(2048)
D**************************************************************************
D* Define carriage-return/linefeed
DNewLine C x'15'
D**************************************************************************
D* Define break
DBreak C '
'
**************************************************************************
* Get the Input parameters from the POST from STDIN
C MOVE *BLANKS OutBuff
C EXSR STDIN
C MOVE *BLANKS WRKARR1
C MOVE *BLANKS WRKARR2
C MOVEA INData WRKARR1
C MOVE *ZEROS F 5 0
C MOVE *ZEROS G 5 0
C MOVE *ZEROS H 5 0
**************************************************************************
* Circumvention - remove x'15' from INData
**************************************************************************
C DO 2048 F
C WRKARR1(F) IFNE NEWLINE
C ADD 1 G
C MOVE WRKARR1(F) WRKARR2(G)
C ELSE
C ADD 1 H
C ENDIF
C ENDDO
C MOVEA WRKARR2 INData
C INActLn SUB H INActLn
**************************************************************************
* End Circumvention
**************************************************************************
* Upon return, your POST data is in INData and its length is in
* INActLn It is in the FLD=VAR format at this time
* Move this data to the DBCvt parms
* Set up the parameters before CALLB
* This includes the length of your Ext DS (394 is correct)
**************************************************************************
C Z-ADD 394 DBDSLn
**************************************************************************
C MOVEL INData DBBuff
C Z-ADD INActLn DBBuffLn
********************************************************************
* Parse using the CvtDB API
C EXSR PARSE
* The field names in your Ext DS now
* contain the Values passed in the POST data
* Move them to the DB file fields
**************************************************************************
C MOVEL FNAME FNAME_X
C MOVEA FNAME ARR1(1)
C MOVEL EMAIL EMAIL_X
C MOVEA EMAIL ARR1(2)
C MOVEL ADDRESS1 ADDRESS1_X
C MOVEA ADDRESS1 ARR1(3)
C MOVEL ADDRESS2 ADDRESS2_X
C MOVEA ADDRESS2 ARR1(4)
C MOVEL CITY CITY_X
C MOVEA CITY ARR1(5)
C MOVEL STATE STATE_X
C MOVEA STATE ARR1(6)
C MOVEL ZIPCODE ZIPCODE_X
C MOVEA ZIPCODE ARR1(7)
C MOVEL COUNTRY COUNTRY_X
C MOVEA COUNTRY ARR1(8)
C MOVEL PHONE PHONE_X
C MOVEA PHONE ARR1(9)
C MOVEL COMMENT COMMENT_X
C MOVEA COMMENT COMARR
C WRITE COMREC
* If you had multiple values for the same field, you would
* have lost all but the first. You need another technique for
* this situation
*Write HTML Required control records
* For each line of HTML, move it to array append linefeed/carriage
* return, and set the array pointer BP
C Move *ZEROS I
C Move *ZEROS I2
C DO 21 I 5 0
C MOVE *OFF *IN96
C MOVE *OFF *IN97
C I IFGT 8
C I IFLT 18
C I SUB 8 J 5 0
C MOVE *ON *IN97
C MOVEA HTMLO(I) HTMLAR1
C MOVEA ARR1(J) HTMLAR1(21)
C Move *BLANKS WRK1 50
C MOVEA HTMLAR1 WRK1
C OutBuff cat WRK1:0 OutBuff
C OutBuff cat Break:0 OutBuff
C OutBuff cat NewLine:0 OutBuff
C ENDIF
C ENDIF
C I IFEQ 18
C MOVE *ON *IN96
C MOVEA HTMLO(I) HTMLAR2
C Move *BLANKS WRK2 80
C MOVEA HTMLAR2 WRK2
C OutBuff cat WRK2:0 OutBuff
C OutBuff CAT NewLine:0 OutBuff
C DO 5 I2 5 0
C Move *BLANKS WRK1
C MOVEA COMARR(I2) WRK1
C OutBuff cat WRK1:0 OutBuff
C OutBuff cat Break:0 OutBuff
C OutBuff cat NewLine:0 OutBuff
C ENDDO
C ENDIF
C*
C *IN97 IFEQ *OFF
C *IN96 IFEQ *OFF
C MOVEA HTMLO(I) HTMLAR2
C Move *BLANKS WRK2 80
C MOVEA HTMLAR2 WRK2
C OutBuff cat WRK2:0 OutBuff
C OutBuff CAT NewLine:0 OutBuff
C ENDIF
C ENDIF
C ENDDO
* Move the records from the closing HTML file to the array
C MOVE *OFF *IN99
C *IN99 DOWEQ *OFF
C READ HTMLREC 99
C *IN99 CABEQ *ON ENDIT
C ENDIT TAG
C ENDDO
* Send OutBuff to standard output
C EXSR STDOUT
* End program
C MOVE *ON *INLR
* These are the APIs used in subroutines to keep the main processing
* simple. They do not need to be SUBRs!
* Subroutine to read STD IN
C STDIN BEGSR
C CALLB APIStdIn
C parm INData
C parm INDataLn
C parm INActLn
C parm QUSEC
C ENDSR
C* Parse subroutine
C PARSE BEGSR
C CALLB APICvtDB
C parm DBFileName
C parm DBBuff
C parm DBBuffLn
** Remember to code your External DS name. The API returns your data
** in this structure. The field names are in the structure
**************************************************************************
C parm COMMENTDS
**************************************************************************
C parm DBDSLn
C parm DBActLn
C parm DBRespCd
C parm QUSEC
C ENDSR
* This is the STD OUT SUBR
C STDOUT BEGSR
C callb APIStdOut
C parm OUTBuff
C parm OUTBuffLn
C parm QUSEC
C ENDSR
* Compile-time array follows:
**CTDATA HTMLO
Content-type: text/html
AS/400 Internet Connection - Short Commment
Your Feedback :
Name............. :
E-mail........... :
Street address... :
Address ( cont. ) :
City............. :
State/Province... :
Zip/Postal code.. :
Country.......... :
Phone Number..... :
Your Comments :
The data will not be stored and used in any way other than for this example.