PGM PARM(&RCVCMD &SNDPRM) /*-------------------------------------------------------------------*/ /* AA7_SAMPLE: プロンプト選択プログラム (CHOICEPGM) */ /* */ /* 2020/03/19 作成 */ /*-------------------------------------------------------------------*/ DCL VAR(&RCVCMD) TYPE(*CHAR) LEN(21) DCL VAR(&CMD) TYPE(*CHAR) LEN(10) DCL VAR(&KWD) TYPE(*CHAR) LEN(10) DCL VAR(&ACT) TYPE(*CHAR) LEN(1) DCL VAR(&SNDPRM) TYPE(*CHAR) LEN(2000) 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(&DEC08) TYPE(*DEC) LEN(8 0) DCL VAR(&DTALEN) TYPE(*CHAR) LEN(4) /* 2 進数 */ DCL VAR(&BIN4) TYPE(*CHAR) LEN(4) /* 2 進数 */ DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) + VALUE(X'00000074') /* 2 進数 */ DCL VAR(&PRMHED) TYPE(*CHAR) LEN(30) DCL VAR(&TOTAL) TYPE(*CHAR) LEN(2) DCL VAR(&PRM1992) TYPE(*CHAR) LEN(1992) DCL VAR(&LEN) TYPE(*DEC) LEN(8 0) DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00') DCL VAR(&COUNT) TYPE(*DEC) LEN(8 0) DCL VAR(&RECORD) TYPE(*CHAR) LEN(34) DCL VAR(&RECLEN) TYPE(*CHAR) LEN(2) DCL VAR(&KBN) TYPE(*CHAR) LEN(1) DCL VAR(&OBJOBJLIB) TYPE(*CHAR) LEN(20) + VALUE('dﾊﾞjﾞｫgq/waﾊﾞwxｰ') DCL VAR(&STRPOS) TYPE(*CHAR) LEN(4) + VALUE(X'0000007D') /* 2 進数開始位置 : + 125 */ DCL VAR(&LENDTA) TYPE(*CHAR) LEN(4) + VALUE(X'00000010') /* 2 進数受取長さ : 16 */ DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(16) + VALUE(X'0000000000000000') DCL VAR(&OFFSET) TYPE(*CHAR) LEN(4) /* + 2 進数 dﾊlWq */ DCL VAR(&NOENTR) TYPE(*CHAR) LEN(4) /* + 2 進数項目数 */ DCL VAR(&LSTSIZ) TYPE(*CHAR) LEN(4) /* + 2 進数リストサイズ */ DCL VAR(&ADDLEN) TYPE(*DEC) LEN(8 0) /* WORK */ DCL VAR(&NOENT) TYPE(*DEC) LEN(8 0) /* WORK */ DCL VAR(&N) TYPE(*DEC) LEN(8 0) VALUE(1) /* WORK */ DCL VAR(&RCVDTA) TYPE(*CHAR) LEN(1024) /* + 受取データ */ DCL VAR(&DEC08) TYPE(*DEC) LEN(8 0) DCL VAR(&FLD8) TYPE(*CHAR) LEN(8) DCL VAR(&DEV) TYPE(*CHAR) LEN(10) DCL VAR(&OBJATR) TYPE(*CHAR) LEN(10) MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR)) CHGVAR VAR(&CMD) VALUE(%SST(&RCVCMD 01 10)) CHGVAR VAR(&KWD) VALUE(%SST(&RCVCMD 11 10)) CHGVAR VAR(&ACT) VALUE(%SST(&RCVCMD 21 1)) IF COND(&ACT *EQ &NULL) THEN(DO) CHGVAR VAR(&SNDPRM) VALUE('F4=PROMOT') RETURN ENDDO IF COND(&ACT *EQ 'C') THEN(DO) CHGVAR VAR(&SNDPRM) VALUE(' 名前，リストは F4') RETURN ENDC: ENDDO /* ************************************************ */ /* ライターの検索 */ /* ************************************************ */ CHGVAR VAR(&COUNT) VALUE(0) /*( ユーザー・スペースの作成 )*/ CALL PGM(QUSCRTUS) PARM('QUSLOBJ QTEMP ' + 'PF ' 1000 ' ' '*ALL ' + 'QUSLOBJD 用ユーザー空間 ' '*YES ' + &APIERR) MONMSG CPF9870 /*( QUSLOBJ : オブジェクト・リストＡＰＩ )*/ CHGVAR VAR(&OBJOBJLIB) VALUE('*ALL QSYS ') CALL PGM(QUSLOBJ) PARM('QUSLOBJ QTEMP ' + 'OBJL0200' &OBJOBJLIB '*DEVD ' &APIERR) /*( リストＡＰＩで作成されたユーザー空間の検索 )*/ /*( リストデータセクションのオフセットを検索 )*/ CALL PGM(QUSRTVUS) PARM('QUSLOBJ QTEMP ' + &STRPOS &LENDTA &RCVVAR) CHGVAR VAR(&OFFSET) VALUE(%SST(&RCVVAR 1 4)) CHGVAR VAR(&NOENTR) VALUE(%SST(&RCVVAR 9 4)) CHGVAR VAR(&LSTSIZ) VALUE(%SST(&RCVVAR 13 4)) /*( RCVVAR によって OFFSET,LSTSIZ を受取った )*/ CHGVAR VAR(&STRPOS) VALUE(&OFFSET) CHGVAR VAR(&DEC08) VALUE(%BIN(&STRPOS)) CHGVAR VAR(&DEC08) VALUE(&DEC08 + 1) CHGVAR VAR(%BIN(&STRPOS)) VALUE(&DEC08) CHGVAR VAR(&LENDTA) VALUE(&LSTSIZ) CHGVAR VAR(&ADDLEN) VALUE(%BIN(&LENDTA)) CHGVAR VAR(&NOENT) VALUE(%BIN(&NOENTR)) CHGVAR VAR(&COUNT) VALUE(0) CHGVAR VAR(&LEN) VALUE(0) CHGVAR VAR(%BIN(&RECLEN)) VALUE(10) READ: CALL PGM(QUSRTVUS) PARM('QUSLOBJ QTEMP ' + &STRPOS &LENDTA &RCVDTA) /*( 処理の開始 )*/ CHGVAR VAR(&DEV) VALUE(%SST(&RCVDTA 01 10)) CHGVAR VAR(&OBJATR) VALUE(%SST(&RCVDTA 32 10)) IF COND(%SST(&OBJATR 1 3) *EQ 'PRT') THEN(DO) CHGVAR VAR(&COUNT) VALUE(&COUNT + 1) CHGVAR VAR(&RECORD) VALUE(&RECLEN *CAT &DEV) IF COND(&COUNT *EQ 1) THEN(DO) /* 最初 */ CHGVAR VAR(&PRM1992) VALUE(&RECORD) ENDDO /* 最初 */ ELSE CMD(DO) /* 2 番目以降 */ CHGVAR VAR(&PRM1992) VALUE(%SST(&PRM1992 1 &LEN) + *CAT &RECORD) ENDDO /* 2 番目以降 */ CHGVAR VAR(&LEN) VALUE(&LEN + 12) ENDDO /*( 処理の終了 )*/ IF COND(&N < &NOENT) THEN(DO) CHGVAR VAR(&N) VALUE(&N + 1) CHGVAR VAR(&DEC08) VALUE(%BIN(&STRPOS)) CHGVAR VAR(&DEC08) VALUE(&DEC08 + &ADDLEN) CHGVAR VAR(%BIN(&STRPOS)) VALUE(&DEC08) GOTO READ ENDDO REDEND: /*( 合計を記述する )*/ CHGVAR VAR(%BIN(&TOTAL)) VALUE(&COUNT) CHGVAR VAR(&SNDPRM) VALUE(&TOTAL *CAT &PRM1992) RETURN ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) + MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) + SNDMSGFLIB(&MSGFLIB) SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO) SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) + MSGTYPE(*ESCAPE) ENDDO ELSE CMD(DO) SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + MSGDTA(&MSGDTA) TOMSGQ(*TOPGMQ) + MSGTYPE(*ESCAPE) ENDDO DSPJOBLOG JOB(*) OUTPUT(*PRINT) ENDPGM: ENDPGM