RTCTCPSTS -- Retrieve TCP/IP status

 
/*  ===============================================================  */
/*  = 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))