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

2013年(15)

2012年(17)

2011年(17)

2010年(135)

2009年(85)

2008年(18)

分类: 系统运维

2010-06-04 16:50:43

Retrieve Object Description **-- Global variables:-------------------------------------------------** D ObjNam       s      10 a
D ObjLib       s      10 a
D ObjTyp       s      10 a
**-- Api error data structure:-----------------------------------------**
D ApiError     Ds
D AeBytPro            10 i 0    Inz( %Size( ApiError ))
D AeBytAvl            10 i 0    Inz
D AeMsgId              7 a
D                      1 a
D AeMsgDta           128 a
**-- Object description structure OBJD0100:----------------------------**
D RoData       Ds
D RoBytRtn            10 i 0
D RoBytAvl            10 i 0
D RoObjNam            10 a
D RoObjLib            10 a
D RoObjTypRt          10 a
D RoObjLibRt          10 a
D RoObjASP            10 i 0
D RoObjOwn            10 a
D RoObjDmn             2 a
D RoObjCrtDts         13 a
D RoObjChgDts         13 a
D RoExtAtr            10 a
D RoTxtDsc            50 a
D RoSrcF              10 a
D RoSrcLib            10 a
D RoSrcMbr            10 a
**-- Retrieve object description:--------------------------------------**
D RtvObjD       Pr             ExtPgm( 'QUSROBJD' )
D RoRcvVar         32767 a     Options( *VarSize )
D RoRcvVarLen         10 i 0   Const
D RoFmtNam             8 a     Const
D RoObjNamQ           20 a     Const
D RoObjTyp            10 a     Const
D RoError          32767 a     Options( *VarSize )
** **-- Get Web value:----------------------------------------------------** **
C               Eval ObjNam = '???'
C               Eval ObjLib = '*LIBL'
C               Eval ObjTyp = '*PGM'
**
C               CallP RtvObjD( RoData C : %Size( RoData )
C                     : 'OBJD0100'
C                     : ObjNam + ObjLib
C                     : ObjTyp
C                     : ApiError C )
**
C              If AeBytAvl > *Zero
C              If %Subst(AeMsgId:1:5) = 'CPF98'
**-- Object doesn't exist...
** CPF9801 E - Object &2 in library &3 not found.
** CPF9802 E - Not authorized to object &2 in &3.
** CPF9803 E - Cannot allocate object &2 in library &3.
** CPF9811 E - Program &2 in library &3 not found. C EndIf C EndIf C Return
** Thanks to Carsten Flensburg and Bob Cozzi
阅读(916) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~