Refer to shipped RPG source file QRPGLRSRC and CRTDEMO program source in QCLSRC source file.
This HTTP example is self-contained and requires no additional work besides compilation. This assumes that the sample website is operational.
H OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER)
H BNDDIR('JSMBNDDIR')
*
D JSMHDL S 4A INZ(*BLANKS)
D JSMSRV S 50A INZ(*BLANKS)
D JSMSTS S 20A INZ(*BLANKS)
D JSMMSG S 512A INZ(*BLANKS)
D JSMCMD S 512A INZ(*BLANKS)
D ZEROLENGTH S 10I 0 INZ(0)
*
D HOST S 40A INZ(*BLANKS)
*
* JSMX_BEGIN
*
C CALLB(D) 'JSMX_BEGIN'
C PARM *OMIT
C PARM ZEROLENGTH
*
* JSMX_OPEN - USE JSMCLTDTA FOR SERVER
*
C CLEAR JSMSRV
C EVAL JSMSRV = ''
C CALLB(D) 'JSMX_OPEN'
C PARM JSMHDL
C PARM JSMSRV
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* SERVICE_LOAD
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'SERVICE_LOAD' +
C ' SERVICE(HTTPService)' +
C ' TRACE(*YES)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* SEND REQUEST
*
* NOTE: REQUIRES JDK 8.0 FOR SNI SUPPORT
*
C EVAL HOST = 'jsonplaceholder.typicode.com'
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'SEND' +
C ' HOST(' + HOST + ')' +
C ' HANDLER(OutboundNameValue)' +
C ' URI(/users)' +
C ' SECURE(*YES)'+
C ' SNISERVER(*HOST)' +
C ' METHOD(*GET)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* RECEIVE CONTENT
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'RECEIVE' +
C ' HANDLER(InboundFile)' +
C ' TO(demo.json)'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* SERVICE_UNLOAD
*
C CLEAR JSMCMD
C EVAL JSMCMD = 'SERVICE_UNLOAD'
C CALLB(D) 'JSMX_COMMAND'
C PARM JSMHDL
C PARM JSMCMD
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* JSMX_CLOSE
*
C CALLB(D) 'JSMX_CLOSE'
C PARM JSMHDL
C PARM JSMSTS
C PARM JSMMSG
C CALLP checkSTS(JSMSTS:JSMMSG)
*
* JSMX_END
*
C CALLB(D) 'JSMX_END'
*
C SETON LR
********************************
* Procedure to check JSM status
********************************
P checkSTS B
D checkSTS PI N
D csJSMSTS CONST LIKE(JSMSTS)
D csJSMMSG CONST LIKE(JSMMSG)
D csMSGTXT S 512A
C IF csJSMSTS <> 'OK'
C EVAL csMSGTXT = %TRIM(csJSMSTS) + ' ' +
C %TRIM(csJSMMSG)
C CALLP sendMSG(csMSGTXT)
C RETURN *OFF
C ENDIF
C RETURN *ON
P E
**************************************
* Procedure to send a program message
**************************************
P sendMSG B
D sendMSG PI
D smMSGTXT 512A VALUE
D smMSGT S 10A INZ('*DIAG')
D smMSGI S 7A INZ('CPF9897')
D smMSGF S 20A INZ('QCPFMSG *LIBL ')
D smMSGL S 10I 0 INZ(%SIZE(smMSGTXT))
D smSTKE S 10A INZ('*')
D smSTKC S 10I 0 INZ(1)
D smMSGK S 4A INZ(*BLANK)
D smERRC S 10I 0 INZ(0)
C CALL 'QMHSNDPM'
C PARM smMSGI
C PARM smMSGF
C PARM smMSGTXT
C PARM smMSGL
C PARM smMSGT
C PARM smSTKE
C PARM smSTKC
C PARM smMSGK
C PARM smERRC
P E