PGM /*-------------------------------------------------------------------*/ /* TESTOBJL : API:QGYOLOBJ のテスト */ /* */ /* 2020/07/31 作成 */ /*-------------------------------------------------------------------*/ DCL VAR(&MSG) TYPE(*CHAR) LEN(132) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132) DCL VAR(&TYPE) TYPE(*CHAR) LEN(1) DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10) DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) + VALUE('*ESCAPE ') DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) + VALUE(X'000074') /* 2 進数 */ DCL VAR(&ERR) TYPE(*CHAR) LEN(1) DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) + VALUE(X'00000000') /*( QGYOLOBJ に必要な変数 )*/ DCL VAR(&RCVBUF) TYPE(*CHAR) LEN(32000) DCL VAR(&RCVLEN) TYPE(*CHAR) LEN(4) + VALUE(X'00007D00') DCL VAR(&LISTINFO) TYPE(*CHAR) LEN(80) DCL VAR(&LISTSU) TYPE(*CHAR) LEN(4) + VALUE(X'0000000A') DCL VAR(&NBRRCD) TYPE(*CHAR) LEN(4) + VALUE(X'000001F4') /* 500 個 */ DCL VAR(&SORT) TYPE(*CHAR) LEN(4) + VALUE(X'00000000') DCL VAR(&OBJOBJLIB) TYPE(*CHAR) LEN(20) + VALUE('*ALL QSYS ') DCL VAR(&AUTO) TYPE(*CHAR) LEN(48) DCL VAR(&OBJAUT) TYPE(*CHAR) LEN(10) + VALUE('*ALL ') DCL VAR(&LIBAUT) TYPE(*CHAR) LEN(10) + VALUE('*ALL ') DCL VAR(&SELECT) TYPE(*CHAR) LEN(21) DCL VAR(&DPLSTS) TYPE(*CHAR) LEN(4) + VALUE(X'00000014') DCL VAR(&NBRSTS) TYPE(*CHAR) LEN(4) + VALUE(X'00000001') DCL VAR(&KEYSU) TYPE(*CHAR) LEN(4) + VALUE(X'00000001') DCL VAR(&KEYARY) TYPE(*CHAR) LEN(4) + VALUE(X'000000CA') DCL VAR(&BIN0) TYPE(*CHAR) LEN(4) + VALUE(X'00000000') DCL VAR(&BIN1) TYPE(*CHAR) LEN(4) + VALUE(X'00000001') DCL VAR(&BIN4) TYPE(*CHAR) LEN(4) DCL VAR(&PRINTER) TYPE(*CHAR) LEN(10) DCL VAR(&OUTQQLIB) TYPE(*CHAR) LEN(20) DCL VAR(&RTNSU) TYPE(*DEC) LEN(5 0) DCL VAR(&RTNSUC) TYPE(*CHAR) LEN(5) /*( QGYGTLE に必要な変数 )*/ DCL VAR(&LSTHND) TYPE(*CHAR) LEN(4) DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(256) DCL VAR(&VARLEN) TYPE(*CHAR) LEN(4) + VALUE(X'00000100') DCL VAR(&N) TYPE(*DEC) LEN(7 0) DCL VAR(&STRCNV) TYPE(*CHAR) LEN(4) DCL VAR(&TEXT) TYPE(*CHAR) LEN(50) DCL VAR(&STSBIN) TYPE(*CHAR) LEN(4) DCL VAR(&COUNT) TYPE(*DEC) LEN(5 0) DCL VAR(&COUNTC) TYPE(*CHAR) LEN(5) DCL VAR(&DEV) TYPE(*CHAR) LEN(10) DCL VAR(&OBJATR) TYPE(*CHAR) LEN(10) /* MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR)) */ /*( 環境の取得 )*/ RTVJOBA TYPE(&TYPE) IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */ CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ') ENDDO /* バッチ */ ELSE CMD(DO) /* 対話式 */ CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ') ENDDO /* 対話式 */ /*( オブジェクト・リストのオープン )*/ CHGVAR VAR(%SST(&LISTINFO 1 4)) VALUE(&LISTSU) CHGVAR VAR(%BIN(&BIN4)) VALUE(48) CHGVAR VAR(&AUTO) VALUE(&BIN4 *CAT &BIN0 *CAT &BIN0 + *CAT &BIN0 *CAT &BIN0 *CAT &BIN0 *CAT + &BIN0 *CAT &OBJAUT *CAT &LIBAUT) CHGVAR VAR(%BIN(&BIN4)) VALUE(22) CHGVAR VAR(&SELECT) VALUE(&BIN4 *CAT &BIN0 *CAT + &DPLSTS *CAT &NBRSTS *CAT &BIN0 *CAT ' ') CHGVAR VAR(%BIN(&NBRRCD)) VALUE(-1) CALL PGM(QGYOLOBJ) PARM(&RCVBUF &RCVLEN &LISTINFO + &NBRRCD &SORT &OBJOBJLIB '*DEVD ' + &AUTO &SELECT &KEYSU &KEYARY &APIERR) IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO) SNDPGMMSG + MSG('API: QGYOLOBJ の実行で次のエラーが発生 + しました。 ') MSGTYPE(*DIAG) GOTO APIERR ENDDO SNDPGMMSG + MSG(' オブジェクト・リストのオープンに成功 + ') MSGTYPE(*DIAG) /*( リスト検索の開始 )*/ CHGVAR VAR(&BIN4) VALUE(%SST(&LISTINFO 1 4)) CHGVAR VAR(&RTNSU) VALUE(%BIN(&BIN4)) IF COND(&RTNSU *EQ 0) THEN(DO) /* + 戻り数がない */ GOTO ENDLIST ENDDO /* 戻り数がない */ IF COND(&RTNSU > 0) THEN(DO) /* 戻り数 >0 */ CHGVAR VAR(&LSTHND) VALUE(%SST(&LISTINFO 9 4)) CHGVAR VAR(&COUNT) VALUE(0) CHGVAR VAR(&N) VALUE(1) CHGVAR VAR(%BIN(&STRCNV)) VALUE(1) CHGVAR VAR(%BIN(&NBRRCD)) VALUE(1) LOOP: CALL PGM(QGYGTLE) PARM(&RCVVAR &VARLEN &LSTHND + &LISTINFO &NBRRCD &STRCNV &APIERR) IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO) SNDPGMMSG + MSG('API: QGYGTLE の実行で次のエラーが発生 + しました。 ') MSGTYPE(*DIAG) GOTO APIERR ENDDO /*( 戻り値を取得する )*/ CHGVAR VAR(&DEV) VALUE(%SST(&RCVVAR 1 10)) CHGVAR VAR(&OBJATR) VALUE(%SST(&RCVVAR 53 10)) IF COND(%SST(&OBJATR 1 3) *EQ 'PRT') THEN(DO) CHGVAR VAR(&COUNT) VALUE(&COUNT + 1) ENDDO BYPAS: IF COND(&N < &RTNSU) THEN(DO) CHGVAR VAR(&N) VALUE(&N + 1) CHGVAR VAR(%BIN(&STRCNV)) VALUE(%BIN(&STRCNV) + 1) GOTO LOOP ENDDO CHGVAR VAR(&COUNTC) VALUE(&COUNT) NXTCNT: IF COND(%SST(&COUNTC 1 1) = '0') THEN(DO) CHGVAR VAR(&COUNTC) VALUE(%SST(&COUNTC 2 4)) GOTO NXTCNT ENDDO CHGVAR VAR(&MSG) VALUE(&COUNTC *TCAT + ' 個のプリンターが見つかりました。 ') CHGVAR VAR(&MSGTYPE) VALUE('*DIAG ') SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG) ENDDO /* 戻り数 >0 */ /*( リストのクローズ )*/ ENDLIST: CALL PGM(QGYCLST) PARM(&LSTHND &APIERR) RETURN APIERR: CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7)) CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100)) IF COND(%SST(&MSGID 1 3) *EQ 'GUI') THEN(DO) CHGVAR VAR(&MSGF) VALUE('QGUIMSG ') ENDDO ELSE CMD(DO) CHGVAR VAR(&MSGF) VALUE('QCPFMSG ') ENDDO CHGVAR VAR(&MSGFLIB) VALUE('QSYS ') GOTO SNDMSG ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) + MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) + MSGFLIB(&MSGFLIB) SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO) SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) + TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE) MONMSG MSGID(CPF2400) EXEC(RETURN) ENDDO ELSE CMD(DO) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) + MSGTYPE(&MSGTYPE) MONMSG MSGID(CPF2400) EXEC(RETURN) ENDDO ENDPGM