IBM iから注文書をまとめてバッチ送信するサンプル・ソースを
紹介します。
なおこの記事はSpoolライターVer5.0の公開マニュアルの
チュートリアルにも掲載されています。
IBM iがインターネット接続可能になっていることが必要です。
SPOOLWTR/PINGCHK + [実行] によって自社のIBM iが
インターネットに接続可能かどうかを調べることができます。
[コマンド:SNDHATの実行]
注文書メール送信 (SNDHAT)
選択項目を入力して，実行キーを押してください。
仕入先 から . . . . . 文字値
まで . . . . . 9999 文字値
発注日 (YYMMDD) から . . 数値
(YYMMDD) まで . . 99999999 数値
出力 . . . . . . . . . . . . . *MAIL *, *PRINT, *MAIL
終り
F3= 終了 F4=ﾌﾟﾛﾝﾌﾟﾄ F5= 最新表示 F12= 取り消し
F13= この画面の使用法 F24= キーの続き
[コマンド:SNDHAT]
ソースはこちらから
0001.00 CMD PROMPT(' 注文書メール送信 ')
0002.00 PARM KWD(FROMSIR) TYPE(*CHAR) LEN(4) +
0003.00 PROMPT(' 仕入先 から ')
0004.00 PARM KWD(TOSIR) TYPE(*CHAR) LEN(4) +
0005.00 DFT(9999) PROMPT(' +
0006.00 まで ')
0007.00 PARM KWD(DATEFROM) TYPE(*DEC) LEN(8 0) +
0008.00 PROMPT(' 発注日 (YYMMDD) から ')
0009.00 PARM KWD(DATEEND) TYPE(*DEC) LEN(8 0) +
0010.00 DFT(99999999) PROMPT(' +
0011.00 (YYMMDD) まで ')
0012.00 PARM KWD(OUTPUT) TYPE(*CHAR) LEN(6) RSTD(*YES) +
0013.00 DFT(*PRINT) VALUES(* *PRINT *MAIL) +
0014.00 PROMPT(' 出力 ')
0015.00 PARM KWD(LOG) TYPE(*CHAR) LEN(4) RSTD(*YES) +
0016.00 DFT(*NO) VALUES(*YES *NO) PMTCTL(MAIL) +
0017.00 PROMPT(' ログ出力 ')
0018.00 MAIL: PMTCTL CTL(OUTPUT) COND((*EQ *MAIL))
[コンパイル]
CRTCMD QTROBJ/SNDHAT PGM(QTROBJ/SNDHATCL) SRCFILE(QTRSRC/QCMDSRC) AUT(*ALL)
[CLP:SNDHATCL ]
ソースはこちらから
0001.00 PGM PARM(&SIRFROM &SIREND &DATEFROM &DATEEND +
0002.00 &OUTPUT &LOG)
0003.00 /*-------------------------------------------------------------------*/
0004.00 /* SNDHATCL : 注文書メール送信 */
0005.00 /* */
0006.00 /* 2018/02/01 作成 */
0007.00 /*-------------------------------------------------------------------*/
0008.00 DCL VAR(&SIRFROM) TYPE(*CHAR) LEN(4)
0009.00 DCL VAR(&SIREND) TYPE(*CHAR) LEN(4)
0010.00 DCL VAR(&DATEFROM) TYPE(*DEC) LEN(8 0)
0011.00 DCL VAR(&DATEEND) TYPE(*DEC) LEN(8 0)
0012.00 DCL VAR(&OUTPUT) TYPE(*CHAR) LEN(6)
0013.00 DCL VAR(&LOG) TYPE(*CHAR) LEN(4)
0014.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0015.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0016.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0017.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0018.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0019.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0020.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0021.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +
0022.00 VALUE('*ESCAPE ')
0023.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0024.00 VALUE(X'000074') /* 2 進数 */
0025.00 DCL VAR(&ERR) TYPE(*CHAR) LEN(1)
0026.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0027.00 VALUE(X'00000000')
0028.00 DCL VAR(&DFTCCSID) TYPE(*DEC) LEN(5 0)
0029.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0030.00
0031.00 /*( 環境の取得 )*/
0032.00 RTVJOBA TYPE(&TYPE) DFTCCSID(&DFTCCSID)
0033.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0034.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0035.00 ENDDO /* バッチ */
0036.00 ELSE CMD(DO) /* 対話式 */
0037.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0038.00 ENDDO /* 対話式 */
0039.00
0040.00 /*( パラメータの検査 )*/
0041.00 CHGJOB CCSID(5035)
0042.00
0043.00 /*( プログラムの実行 )*/
0044.00 OVRDBF FILE(HATTUL1) TOFILE(QTRFIL/HATTUL1) +
0045.00 SECURE(*YES) OVRSCOPE(*JOB)
0046.00 CALL PGM(QTROBJ/SNDHAT) PARM(&SIRFROM &SIREND +
0047.00 &DATEFROM &DATEEND &OUTPUT &LOG)
0048.00 DLTOVR FILE(HATTUL1) LVL(*JOB)
0049.00 CHGJOB CCSID(&DFTCCSID)
0050.00 RETURN
0051.00
0052.00 APIERR:
0053.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0054.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0055.00 CHGVAR VAR(&MSGF) VALUE('QCPFMSG ')
0056.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
0057.00 GOTO SNDMSG
0058.00
0059.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0060.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0061.00 SNDMSGFLIB(&MSGFLIB)
0062.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0063.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0064.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)
0065.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0066.00 ENDDO
0067.00 ELSE CMD(DO)
0068.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0069.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0070.00 MSGTYPE(&MSGTYPE)
0071.00 MONMSG MSGID(CPF2400) EXEC(RETURN)
0072.00 ENDDO
0073.00 ENDPGM
[コンパイル]
CRTCLPGM QTROBJ/SNDHATCL SRCFILE(QTRSRC/QCLSRC) AUT(*ALL)
[RPG: SNDHAT ]
ソースはこちらから
0001.00 H DFTNAME(SNDHAT) DATEDIT(*YMD/) BNDDIR('QC2LE')
0002.00 F********** 注文書メール送信 ******************************************
0003.00 FHATTUL1 IF E K DISK
0004.00 FSIREMT IF E K DISK
0005.00 FBUHINM IF E K DISK
0006.00 FMAILADR IF E K DISK EXTFILE('QUSRTEMP/MAILADR')
0007.00 FQPRINT O F 132 PRINTER OFLIND(*INOF) USROPN
0008.00 F FORMLEN(66)
0009.00 F FORMOFL(62)
0010.00 F**********************************************************************
0011.00
0012.00 * CRTBNDRPG PGM(QTROBJ/SNDHAT) SRCFILE(QTRSRC/QRPGLESRC)
0013.00 * DFTACTGRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)
0014.00
0015.00 *-------------------------------------------------------------------*
0016.00 * 2020/12/21 : 作成
0017.00 *-------------------------------------------------------------------*
0018.00 *( 作業変数 )
0019.00 D AR S 1A DIM(256)
0020.00 D CMD S 1024A
0021.00 D N S 4S 0
0022.00 D TRUE S 1A DIM(256)
0023.00 D TRUE# S 4B 0 INZ(0)
0024.00 D FALSE# S 4B 0 INZ(-1)
0025.00 D QUOT C CONST(X'7D')
0026.00 D OE C CONST(X'0E')
0027.00 D OF C CONST(X'0F')
0028.00 D NULL C CONST(X'00')
0029.00
0030.00 D HDR S 32 DIM(1) CTDATA PERRCD(1) 見出し
0031.00 D LIN S 1 DIM(132)
0032.00
0033.00 D SYSTEM PR 10I 0 EXTPROC('ﾋﾙﾋﾌdｺ')
0034.00 D CMD * VALUE OPTIONS(*STRING)
0035.00
0036.00 C*-------------------------------------------------------------------------+
0037.00 C *ENTRY PLIST |
0038.00 C PARM FROMSIR 4 |
0039.00 C PARM TOSIR 4 |
0040.00 C PARM DATEFROM 8 0 |
0041.00 C PARM DATEEND 8 0 |
0042.00 C PARM OUTPUT_ 6 |
0043.00 C PARM LOG_ 4 |
0044.00 C*-------------------------------------------------------------------------+
0045.00 C*----------------------------------------------------+
0046.00 C SETKEY KLIST
0047.00 C KFLD HTSRCD
0048.00 C KFLD HTDATE
0049.00 C KFLD HTHTNO
0050.00 C KFLD HTGYO
0051.00 C*----------------------------------------------------+
0052.00 C MOVEA *ALL'-' LIN
0053.00 C MOVEL FROMSIR HTSRCD
0054.00 C MOVEL DATEFROM HTDATE
0055.00 C MOVE *LOVAL HTHTNO
0056.00 C MOVE *LOVAL HTGYO
0057.00 C SETKEY SETLL HATTUL1
0058.00 C DO *HIVAL DO-*HIVAL
0059.00 C SETOFF 50
0060.00 C READ HATTUL1 50
0061.00 C 50 LEAVE
0062.00 C SETKEY SETLL HATTUL1
0063.00 C*----------------------------------------------------+
0064.00 C EQLKEY KLIST
0065.00 C KFLD HTSRCD
0066.00 C KFLD HTDATE
0067.00 C*----------------------------------------------------+
0068.00 C EXSR OVRPRTF
0069.00 C OPEN QPRINT 90
0070.00 C *IN90 IFEQ *OFF QPRINT
0071.00 C DO *HIVAL DO-*HIVAL-EQL
0072.00 C SETOFF 50
0073.00 C EQLKEY READE HATTUL1 50
0074.00 C 50 LEAVE
0075.00 C SETOFF 99
0076.00 C HTSRCD CHAIN SIREMT 99
0077.00 C SETOFF 99
0078.00 C HTBHCD CHAIN BUHINM 99
0079.00 C MOVEL(P) HTSRCD USER
0080.00 C USER CHAIN MAILADR 99
0081.00 C*( 明細印刷 )
0082.00 C*-------------------------------------------------------------------------+
0083.00 C SETON 42 |
0084.00 C EXSR OUTPUT |
0085.00 C*-------------------------------------------------------------------------+
0086.00 C ADD 1 KENSU 7 0 件数
0087.00 C ENDDO DO-*HIVAL-EQL
0088.00 C CLOSE QPRINT
0089.00 *
0090.00 C SELECT SELECT
0091.00 C WHEN OUTPUT_ = '* '
0092.00 C EXSR DSPLY
0093.00 C WHEN OUTPUT_ = '*PRINT'
0094.00 C EXSR PRINT
0095.00 C WHEN OUTPUT_ = '*MAIL '
0096.00 C EXSR SNDMAIL
0097.00 C ENDSL SELECT
0098.00 C EXSR DLTOVR
0099.00 *
0100.00 C ENDIF QPRINT
0101.00 *
0102.00 C ENDDO DO-*HIVA
0103.00 C SETON LR
0104.00 C RETURN
0105.00 C******************************************************
0106.00 C OVRPRTF BEGSR
0107.00 C******************************************************
0108.00 C IF OUTPUT_ = '* ' OR OVRPRTF
0109.00 C OUTPUT_ = '*MAIL '
0110.00 /FREE
0111.00 SYSTEM('OVRPRTF FILE(QPRINT) HOLD(*YES) USRDTA('' 注文書 '') -
0112.00 SECURE(*YES) OVRSCOPE(*JOB)');
0113.00 /END-FREE
0114.00 C ELSE OVRPRTF
0115.00 /FREE
0116.00 SYSTEM('OVRPRTF FILE(QPRINT) USRDTA('' 注文書 '') -
0117.00 SECURE(*YES) OVRSCOPE(*JOB)');
0118.00 /END-FREE
0119.00 C ENDIF OVRPRTF
0120.00 C ENDSR
0121.00 C******************************************************
0122.00 C DLTOVR BEGSR
0123.00 C******************************************************
0124.00 /FREE
0125.00 SYSTEM('DLTOVR FILE(QPRINT) LVL(*JOB)');
0126.00 IF OUTPUT_ = '*';
0127.00 SYSTEM('DLTSPLF FILE(QPRINT) SPLNBR(*LAST)');
0128.00 ENDIF;
0129.00 /END-FREE
0130.00 C ENDSR
0131.00 C******************************************************
0132.00 C DSPLY BEGSR
0133.00 C******************************************************
0134.00 /FREE
0135.00 SYSTEM('DSPSPLF FILE(QPRINT) SPLNBR(*LAST)');
0136.00 /END-FREE
0137.00 C ENDSR
0138.00 C******************************************************
0139.00 C PRINT BEGSR
0140.00 C******************************************************
0141.00 C ENDSR
0142.00 C******************************************************
0143.00 C SNDMAIL BEGSR
0144.00 C******************************************************
0145.00 /FREE
0146.00 CMD = 'SPOOLWTR/CVTSPLF SPLF(QPRINT) JOB(*) SPLNO(*LAST) ' +
0147.00 ' OUTPUT(*PDF) ' +
0148.00 'OPTION(*MAIL) FROMADR(hqeｻ@ｻeehbdｽﾕ ﾌﾌｾｻ.bｻｺ) TOADDR(' +
0149.00 %TRIMR(ADDR) +
0150.00 ') SUBJECT('' 注文書 '') ADDFILE(*SPLF) ' +
0151.00 ' SMTPLOG(' + %TRIMR(LOG_) + ') ' +
0152.00 ' SMTPSERVER(*FROMADR) SMTPPORT(25)';
0153.00 SYSTEM(CMD);
0154.00 /END-FREE
0155.00 C ENDSR
0156.00 C******************************************************
0157.00 C OUTPUT BEGSR
0158.00 C******************************************************
0159.00 C N40 SETON 4041
0160.00 C EXCEPT
0161.00 C OF SETOFF 40OF
0162.00 C SETOFF 414243
0163.00 C SETOFF 444546
0164.00 C SETOFF 474849
0165.00 C ENDSR
0166.00 OQPRINT E 41 2 06
0167.00 O UDATE Y 8
0168.00 O 14 ' 作成 '
0169.00 O HDR(1) 82
0170.00 O 128 'PAGE.'
0171.00 O PAGE Z 131
0172.00 O E 41 1
0173.00 O HTSRCD 4
0174.00 O SRNMJ 38
0175.00 O 42 ' 様 '
0176.00 O E 41 1
0177.00 O LIN 132
0178.00 O E 41 1
0179.00 O 8 ' コード '
0180.00 O 20 ' 品 名 '
0181.00 O 42 ' 単価 '
0182.00 O 60 ' 発注数 '
0183.00 O 80 ' 金額 '
0184.00 O E 41 1
0185.00 O LIN 132
0186.00 O E 42 2
0187.00 O HTBHCD 12
0188.00 O BHNAME 33
0189.00 O HTTANK J 44
0190.00 O HTSUR J 60
0191.00 O HTKING J 80
0192.00 ** HDR
0193.00 注文書
[コンパイル]
CRTBNDRPG QTROBJ/SNDHAT SRCFILE(QTRSRC/QRPGLESRC) DFTACTGRP(*NO)
ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)
[解説]
FAX送信のFAXSPLとは違った方法としてRPGプログラムの中で仕入先毎に
スプールをクローズしてRPGからコマンド: CVTSPLFを呼び出して実行しています。