2006-04-25 如何檢核 TCPIP 是否已啟動 ?(Command RTVTCPSTS with API QtocRtvTCPA)

如何檢核 TCPIP 是否已啟動 ?(Command RTVTCPSTS with API QtocRtvTCPA)

File  : QRPGLESRC
Member: RTVTCPSTS
Type  : RPGLE
Usage : CRTBNDRPG RTVTCPSTS


     **
     **  Program . . : RTVTCPSTS
     **  Description : Retrieve TCP/IP status
     **  Author  . . : Vengoal Chang
     **  Published . : AS400ePaper
     **  Date  . . . : April 21, 2006
     **
     **
     **  Program summary
     **  ---------------
     **
     **  Object - User space APIs:
     **    QUSCRTUS       Create user space    Creates a user space in either
     **                                        user domain or system domain.
     **                                        Only user domain user spaces are
     **                                        accessible by the user space APIs.
     **
     **    QUSDLTUS       Delete user space    Deletes the user space specified.
     **
     **    QUSPTRUS       Retrieve pointer to  The address of the first byte
     **                   user space           of the storage allocated by the
     **                                        user space requested is returned.
     **
     **
     **  Communication - TCP/IP management APIs:
     **    QtocRtvTCPA       Retrieve TCP/IP   Retrieves TCP/IPv4 and TCP/IPv6
     **                      attributes        (V5R2) stack attributes.
     **                                        API introduced: V5R1
     **
     **  TCP/IP stack status
     **     0   Inactive
     **     1   Active
     **     2   Starting
     **     3   Ending, immediate
     **     4   Ending, controlled
     **
     **
     **  events:
     **       The current operational status of the TCP/IP stack is retrieved
     **       to ensure that TCP/IP connection information is available.
     **
     **
     **  Compile options:
     **
     **    CrtRpgMod Module( RTVTCPSTS )  DbgView( *LIST )
     **
     **    CrtPgm    Pgm( RTVSCPSTS )
     **              Module( RTVTCPSTS )
     **
     **-- Header specifications:  --------------------------------------------**
     H Option( *SrcStmt ) DFTACTGRP(*NO) debug
     **-- Api error data structure:  -----------------------------------------**
     D ApiError        Ds
     D  AeBytPro                     10i 0 Inz( %Size( ApiError ))
     D  AeBytAvl                     10i 0 Inz
     D  AeMsgId                       7a
     D                                1a
     D  AeMsgDta                    128a
     **
     **-- TCP/IP attributes:  ------------------------------------------------**
     D TCPA0100        Ds
     D  T1BytRtn                     10u 0
     D  T1BytAvl                     10u 0
     D  T1StkSts                     10u 0
     D  T1ActTim                     10u 0
     D  T1LstStrD                     8a
     D  T1LstStrT                     6a
     D  T1LstEndD                     8a
     D  T1LstEndT                     6a
     D  T1StrJob                     10a
     D  T1StrUsr                     10a
     D  T1StrNbr                      6a
     D  T1StrJobInt                  16a
     D  T1EndJob                     10a
     D  T1EndUsr                     10a
     D  T1EndNbr                      6a
     D  T1EndJobInt                  16a
     D  T1OfsAddInf                  10u 0
     D  T1LenAddInf                  10u 0
     **-- Retrieve TCP/IP attributes:  ---------------------------------------**
     D RtvTcpA         Pr                  ExtProc( 'QtocRtvTCPA' )
     D  RtRcvVar                  32767a          Options( *VarSize )
     D  RtRcvVarLen                  10i 0 Const
     D  RtFmtNam                      8a   Const
     D  RtError                   32767a          Options( *VarSize )
     **
     D TCPSTS          s              1
     ** Return TCP/IP status
     ** 'E' --> TCP/IP API error.
     ** '0' --> TCP/IP not active.
     ** '1' --> TCP/IP is  active.
     **
     **-- Mainline:  ---------------------------------------------------------**
     **
     C     *entry        Plist
     C                   Parm                    TCPSTS
     **
     C                   CallP     RtvTcpA( TCPA0100
     C                                    : %Size( TCPA0100 )
     C                                    : 'TCPA0100'
     C                                    : ApiError
     C                                    )
     **
     C                   Select
     C                   When      AeBytAvl    > *Zero
     **-- Error occurred...
     C                   Eval      TcpSts = 'E'
     C*                  dump
     **
     C                   When      T1StkSts    = 0             Or
     C                             T1StkSts    = 2
     **-- TCP/IP stack not operational...
     C                   Eval      TcpSts = '0'
     **
     C                   When      T1StkSts    = 3             Or
     C                             T1StkSts    = 4
     **-- TCP/IP Ending ....
     C                   Eval      TcpSts = '0'
     **
     C                   Other
     **-- TCP/IP Active ...
     C                   Eval      TcpSts = '1'
     C                   EndSl
     **
     C                   Eval      *InLr       = *On
     C                   Return
     **



File  : QCMDSRC
Member: RTVTCPSTS
Type  : CMD
Usage : CRTCMD CMD(RTVTCPSTS) PGM(RTVTCPSTDS) ALLOW(*IPGM *BPGM)
        


/*  ===============================================================  */
/*  = 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                                     =  */
/*  =    'E' -- TCP/IP API error                                  =  */
/*  ===============================================================  */
/*  = 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')



File  : QCLSRC
Member: RTVTCPSTST
Type  : CLP 
Usage : CRTCLPGM RTVTCPSTST
        測試程式
        CALL RTVTCPSTST


PGM

             DCL        VAR(&TCPSTS) TYPE(*CHAR) LEN(1)

             RTVTCPSTS  TCPSTS(&TCPSTS)

             IF         COND(&TCPSTS *EQ '1') THEN(SNDPGMMSG +
                          MSG('TCP/IP status is active.'))
             IF         COND(&TCPSTS *EQ '2') THEN(SNDPGMMSG +
                          MSG('TCP/IP status is ending.'))
             IF         COND(&TCPSTS *EQ '0') THEN(SNDPGMMSG +
                          MSG('TCP/IP status is not active.'))
             IF         COND(&TCPSTS *EQ 'E') THEN(SNDPGMMSG +
                          MSG('TCP/IP API call error! Please see +
                          dump printer file.'))
ENDPGM