PGM /*-------------------------------------------------------------------*/ /* TESTPRTL : API:QGYRPRTL のテスト */ /* */ /* 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') /*( QGYRPRTL に必要な変数 )*/ 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(&FILTER) TYPE(*CHAR) LEN(40) 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(64) 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) /*( QDCRDEVD に必要な変数 )*/ DCL VAR(&RCVDEV) TYPE(*CHAR) LEN(1024) DCL VAR(&DEVLEN) TYPE(*CHAR) LEN(4) + VALUE(X'00000400') DCL VAR(&DEV) TYPE(*CHAR) LEN(10) DCL VAR(&CLASS) TYPE(*CHAR) LEN(10) DCL VAR(&COUNT) TYPE(*DEC) LEN(5 0) DCL VAR(&COUNTC) TYPE(*CHAR) LEN(5) 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(&FILTER) VALUE(&BIN0 *CAT &BIN0) CALL PGM(QGYRPRTL) PARM(&RCVBUF &RCVLEN &LISTINFO + &NBRRCD &FILTER 'PRTL0100' &APIERR) IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO) SNDPGMMSG + MSG('API: QGYRPRTL の実行で次のエラーが発生 + しました。 ') MSGTYPE(*DIAG) GOTO APIERR ENDDO 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(&N) VALUE(1) CHGVAR VAR(%BIN(&NBRRCD)) VALUE(1) CHGVAR VAR(%BIN(&STRCNV)) VALUE(1) CHGVAR VAR(%BIN(&RCVLEN)) VALUE(64) CHGVAR VAR(&COUNT) VALUE(0) LOOP: CALL PGM(QGYGTLE) PARM(&RCVVAR &RCVLEN &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(&PRINTER) VALUE(%SST(&RCVVAR 1 10)) CHGVAR VAR(&TEXT) VALUE(%SST(&RCVVAR 11 50)) CHGVAR VAR(&STSBIN) VALUE(%SST(&RCVVAR 61 4)) /*( *VRT のプリンタだけを選択する )*/ /*( 装置のクラスを調べる )*/ CHGVAR VAR(&DEV) VALUE(&PRINTER) CALL PGM(QDCRDEVD) PARM(&RCVDEV &DEVLEN + 'DEVD1100' &DEV &APIERR) IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO) SNDPGMMSG + MSG('API: QDCRDEVD の実行で次のエラーが発生 + しました。 ') MSGTYPE(*DIAG) GOTO APIERR ENDDO CHGVAR VAR(&CLASS) VALUE(%SST(&RCVDEV 153 10)) IF COND(&CLASS *NE '*VRT') THEN(DO) GOTO BYPAS ENDDO SNDPGMMSG MSG('PRINTER=' *CAT &PRINTER) + MSGTYPE(*DIAG) CHGVAR VAR(&COUNT) VALUE(&COUNT + 1) 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) RETURN 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