midrange.com code scratchpad
Name:
Command: RTVENVVAR
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
02/15/2008 08:16:21 am
IP:
Logged
Description:
Command: RTVENVVAR with API Qp0zGetEnv, Qp0zGetSysEnv
Code:
  1. <b>
  2. File   : QRPGLESRC
  3. Member : RTVENVVAR
  4. Type   : RPGLE
  5. Usage  : CRTBNDRPG PGM(RTVENVVAR) TGTRLS(V5R1M0)
  6. </b>
  7.      H Debug
  8.      H OPTION(*NODEBUGIO : *SRCSTMT) DFTACTGRP(*NO) BNDDIR('QC2LE')
  9.       **************************************************************************
  10.       **  This program returns the environment variable's value.
  11.       **  It is stuffed into the CL variable passed on the 2nd parm.
  12.       **   CPP for RTVENVVAR CL command.
  13.       **************************************************************************
  14.  
  15.       ** Template definition used for 2nd parameter
  16.      D CL_RTNVAR_T     DS                  based(pNothing_T) QUALIFIED
  17.      D  nLen                          5I 0
  18.      D  Data                      32766A
  19.  
  20.      D RtvEnvVar       PR
  21.      D  envvar                      256A
  22.      D  rtnVar                             LIKEDS(CL_RTNVAR_T)
  23.      D  envlvl                        4A
  24.  
  25.      D RtvEnvVar       PI
  26.      D  envvar                      256A
  27.      D  rtnVar                             LIKEDS(CL_RTNVAR_T)
  28.      D  envlvl                        4A
  29.  
  30.       * Get job level env
  31.      D Qp0zGetEnv      PR              *   ExtProc('Qp0zGetEnv')
  32.      D  envvar                         *   VALUE OPTIONS(*STRING)
  33.      D  nCCSID                       10I 0
  34.  
  35.       * Get sys level env
  36.      D Qp0zGetSysEnv   PR            10I 0 ExtProc('Qp0zGetSysEnv')
  37.      D  envVarName                     *   VALUE OPTIONS(*STRING)
  38.      D  rtnBuffer                 65535A   OPTIONS(*VARSIZE)
  39.      D  bufLen                       10I 0
  40.      D  nCCSID                       10I 0
  41.      D  reserved                       *   OPTIONS(*OMIT)
  42.  
  43.      D  rtnBuffer      S            512A
  44.      D  pRtnBuffer     S               *   Inz
  45.      D  pEnv           S               *   Inz
  46.      D  bufLen         S             10I 0
  47.      D  nCCSID         S             10I 0 Inz(0)
  48.      D  nRtn           S             10I 0 Inz(0)
  49.  
  50.      C                   eval      *INLR = *ON
  51.      C                   if        envlvl = '*JOB'
  52.       ** Retrieve a pointer to the environment variable's value
  53.      C                   eval      pEnv = Qp0zGetEnv(%TRIMR(ENVVAR):nCCSID)
  54.  
  55.       **  If nothing came back, then the ENVVAR is bad, so return nothing.
  56.      C                   if        pEnv = *NULL
  57.      C                   return
  58.      C                   endif
  59.  
  60.       **  Copy the environment variable to the return variable,
  61.       **  being careful not to overstep the variable's length.
  62.      C                   eval      %subst(rtnVar.Data:1:rtnVar.nLen) =
  63.      C                                %str(pEnv)
  64.      C                   else
  65.      C                   eval      bufLen = %len(rtnBuffer)
  66.      C                   eval      nRtn = Qp0zGetSysEnv(%TRIMR(ENVVAR):
  67.      C                                                  rtnBuffer  :
  68.      C                                                  bufLen     :
  69.      C                                                  nCCSID :
  70.      C                                                  *OMIT)
  71.      C                   if        nRtn <> 0
  72.      C                   dump
  73.      C                   return
  74.      C                   endif
  75.  
  76.      C                   eval      rtnVar.nLen = bufLen
  77.      C                   eval      pRtnBuffer = %addr(rtnBuffer)
  78.      C                   eval      %subst(rtnVar.Data:1:bufLen) =
  79.      C                                %str(pRtnBuffer)
  80.      C                   endif
  81.  
  82.      C                   return
  83.  
  84.  
  85. <b>
  86. File   : QCMDSRC
  87. Member : RTVENVVAR
  88. Type   : CMD
  89. Usage  : CRTCMD CMD(your-lib/RTVENVVAR) PGM(your-lib/RTVENVVAR) ALLOW(*IPGM *BPGM) 
  90. </b>
  91.  RTVENVVAR:  CMD        PROMPT('Retrieve Environment Variable')
  92.  
  93.              /* Command processing program is RTVENVVAR   */
  94.  
  95.              PARM       KWD(ENVVAR) TYPE(*CHAR) LEN(256) MIN(1) +
  96.                           EXPR(*YES) INLPMTLEN(17) +
  97.                           PROMPT('Environment variable')
  98.              PARM       KWD(RTNVAL) TYPE(*CHAR) LEN(1) RTNVAL(*YES) +
  99.                           VARY(*YES) CHOICE('Environment var return +
  100.                           value') PROMPT('CL Var. for return value')
  101.              PARM       KWD(LEVEL) TYPE(*CHAR) LEN(4) RSTD(*YES) +
  102.                           DFT(*JOB) SPCVAL((*JOB) (*SYS)) +
  103.                           EXPR(*YES) PMTCTL(*PMTRQS) PROMPT('Level')
  104.  
  105. <b>
  106. File   : QCLSRC
  107. Member : RTVENVVARC
  108. Type   : CLP
  109. Usage  :  
  110.          CRTCLPGM RTVENVVARC
  111.          CALL RTVENVVARC 
  112. </b>
  113. /* Before you run the program run following command to set sample   */
  114. /* environment variable for testing:                                */
  115. /*  ADDENVVAR ENVVAR(JOBCLASSPATH) VALUE('.:/java')                 */
  116. /*  ADDENVVAR ENVVAR(SYSCLASSPATH) VALUE('.:/system') LEVEL(*SYS)   */
  117.  
  118. /* After  you run the program run following command to reset ENVVAR */
  119. /*  RMVENVVAR ENVVAR(JOBCLASSPATH)                                  */
  120. /*  RMVENVVAR ENVVAR(SYSCLASSPATH) LEVEL(*SYS)                      */
  121.  
  122. /* You can browse spooled file QPPGMDMP under current job for job   */
  123. /* and system level value same as we set above                      */
  124.  
  125.              PGM
  126.  
  127.              DCL &SYSPATH *CHAR 32
  128.              DCL &JOBPATH *CHAR 32
  129.  
  130.              RTVENVVAR  ENVVAR(JOBCLASSPATH) RTNVAL(&JOBPATH)
  131.  
  132.              RTVENVVAR  ENVVAR(SYSCLASSPATH) RTNVAL(&SYSPATH) +
  133.                           LEVEL(*SYS)
  134.              DMPCLPGM
  135.  
  136.              ENDPGM
  137.  
  138.  
© 2004-2019 by midrange.com generated in 0.005s valid xhtml & css