Chinaunix首页 | 论坛 | 博客
  • 博客访问: 1298638
  • 博文数量: 287
  • 博客积分: 11000
  • 博客等级: 上将
  • 技术积分: 3833
  • 用 户 组: 普通用户
  • 注册时间: 2007-08-16 08:43
文章分类
文章存档

2013年(15)

2012年(17)

2011年(17)

2010年(135)

2009年(85)

2008年(18)

分类: 系统运维

2010-06-05 09:00:13

Retrieve System Value
h dftactgrp(*no) actgrp('QILE') bnddir('QC2LE')
 * Prototype for QWCRSVAL API - Retrieve QUSRLIBL
d QWCRSVALU     pr              ExtPgm('QWCRSVAL')
d p_Rcvr                        Like(u_Rcvr)
d p_RcvrLngth                   Like(u_RcvrLngth)
d p_NbrToRtv                    Like(u_NbrToRtv)
d p_SysVal                      Like(u_SysVal)
d p_Error                       Like(u_APIError)
 * Prototype for QWCRSVAL API - Retrieve QSYSLIBL
d QWCRSVALS     pr              ExtPgm('QWCRSVAL')
d p_Rcvr                        Like(s_Rcvr)
d p_RcvrLngth                   Like(s_RcvrLngth)
d p_NbrToRtv                    Like(s_NbrToRtv)
d p_SysVal                      Like(s_SysVal)
d p_Error                       Like(s_APIError)
d #QUSRLIBL     pr      250a
d #QSYSLIBL     pr      150a
d ds           
d UsrLibl               250
d SysLibl               150
d USRLIBLDS     ds             inz
d u_Rcvr                278a
d u_RcvrLngth             9b 0 inz(%len(u_Rcvr))
d u_NbrToRtv              9b 0 inz(1)
d u_SysVal               10a   inz('QUSRLIBL')
d u_APIError              1
d SYSLIBLDS     ds             inz
d s_Rcvr                178a
d s_RcvrLngth             9b 0 inz(%len(s_Rcvr))
d s_NbrToRtv              9b 0 inz(1)
d s_SysVal               10a   inz('QSYSLIBL')
d s_APIError              1
 * Program Mainline c
 /free
     UsrLibl=#QUSRLIBL;
     SysLibl=#QSYSLIBL;
     *inlr=*on;
 /end-free
 * #QUSRLIBL - Retrieve the QUSRLIBL library list
p #QUSRLIBL     b               Export
d #QUSRLIBL     pi      250a
d DS_SysValTbl  ds              inz
d d_ValsRtn               9b 0
d d_Offset                9b 0
d d_SysVal               10a
d d_ValType               1a
d d_InfoSts               1a
d d_DtaLngth              9b 0
d d_Data                250a
c/free
     reset u_APIError;
     qwcrsvalu(u_Rcvr: u_RcvrLngth: u_NbrToRtv:
               u_SysVal: u_APIError);
     ds_SysValTbl = u_Rcvr;
     return %subst(d_Data:1:d_DtaLngth);
 /end-free
p #QUSRLIBL     e
* #QSYSLIBL - Retrieve the QSYSLIBL library list
p #QSYSLIBL     b                Export
d #QSYSLIBL     pi      150a
d DS_SysValTbl  ds               inz
d d_ValsRtn              9b 0
d d_Offset               9b 0
d d_SysVal              10a
d d_ValType              1a
d d_InfoSts              1a
d d_DtaLngth             9b 0
d d_Data               150a
c/free
     reset s_APIError;
     qwcrsvals(s_Rcvr: s_RcvrLngth: s_NbrToRtv:
               s_SysVal: s_APIError);
     ds_SysValTbl = s_Rcvr;
     return %subst(d_Data:1:d_DtaLngth);
 /end-free
p #QSYSLIBL     e

Thanks to Tom H.
 
 And one more ...
D QWCRSVALD     PR                EXTPGM('QWCRSVAL')
D QRSYS                           LIKE(QRSYSD)
D QRLEN                           LIKE(QRLEND)
D QRNUM                           LIKE(QRNUMD)
D QRVAR                           LIKE(QRVARD)
D QRERR                 200A      OPTIONS(*VARSIZE) CONST
D*
D* system value reciver: date format
D QRTVFMTD     DS
D QRSYSD                 31A      INZ(' ')                 Receiver variable
D QRLEND                 10I 0    INZ(%len(QRSYSD))        Length recevr var
D QRNUMD                 10I 0    INZ(1)                   Number of sys val
D QRVARD                 10A      INZ('QDATFMT')           System value name
D*
D QFORMAT      DS
D QNBR                   10I 0    INZ(0)                   Number of sys val
D QOFF                   10I 0    INZ(0)                   Offset to sys val
D QVAL                 5000A      INZ(' ')                 System value info
D*
D SYSDATA      DS
D SYSVAL                 10A      INZ(' ')
D SYSTYP                  1A      INZ(' ')
D SYSSTA                  1A      INZ(' ')
D SYSLEN                 10I 0    INZ(0)
D SYSDAT               3000A      INZ(' ')
D* 
D ERRC0100     DS
D ERRBYT                 10I 0    INZ(0)                   Bytes provided
D ERRAVAL                10I 0    INZ(0)                   Bytes available
D ERREXC                  7A      INZ(' ')                 Exception ID
D ERRRES                  1A      INZ(' ')                 Reserved
D ERROUT                 84A      INZ(' ')                 Output
 /FREE
    // get QDATFMT system value using API's
    CALLP QWCRSVALD (QRSYSD : QRLEND : QRNUMD :
                     QRVARD : ERRC0100);
    EVAL QFORMAT = QRSYSD;
    EVAL SYSDATA = QVAL;
 /END-FREE

 Thanks Joe M. Wesson

 

阅读(749) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~