Chinaunix首页 | 论坛 | 博客
  • 博客访问: 77090
  • 博文数量: 10
  • 博客积分: 246
  • 博客等级: 二等列兵
  • 技术积分: 121
  • 用 户 组: 普通用户
  • 注册时间: 2011-12-17 08:48
个人简介

rpgle已经是一门夕阳红语言吗

文章分类
文章存档

2012年(6)

2011年(4)

我的朋友

分类: 系统运维

2012-02-29 23:43:30

PF物理文件 EXISTSLOG

    A          R REXTLOG
    A            MSG         1000A
    A

 

RPGLE程序 EXISTS.RPGLE

H*=========================================================
H*调用系统API QUSROBJD
H* 读取obj的相关详细信息
H*
H*
H*=========================================================
FEXISTSLOG UF A E             DISK
*返回信息的长度
DRECEIVEVAR       S           1000    INZ
* 存储返回信息的变量
DRECEIVELEN       S              9B 0 INZ(1000)
*模式
DOBJDFORMAT       S              8    INZ('OBJD0400')
*文件名和库名
DOBJECTLIB        S             20    INZ('          *LIBL     ')
*类型
DOBJECTTYPF       S             10    INZ('*PGM')
DVALID            S              1
D
*返回错误信息
DERRORDS          DS           116    INZ
D BYTESPRV                1      4B 0 INZ(116)
D BYTESAVL                5      8B 0 INZ(0)
D MESSAGEID               9     15
D ERR###                 16     16
D MESSAGEDTA             17    116
D
DPGMNAME          S             10A
D
C     *ENTRY        PLIST
C                   PARM                    PGMNAME
C
C                   MOVEL     PGMNAME       OBJECTLIB
C
C                   CALL      'QUSROBJD'
C                   PARM                    RECEIVEVAR
C                   PARM                    RECEIVELEN
C                   PARM                    OBJDFORMAT
C                   PARM                    OBJECTLIB
C                   PARM                    OBJECTTYPF
C                   PARM                    ERRORDS
C
C                   SELECT
C
C                   WHEN      MESSAGEID='CPF9821'
C                   EVAL      VALID='Y'
C                   WHEN      MESSAGEDTA<>*BLANKS
C                   EVAL      VALID='N'
C                   OTHER
C                   EVAL      VALID='Y'
C                   ENDSL
C
C*    VALID         DSPLY
C
C*    *LOVAL        SETLL     REXTLOG
C                   IF        VALID='Y'
C                   EVAL      MSG=RECEIVEVAR
C                   ELSE
C                   EVAL      MSG=MESSAGEDTA
C
C                   ENDIF
C                   WRITE     REXTLOG
C                   EVAL      *INLR=*ON
C                   RETURN
C

 

调用程序 call EXITS EXITS

DEBUG 查看变量结果:

 

EVAL RECEIVEVAR

RECEIVEVAR =

....5...10...15...20...25...30...35...40...45...50...55...60

1 ' EXISTS *LIBL *PGM TEST001 TEST003 '

61 ' *U11202091442381120209144238RPGLE * 判断 OBJ 是否存在 '

121 ' '

181 ' 1120224090838 TEST003 S102XYZM '

241 ' } *KEEP SAVLIB '

301 ' *SAVF TEST '

361 ' TEST001 V05R02M00CRTPGM V05R02M00 '

421 ' 1 1120229Y } '

481 'N10 0 *NONE *NONE 0 '

541 ' 0 } *SYSBAS *SYSBAS 00 '

601 '

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