14. ただでできる対話式SQL
ただ(無償) で、できるSQLを紹介する。
iSeries400/i5 でもモデルが大きくなると SQLと言えども結構な値段がする。
もちろん、SQLが導入されていないiSeries400/i5 で SQL を使ってみたい場合もあるであろう。
実はSQLは QSQROUTE という一本の API から成り立っており、すべてのOS400にこの API は
導入されている。API : QSQROUTE がある限り QUERY/400であっても自作することができる。
タダでできるSQLを公開することは若干、問題があるのかも知れないが IBM が提供している
製品レベルではないことは、ご承知されたい。
しかし、SELECT文は、もちろんのこと、UPDATE や DELETE 文も、しっかり動作する結構な
シロモノである。(F4キーは効かない)
ソースを見ることによって SQL の原理を学習して頂ければと考えて公開に至った。
【 コマンド STRPNLSQL 】
0001.00 CMD PROMPT(' 対話式ＳＱＬ ')
【 コンパイル 】
CRTCMD CMD(MYLIB/STRPNLSQL) PGM(MYLIB/STRPNLSQLC) SRCFILE(MYSRCLIB/QCMDSRC) AUT(*ALL)
【 CLP : STRPNLSQLC 】
0001.00 PGM
0002.00 /*---------------------------------------------------------*/
0003.00 /* STRPNLSQL : 対話式ＳＱＬ */
0004.00 /*---------------------------------------------------------*/
0005.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(80)
0006.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0007.00 DCL VAR(&MSGFLD) TYPE(*CHAR) LEN(80)
0008.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0009.00 DCL VAR(&MSGLIB) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&HANDLE) TYPE(*CHAR) LEN(8) /* +
0011.00 摘要業務ハンドル */
0012.00 DCL VAR(&FNCTON) TYPE(*CHAR) LEN(4) +
0013.00 VALUE(X'00000000') /* 2 進数 */
0014.00 DCL VAR(&PANEL) TYPE(*CHAR) LEN(10)
0015.00 DCL VAR(&AGAIN) TYPE(*CHAR) LEN(1) VALUE(Y)
0016.00 DCL VAR(&USRTSK) TYPE(*CHAR) LEN(1) VALUE(N)
0017.00 DCL VAR(&STACK) TYPE(*CHAR) LEN(4) +
0018.00 VALUE(X'00000000') /* 2 進数 */
0019.00 DCL VAR(&UIMMSG) TYPE(*CHAR) LEN(10) VALUE(*CALLER)
0020.00 DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
0021.00 DCL VAR(&CSROPT) TYPE(*CHAR) LEN(1) VALUE(D)
0022.00 DCL VAR(&LASLST) TYPE(*CHAR) LEN(4) VALUE(NONE)
0023.00 DCL VAR(&ERRLST) TYPE(*CHAR) LEN(4)
0024.00 DCL VAR(&WAITTIME) TYPE(*CHAR) LEN(4) +
0025.00 VALUE(X'FFFFFFFF') /* 2 進数 */
0026.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(4) +
0027.00 VALUE(X'00000000') /* 2 進数 */
0028.00 DCL VAR(&CF03) TYPE(*CHAR) LEN(4) +
0029.00 VALUE(X'FFFFFFFC') /* 2 進数 */
0030.00 DCL VAR(&CF12) TYPE(*CHAR) LEN(4) +
0031.00 VALUE(X'FFFFFFF8') /* 2 進数 */
0032.00 DCL VAR(&DTALEN) TYPE(*CHAR) LEN(4) /* 2 進数 */
0033.00 DCL VAR(&VARRCD) TYPE(*CHAR) LEN(10)
0034.00 DCL VAR(&VARDTA) TYPE(*CHAR) LEN(1024)
0035.00 DCL VAR(&HED) TYPE(*CHAR) LEN(3)
0036.00 DCL VAR(&BLK80) TYPE(*CHAR) LEN(80)
0037.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0038.00
0039.00 OPNPNL PNLGRP(PANELWKR/STRPNLSQL) HANDLE(&HANDLE)
0040.00 /*------------------*/
0041.00 DSPLY:
0042.00 /*------------------*/
0043.00 CHGVAR VAR(&CSROPT) VALUE('D')
0044.00 CHGVAR VAR(&USRTSK) VALUE('N')
0045.00 CHGVAR VAR(&PANEL) VALUE('DSPDTA ')
0046.00 CHGVAR VAR(&STACK) VALUE(X'00000000')
0047.00 CHGVAR VAR(&UIMMSG) VALUE('*CALLER')
0048.00 CALL PGM(QUIDSPP) PARM(&HANDLE &FNCTON &PANEL +
0049.00 &AGAIN &APIERR &USRTSK &STACK &UIMMSG +
0050.00 &MSGKEY &CSROPT &LASLST &ERRLST &WAITTIME)
0051.00 CHGVAR VAR(&MSGKEY) VALUE(' ')
0052.00
0053.00 /*( CF03 )= 終了 */
0054.00 IF COND(&FNCTON *EQ &CF03) THEN(DO)
0055.00 GOTO CLOSE
0056.00 ENDDO
0057.00 /*( CF12 )= 取消し */
0058.00 IF COND(&FNCTON *EQ &CF12) THEN(DO)
0059.00 GOTO CLOSE
0060.00 ENDDO
0061.00 /*( 実行キー )*/
0062.00 CHGVAR VAR(%BIN(&DTALEN)) VALUE(1024)
0063.00 CALL PGM(QUIGETV) PARM(&HANDLE &VARDTA &DTALEN +
0064.00 'DSPRCD ' &APIERR)
0065.00 CHGVAR VAR(&MSGID) VALUE(' ')
0066.00 CHGVAR VAR(&MSGFLD) VALUE(&BLK80)
0067.00 CALL PGM(PANELWKR/PNLSQL) PARM(&VARDTA &MSGID +
0068.00 &MSGFLD)
0069.00 IF COND(&MSGID *NE ' ') THEN(DO)
0070.00 CHGVAR VAR(&HED) VALUE(%SST(&MSGID 1 3))
0071.00 IF COND((&HED *EQ 'SQL') *OR (&HED *EQ 'QMR')) +
0072.00 THEN(DO)
0073.00 SNDPGMMSG MSGID(&MSGID) MSGF(QSYS/QSQLMSG) +
0074.00 MSGDTA(&MSGFLD) TOPGMQ(*SAME) +
0075.00 MSGTYPE(*COMP) KEYVAR(&MSGKEY)
0076.00 GOTO DSPLY
0077.00 ENDDO
0078.00 ENDDO
0079.00 IF COND(&HED *EQ 'PNL') THEN(DO)
0080.00 SNDPGMMSG MSGID(&MSGID) MSGF(PANELWKR/PNLMSG) +
0081.00 MSGDTA(&MSGFLD) TOPGMQ(*SAME) +
0082.00 MSGTYPE(*COMP) KEYVAR(&MSGKEY)
0083.00 GOTO DSPLY
0084.00 ENDDO
0085.00 IF COND(&MSGFLD *NE ' ') THEN(DO)
0086.00 SNDPGMMSG MSG(&MSGFLD) TOPGMQ(*SAME) MSGTYPE(*COMP) +
0087.00 KEYVAR(&MSGKEY)
0088.00 GOTO DSPLY
0089.00 ENDDO
0090.00 RMVMSG CLEAR(*ALL)
0091.00 GOTO DSPLY
0092.00 /*( 適用業務のクローズ )*/
0093.00 CLOSE:
0094.00 CALL PGM(QUICLOA) PARM(&HANDLE 'M' &APIERR)
0095.00
0096.00 ERROR: RCVMSG RMV(*NO) MSG(&MSG)
0097.00 IF COND(&MSG *NE ' ') THEN(DO)
0098.00 SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG)
0099.00 ENDDO
0100.00 ENDPGM
【 コンパイル 】
CRTCLPGM PGM(MYILB/STRPNLSQLC) SRCFILE(MYSRCLIB/QCLSRC) AUT(*ALL)
【 パネル・グループ STRPNLSQL 】
ソースは省略
【 インクルードするパネル・グループ・ソース 】
【 コンパイル 】
CRTPNLGRP PNLGRP(MYLIB/STRPNLSQL) SRCFILE(MYSRCLIB/QPNLSRC) INCFILE(MYSRCLIB/QPNLSRC) AUT(*ALL)
【 DSPF : PNLSQLFM 】
ソースは省略
【 コンパイル 】
CRTDSPF FILE(MYLIB/PNLSQLFM) SRCFILE(MYSRCLIB/QDSPSRC) LVLCHK(*NO) AUT(*ALL)
【 PF : SQLSTR 】
001.00 A**********************************************
002.00 A* SQLSTRT : DMY SQL STRING TABLE . *
003.00 A**********************************************
004.00 A*
005.00 A
006.00 A R @SQLSTR TEXT('SQL CONNECT')
007.00 A*
008.00 A STRING 3000A COLHDG('SQL ｽﾄﾘﾝｸﾞ')
【 コンパイル 】
CRTPF FILE(MYLIB/SQLSTR) SRCFILE(MYSRCLIB/QDDSSRC) LVLCHK(*NO) AUT(*ALL)
【 RPGプログラム : PNLSQL 】
ソースは省略
【 コンパイル 】
CRTRPGPGM PGM(MYLIB/PNLDQL) SRCFILE(MYSRCLIB/QRPGSRC) AUT(*ALL)
【 関連コマンド : OPNPNL 】
ソースは省略
【 CLP : OPNPNLCL 】
ソースは省略
