/******************************************************************************/
/* Copyright (c) Tom Liotta http://zap.to/tl400 Used with permission          */
/******************************************************************************/
 RTNIPADDR:  PGM        PARM(&RTVDEV &TCPADDR)

/* Device to retrieve */
             DCL        VAR(&RTVDEV) TYPE(*CHAR) LEN(10)
/* TCP/IP address     */
             DCL        VAR(&TCPADDR) TYPE(*CHAR) LEN(15)


/* Device name        */
             DCL        VAR(&DEVNAM) TYPE(*CHAR) LEN(10)
/* Error field        */
             DCL        VAR(&ERROR) TYPE(*CHAR) LEN(4) +
                          VALUE(X'00000000')
/* Network protocol   */
/* Set to TCP/IP      */
             DCL        VAR(&PROTOCOL) TYPE(*CHAR) LEN(1) VALUE(X'02')
/* Receiver variable  */
             DCL        VAR(&RCVVAR) TYPE(*CHAR) LEN(1024)

             MONMSG     MSGID(CPF0000 MCH0000) EXEC(GOTO +
                          CMDLBL(STDERR))
             IF         COND(&RTVDEV *EQ '*') THEN(RTVJOBA +
                          JOB(&RTVDEV))
/*  Call the Retrieve Device Description API, Format DEVD0600        */
/*  to retrieve information about selected device                    */
             CHGVAR     VAR(&RCVVAR) VALUE(' ')
             CHGVAR     VAR(&TCPADDR) VALUE(*BLANKS)
             CALL       PGM(QDCRDEVD) PARM(&RCVVAR X'00000400' +
                          'DEVD0600' &RTVDEV &ERROR)
/*   Extract values from receiver variable if retrieved device       */
/*   is a TCP/IP device (position 859, network protocol = X'02')     */
             CHGVAR     VAR(&DEVNAM) VALUE(%SST(&RCVVAR 22 10))
             IF         COND(&DEVNAM *NE ' ') THEN(DO)
             IF         COND(%SST(&RCVVAR 859 1) *EQ &PROTOCOL) +
                          THEN(DO)
             CHGVAR     VAR(&TCPADDR) VALUE(%SST(&RCVVAR 878 15))
             ENDDO
             ENDDO
             RETURN
 STDERR:     MOVDIAGMSG
             MONMSG     MSGID(CPF0000 MCH0000)
             RSNESCMSG
             MONMSG     MSGID(CPF0000 MCH0000)
             RETURN
             ENDPGM

-- MartinRowe - 24 Jun 2005
Topic revision: r1 - 24 Jun 2005 - 05:32:58 - MartinRowe
 
This site is powered by FoswikiCopyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400? Send feedback