いよいよ オープン・リストAPI: QGYOLOBJ のサンプルの紹介と解説を行う。
オブジェクト・リストというと QUSLOBJ APIを使うことが多いが
ここに紹介する QGYOLOBJ は QUSLOBJに比べて劇的に速いパフォーマンスを
提供する。
世界感が変わると言えば大げさかも知れないがそれだけの
圧倒的な速さを提供するAPIである。
さて見てきたようにAPIはRPGやCOBOLの中で使うよりはCLPで使用するほうが
やさしい。
CLPのほうがステップ数も少なくなるしRPG,COBOL,Cのどの開発者から見ても
わかりやすい。
API: QGYOLOBJ のサンプル・ソースはRPGで公開されてい例があるが
RPGの場合は大量のソースになって見にくく肝心の部分がIBMマニュアルの
丸写しなので実践には向いていない。
書いているご本人も自信がないのに「やさしい」と評しているのは
不自然でオープン・リストAPIはやはりやさしくはない。
例もないし解説も不十分だからである。
さてAPIを扱うのはC言語が最も適切であるがエラー処理を考えると
CLPで呼び出すことが最も適している。
そこで一般化したCLPのサンプ・ソースを下記に紹介する。
[ TESTOBJL: オープン・リスト API: QGYOLOBJ ]
ソースはこちらから
0001.00 PGM
0002.00 /*-------------------------------------------------------------------*/
0003.00 /* TESTOBJL : API:QGYOLOBJ のテスト */
0004.00 /* */
0005.00 /* 2020/07/31 作成 */
0006.00 /*-------------------------------------------------------------------*/
0007.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0008.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0009.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0011.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0012.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0013.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0014.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0015.00 VALUE('*ESCAPE ')
0016.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0017.00 VALUE(X'000074') /* 2 進数 */
0018.00 DCL VAR(&ERR) TYPE(*CHAR) LEN(1)
0019.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0020.00 VALUE(X'00000000')
0021.00 /*( QGYOLOBJ に必要な変数 )*/
0022.00 DCL VAR(&RCVBUF) TYPE(*CHAR) LEN(32000)
0023.00 DCL VAR(&RCVLEN) TYPE(*CHAR) LEN(4) +
0024.00 VALUE(X'00007D00')
0025.00 DCL VAR(&LISTINFO) TYPE(*CHAR) LEN(80)
0026.00 DCL VAR(&LISTSU) TYPE(*CHAR) LEN(4) +
0027.00 VALUE(X'0000000A')
0028.00 DCL VAR(&NBRRCD) TYPE(*CHAR) LEN(4) +
0029.00 VALUE(X'000001F4') /* 500 個 */
0030.00 DCL VAR(&SORT) TYPE(*CHAR) LEN(4) +
0031.00 VALUE(X'00000000')
0032.00 DCL VAR(&OBJOBJLIB) TYPE(*CHAR) LEN(20) +
0033.00 VALUE('*ALL QSYS ')
0034.00 DCL VAR(&AUTO) TYPE(*CHAR) LEN(48)
0035.00 DCL VAR(&OBJAUT) TYPE(*CHAR) LEN(10) +
0036.00 VALUE('*ALL ')
0037.00 DCL VAR(&LIBAUT) TYPE(*CHAR) LEN(10) +
0038.00 VALUE('*ALL ')
0039.00 DCL VAR(&SELECT) TYPE(*CHAR) LEN(21)
0040.00 DCL VAR(&DPLSTS) TYPE(*CHAR) LEN(4) +
0041.00 VALUE(X'00000014')
0042.00 DCL VAR(&NBRSTS) TYPE(*CHAR) LEN(4) +
0043.00 VALUE(X'00000001')
0044.00 DCL VAR(&KEYSU) TYPE(*CHAR) LEN(4) +
0045.00 VALUE(X'00000001')
0046.00 DCL VAR(&KEYARY) TYPE(*CHAR) LEN(4) +
0047.00 VALUE(X'000000CA')
0048.00 DCL VAR(&BIN0) TYPE(*CHAR) LEN(4) +
0049.00 VALUE(X'00000000')
0050.00 DCL VAR(&BIN1) TYPE(*CHAR) LEN(4) +
0051.00 VALUE(X'00000001')
0052.00 DCL VAR(&BIN4) TYPE(*CHAR) LEN(4)
0053.00 DCL VAR(&PRINTER) TYPE(*CHAR) LEN(10)
0054.00 DCL VAR(&OUTQQLIB) TYPE(*CHAR) LEN(20)
0055.00 DCL VAR(&RTNSU) TYPE(*DEC) LEN(5 0)
0056.00 DCL VAR(&RTNSUC) TYPE(*CHAR) LEN(5)
0057.00 /*( QGYGTLE に必要な変数 )*/
0058.00 DCL VAR(&LSTHND) TYPE(*CHAR) LEN(4)
0059.00 DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(256)
0060.00 DCL VAR(&VARLEN) TYPE(*CHAR) LEN(4) +
0061.00 VALUE(X'00000100')
0062.00 DCL VAR(&N) TYPE(*DEC) LEN(7 0)
0063.00 DCL VAR(&STRCNV) TYPE(*CHAR) LEN(4)
0064.00 DCL VAR(&TEXT) TYPE(*CHAR) LEN(50)
0065.00 DCL VAR(&STSBIN) TYPE(*CHAR) LEN(4)
0066.00 DCL VAR(&COUNT) TYPE(*DEC) LEN(5 0)
0067.00 DCL VAR(&COUNTC) TYPE(*CHAR) LEN(5)
0068.00 DCL VAR(&DEV) TYPE(*CHAR) LEN(10)
0069.00 DCL VAR(&OBJATR) TYPE(*CHAR) LEN(10)
0070.00 /* MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR)) */
0071.00
0072.00 /*( 環境の取得 )*/
0073.00 RTVJOBA TYPE(&TYPE)
0074.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0075.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0076.00 ENDDO /* バッチ */
0077.00 ELSE CMD(DO) /* 対話式 */
0078.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0079.00 ENDDO /* 対話式 */
0080.00
0081.00 /*( オブジェクト・リストのオープン )*/
0082.00 CHGVAR VAR(%SST(&LISTINFO 1 4)) VALUE(&LISTSU)
0083.00 CHGVAR VAR(%BIN(&BIN4)) VALUE(48)
0084.00 CHGVAR VAR(&AUTO) VALUE(&BIN4 *CAT &BIN0 *CAT &BIN0 +
0085.00 *CAT &BIN0 *CAT &BIN0 *CAT &BIN0 *CAT +
0086.00 &BIN0 *CAT &OBJAUT *CAT &LIBAUT)
0087.00 CHGVAR VAR(%BIN(&BIN4)) VALUE(22)
0088.00 CHGVAR VAR(&SELECT) VALUE(&BIN4 *CAT &BIN0 *CAT +
0089.00 &DPLSTS *CAT &NBRSTS *CAT &BIN0 *CAT ' ')
0090.00 CHGVAR VAR(%BIN(&NBRRCD)) VALUE(-1)
0091.00 CALL PGM(QGYOLOBJ) PARM(&RCVBUF &RCVLEN &LISTINFO +
0092.00 &NBRRCD &SORT &OBJOBJLIB '*DEVD ' +
0093.00 &AUTO &SELECT &KEYSU &KEYARY &APIERR)
0094.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
0095.00 SNDPGMMSG +
0096.00 MSG('API: QGYOLOBJ の実行で次のエラーが発生 +
0097.00 しました。 ') MSGTYPE(*DIAG)
0098.00 GOTO APIERR
0099.00 ENDDO
0100.00 SNDPGMMSG +
0101.00 MSG(' オブジェクト・リストのオープンに成功 +
0102.00 ') MSGTYPE(*DIAG)
0103.00 /*( リスト検索の開始 )*/
0104.00 CHGVAR VAR(&BIN4) VALUE(%SST(&LISTINFO 1 4))
0105.00 CHGVAR VAR(&RTNSU) VALUE(%BIN(&BIN4))
0106.00 IF COND(&RTNSU *EQ 0) THEN(DO) /* +
0107.00 戻り数がない */
0108.00 GOTO ENDLIST
0109.00 ENDDO /* 戻り数がない */
0110.00 IF COND(&RTNSU > 0) THEN(DO) /* 戻り数 >0 */
0111.00 CHGVAR VAR(&LSTHND) VALUE(%SST(&LISTINFO 9 4))
0112.00 CHGVAR VAR(&COUNT) VALUE(0)
0113.00 CHGVAR VAR(&N) VALUE(1)
0114.00 CHGVAR VAR(%BIN(&STRCNV)) VALUE(1)
0115.00 CHGVAR VAR(%BIN(&NBRRCD)) VALUE(1)
0116.00 LOOP: CALL PGM(QGYGTLE) PARM(&RCVVAR &VARLEN &LSTHND +
0117.00 &LISTINFO &NBRRCD &STRCNV &APIERR)
0118.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)
0119.00 SNDPGMMSG +
0120.00 MSG('API: QGYGTLE の実行で次のエラーが発生 +
0121.00 しました。 ') MSGTYPE(*DIAG)
0122.00 GOTO APIERR
0123.00 ENDDO
0124.00 /*( 戻り値を取得する )*/
0125.00 CHGVAR VAR(&DEV) VALUE(%SST(&RCVVAR 1 10))
0126.00 CHGVAR VAR(&OBJATR) VALUE(%SST(&RCVVAR 53 10))
0127.00 IF COND(%SST(&OBJATR 1 3) *EQ 'PRT') THEN(DO)
0128.00 CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
0129.00 ENDDO
0130.00 BYPAS: IF COND(&N < &RTNSU) THEN(DO)
0131.00 CHGVAR VAR(&N) VALUE(&N + 1)
0132.00 CHGVAR VAR(%BIN(&STRCNV)) VALUE(%BIN(&STRCNV) + 1)
0133.00 GOTO LOOP
0134.00 ENDDO
0135.00 CHGVAR VAR(&COUNTC) VALUE(&COUNT)
0136.00 NXTCNT: IF COND(%SST(&COUNTC 1 1) = '0') THEN(DO)
0137.00 CHGVAR VAR(&COUNTC) VALUE(%SST(&COUNTC 2 4))
0138.00 GOTO NXTCNT
0139.00 ENDDO
0140.00 CHGVAR VAR(&MSG) VALUE(&COUNTC *TCAT +
0141.00 ' 個のプリンターが見つかりました。 ')
0142.00 CHGVAR VAR(&MSGTYPE) VALUE('*DIAG ')
0143.00 SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG)
0144.00 ENDDO /* 戻り数 >0 */
0145.00 /*( リストのクローズ )*/
0146.00 ENDLIST: CALL PGM(QGYCLST) PARM(&LSTHND &APIERR)
0147.00 RETURN
0148.00
0149.00 APIERR:
0150.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0151.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0152.00 IF COND(%SST(&MSGID 1 3) *EQ 'GUI') THEN(DO)
0153.00 CHGVAR VAR(&MSGF) VALUE('QGUIMSG ')
0154.00 ENDDO
0155.00 ELSE CMD(DO)
0156.00 CHGVAR VAR(&MSGF) VALUE('QCPFMSG ')
0157.00 ENDDO
0158.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
0159.00 GOTO SNDMSG
0160.00
0161.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0162.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0163.00 MSGFLIB(&MSGFLIB)
0164.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0165.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0166.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0167.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0168.00 ENDDO
0169.00 ELSE CMD(DO)
0170.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0171.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0172.00 MSGTYPE(&MSGTYPE)
0173.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0174.00 ENDDO
0175.00 ENDPGM
[解説]
オブジェクトのリストは一番汎用性が高い。
API : QGYOLOBJ の呼び出しは
0091.00 CALL PGM(QGYOLOBJ) PARM(&RCVBUF &RCVLEN &LISTINFO + 0092.00 &NBRRCD &SORT &OBJOBJLIB '*DEVD ' + 0093.00 &AUTO &SELECT &KEYSU &KEYARY &APIERR)
のようになっていて
&RCVBUF …………………….. 受取り変数(CHAR* 32000)
&RCVLEN …………………….. 受取り変数の長さ(CHAR* 4) VALUE(X’00007D00′)は32000の意味
&LISTINFO …………………… リスト情報(CHAR* 80)
最初は
0082.00 CHGVAR VAR(%SST(&LISTINFO 1 4)) VALUE(&LISTSU)
によって10個といてセットしておく。
結果のレコード数はリスト情報から
0104.00 CHGVAR VAR(&BIN4) VALUE(%SST(&LISTINFO 1 4)) 0105.00 CHGVAR VAR(&RTNSU) VALUE(%BIN(&BIN4))
として受取り数 &RTNSU を取得する。
機密情報 &AUTOは
0083.00 CHGVAR VAR(%BIN(&BIN4)) VALUE(48) 0084.00 CHGVAR VAR(&AUTO) VALUE(&BIN4 *CAT &BIN0 *CAT &BIN0 + 0085.00 *CAT &BIN0 *CAT &BIN0 *CAT &BIN0 *CAT + 0086.00 &BIN0 *CAT &OBJAUT *CAT &LIBAUT)
としてセットしたのは機密情報かせないことを意味している。
選択情報 &SELECT についても
0087.00 CHGVAR VAR(%BIN(&BIN4)) VALUE(22) 0088.00 CHGVAR VAR(&SELECT) VALUE(&BIN4 *CAT &BIN0 *CAT + 0089.00 &DPLSTS *CAT &NBRSTS *CAT &BIN0 *CAT ' ')
と何も指定していない。この書き方もこのような例がないと実際には
使えないと思われる。
IBMの解説のサンプルはオブジェクトに損傷のあるものを
抽出する例であり(通常そんな要求はないので)サンプルとしては
適切さを欠いている。ネットの記事もこれを真似ていたのは
正しい書き方がわからないからであろう。
今回示したソースではすべてのオブジェクトを選択している。
分類情報 &SORT も指定なしは
0030.00 DCL VAR(&SORT) TYPE(*CHAR) LEN(4) + 0031.00 VALUE(X'00000000')
と定義している。
ここからが API:QGYOLOBJ 独自の指定方法であるがオブジェクトの名前や
タイプだけでなく「属性」も入手する方法を示している。
「属性」とはオブジェクト・タイプが *FILE であっても
属性が PFなのか、DSPFであるのかによって扱いは異なってくる。
この場合は *DEVD に対して DSPVRTなのか PRTVRT なのかを調べるためである。
そのためにはキーでAPIに要求しなければならない。
そこでキーの個数は
0044.00 DCL VAR(&KEYSU) TYPE(*CHAR) LEN(4) + 0045.00 VALUE(X'00000001')
によって1個を指定する。
続いてキー値は マニュアルを見ると 拡張属性のキー値は 202とあるので
202は HEX では 0xCAであるので
0046.00 DCL VAR(&KEYARY) TYPE(*CHAR) LEN(4) + 0047.00 VALUE(X'000000CA')
として指定する。このこともマニュアルには説明がないので困惑した人もいるかもしれない。
取り出しはマニュアルより開始位置を計算して
0126.00 CHGVAR VAR(&OBJATR) VALUE(%SST(&RCVVAR 53 10))
によって取り出すことができる。
このようにキーの指定の方法がわかれば多くの要素の中から自由に取り出すことが
できるようになる。
読者諸兄は必要なキーをマニュアルを参照して追加すればよい。
このサンプル・ソースはAPI: QGYOLOBJ の使い方を的確に紹介したサンプル・ソースとして
適切である。
今まで難解と思われてきた API: QGYOLOBJ は、これを見れば誰にでも
容易に使えるようになるはずなので大いに利用して頂きたい。
IBM API: QGYOLOBJ の Kowledge Center 解説はこちら (Chromeでオープンすると日本語訳可)