/* =============================================================== */
/* = Command....... RtvTcpSts = */
/* = CPP........... RtvTcpSts RPGLE = */
/* = Description... Retrieve TCP/IP Status = */
/* = = */
/* = CrtCmd Cmd( RtvTcpSts ) = */
/* = Pgm( RtvTcpSts ) = */
/* = SrcFile( YourSourceFile ) Allow(*Ipgm *Bpgm) = */
/* =============================================================== */
/* = TCPSTS return value : = */
/* = '0' -- TCP/IP not active = */
/* = '1' -- TCP/IP active = */
/* =============================================================== */
/* = Date : 2006/04/24 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('Retrieve TCP/TP Status')
PARM KWD(TCPSTS) TYPE(*CHAR) LEN(1) RTNVAL(*YES) +
PROMPT('TCP/IP status')
RTVTCPSTS CPP source(member type CLLE):
/* =============================================================== */
/* = Command RtvTcpSts CPP = */
/* = RtvTcpSts CLLE = */
/* = Paramater notes: = */
/* = TCPSTS : 1 --> TCP/IP is active = */
/* = 0 --> TCP/IP is not active = */
/* =============================================================== */
/* = Date : 2006/04/28 = */
/* = Author: Vengoal Chang = */
/*http://as400bks.rochester.ibm.com/iseries/v5r2/ic2924/index.htm? */
/* info/apis/qtocrtvtcpa.htm */
/* =============================================================== */ pgm (&TCPSTS)
dcl &TcpSts *CHAR 1
dcl &RcvVar *CHAR 140
dcl &ApiErr *CHAR 8 X'0000000000000000'
dcl &Format *CHAR 8 'TCPA0100'
dcl &RcvVarLen *CHAR 4
dcl &TcpStkSts *CHAR 4
dcl &TcpStkStsn *dec 10 0
dcl &MsgId *CHAR 7
dcl &MsgDta *CHAR 256
dcl &MSGF *CHAR 10
dcl &MSGFLIB *CHAR 10
dcl &MSGTXT *CHAR 256
MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO error)
chgvar %Bin(&RcvVarLen) 140
callprc 'QtocRtvTCPA' ( +
&RcvVar +
&RcvVarLen +
&Format +
&ApiErr)
ChgVar &TcpStkSts %SST(&RcvVar 9 4)
ChgVar &TcpStkStsn %bin(&TcpStkSts)
If (&TcpStkStsn *NE 1) +
Chgvar &TcpSts '0'
Else +
Chgvar &TcpSts '1'
Return
/* =============================================================== */
/* = Error routine = */
/* =============================================================== */
Error:
RcvMsg MsgType( *Excp ) +
MsgDta( &MsgDta ) +
MsgID( &MsgID ) +
MsgF( &MsgF ) +
MsgFLib( &MsgFLib )
MonMsg ( CPF0000 MCH0000 )
SndMsg:
SndPgmMsg MsgID( &MsgID ) +
MsgF( &MsgFLib/&MsgF ) +
MsgDta( &MsgDta ) +
MsgType( *Escape )
MonMsg ( CPF0000 MCH0000 )
/* =============================================================== */
/* = End of program = */
/* =============================================================== */ endpgm
Note: In this tip it is VERY important to make sure the name of the API is entered exactly as shown, using upper and lower case in quotes:
CALLPRC PRC('QtocRtvTCPA') PARM((&RCVVAR) +
(&RCVVARLEN) (&FORMAT) (&APIERR)) This was first published in May 2006