JWSPLF 工具可用於 OS/400 V5R1 以後，含原始檔。
TechTip: Upgrade Your JWSPLF
by Giuseppe Costagliola
https://www.mcpressonline.com/programming/rpg/techtip-upgrade-your-jwsplf
Published June 2003
下載 SAVF 及原始檔
安裝程序：
The zip contains a savf and all the sources in clear text (for people that
do not want or can't restore savf).
The savf is an entire library (JWSPLF) with all the programs compiled and
the source file as well. You can create
a savf JWSPLF in your as/400,
ftp and restore the library. If you restored the library, you can use the
command immediately However if you want to recreate the tool by your own just
create a library (say JWSPLF or any other else) and run the REXX JWMAKE
(directly from PDM - opt. 16).
If you want to build the pkg in a library other than JWSPLF just change
the variable LIB in REXX procedure.
星期一, 11月 06, 2023
2003-06-12 JWSPLF 功能比 WRKSPLF 強，非常好用(Command JWSPLF)
2003-01-06 報表安全系列五：如何限制指令 CHGSPLFA 的使用, 防止使用者更改其他人報表的屬性?
報表安全系列五：如何限制指令 CHGSPLFA 的使用, 防止使用者更改其他人報表的屬性?
有鑑於 報表的安全性管理，iSeries(AS/400) 作業系統並未提供完善的保護，我將建議使用 VCP 命令
語法檢核程式來做安全空管，
報表安全系列一 ：如何限制指令 WRKSPLF 的使用, 防止使用者察看全系統的報表 ?
報表安全系列二 ：如何限制指令 DSPSPLF 的使用, 防止使用者於 WRKSPLF 畫面中瀏覽全系統的報表 ?
報表安全系列三 ：如何限制指令 DLTSPLF 的使用, 防止使用者刪除其他人的報表 ?
報表安全系列四 ：如何限制指令 CPYSPLF 的使用, 防止使用者複製其他人的報表 ?
報表安全系列五 ：如何限制指令 CHGSPLFA 的使用, 防止使用者更改其他人報表的屬性?
有 *SPLCTL 權限的人可以更改系統上任何報表的屬性，如印表機，Outq 輸出佇列..等屬性，
要如何防止非授權使用者更改機密敏感的報表資料屬性，為了要防止這種情形發生，只能從命
令檢核程式著手，此範例與其他相關報表命令
（WRKSPLF, DSPSPLF, DLTSPLF, CPYSPLF）的檢核程式一樣，限制除了 QSECOFR, QSYSOPR
之外，使用者僅能刪除自己的報表，同樣也分 OS V5R1(含)以前及OS V5R2(含)以後的版本。
CHGSPLFAVC 命令語法檢核程式 for V5R1
File : QCLSRC
Member: CHGSPLFAVC
Type : CLP
OS version: V5R1 以前
Usage : CRTCLPGM mylib/CHGSPLFAVC
CHGCMD CMD(CHGSPLFA) VLDCKR(mylib/CHGSPLFAVC)
若執行有問題或不使用命令語法檢核程式時，執行
CHGCMD CMD(CHGSPLFA) VLDCKR(*NONE)
/* Program : CHGSPLFVAVC */
/* System : iSeries 400 */
/* */
/* Validity Checking program for command CHGSPLFA */
/* */
/* Example : protecting an OUTQ from a USER */
/* */
/* CHGCMD CMD(CHGSPLFA) VLDCKR(MYLIB/CHGSPLFVAL) */
/* To reset (in case you made errors) : */
/* CHGCMD CMD(CHGSPLFA) VLDCKR(*NONE) */
CHGSPLFVAL: PGM PARM(&P1 &P2 &P3 &P4 &P5 &P6 &P7 &P8 &P9 +
&P10 &P11 &P12 &P13 &P14 &P15 &P16 &P17 +
&P18 &P19 &P20 &P21 &P22 &P23 &P24 &P25 +
&P26 &P27 &P28 &P29 &P30 &P31 &P32 &P33 +
&P34 &P35 &P36 &P37 &P38 &P39)
DCL VAR(&P1) TYPE(*CHAR) LEN(1)
DCL VAR(&P2) TYPE(*CHAR) LEN(10) /* FILE */
DCL VAR(&P3) TYPE(*CHAR) LEN(26) /* JOB */
DCL VAR(&P4) TYPE(*CHAR) LEN(1)
DCL VAR(&P5) TYPE(*CHAR) LEN(44) /* SELECT */
DCL VAR(&P6) TYPE(*CHAR) LEN(10) /* PRINTER */
DCL VAR(&P7) TYPE(*CHAR) LEN(1)
DCL VAR(&P8) TYPE(*CHAR) LEN(20) /* OUTQ */
DCL VAR(&P9) TYPE(*CHAR) LEN(10) /* OUTQ LIB */
DCL VAR(&P10) TYPE(*CHAR) LEN(1)
DCL VAR(&P11) TYPE(*CHAR) LEN(1)
DCL VAR(&P12) TYPE(*CHAR) LEN(1)
DCL VAR(&P13) TYPE(*CHAR) LEN(1)
DCL VAR(&P14) TYPE(*CHAR) LEN(1)
DCL VAR(&P15) TYPE(*CHAR) LEN(1)
DCL VAR(&P16) TYPE(*CHAR) LEN(1)
DCL VAR(&P17) TYPE(*CHAR) LEN(1)
DCL VAR(&P18) TYPE(*CHAR) LEN(1)
DCL VAR(&P19) TYPE(*CHAR) LEN(1)
DCL VAR(&P20) TYPE(*CHAR) LEN(1)
DCL VAR(&P21) TYPE(*CHAR) LEN(1)
DCL VAR(&P22) TYPE(*CHAR) LEN(1)
DCL VAR(&P23) TYPE(*CHAR) LEN(1)
DCL VAR(&P24) TYPE(*CHAR) LEN(1)
DCL VAR(&P25) TYPE(*CHAR) LEN(1)
DCL VAR(&P26) TYPE(*CHAR) LEN(1)
DCL VAR(&P27) TYPE(*CHAR) LEN(1)
DCL VAR(&P28) TYPE(*CHAR) LEN(1)
DCL VAR(&P29) TYPE(*CHAR) LEN(1)
DCL VAR(&P30) TYPE(*CHAR) LEN(1)
DCL VAR(&P31) TYPE(*CHAR) LEN(1)
DCL VAR(&P32) TYPE(*CHAR) LEN(1)
DCL VAR(&P33) TYPE(*CHAR) LEN(1)
DCL VAR(&P34) TYPE(*CHAR) LEN(1)
DCL VAR(&P35) TYPE(*CHAR) LEN(1)
DCL VAR(&P36) TYPE(*CHAR) LEN(1)
DCL VAR(&P37) TYPE(*CHAR) LEN(1)
DCL VAR(&P38) TYPE(*CHAR) LEN(1)
DCL VAR(&P39) TYPE(*CHAR) LEN(1)
DCL VAR(&OUTQ) TYPE(*CHAR) LEN(10)
DCL VAR(&SPLUSR) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
RTVJOBA JOB(&JOBNAME) USER(&USER) NBR(&JOBNBR)
CHGVAR &OUTQ %SST(&P8 1 10)
IF (%SST(&P3 1 1) *EQ '*') DO
CHGVAR &SPLUSR &USER
CHGVAR %SST(&P3 1 10) &JOBNAME
CHGVAR %SST(&P3 11 10) &USER
CHGVAR %SST(&P3 21 6) &JOBNBR
ENDDO
ELSE +
CHGVAR &SPLUSR %SST(&P3 11 10)
/* Check here your criteria. */
/* (f.e. Userprofile ... */
/* If a user is authorized based on your criteria, then */
/* RETURN. */
/* If he is not authorized then goto NOT_OK. */
/* In that case an escape message is send. */
/* USER QSECOFR, QSYSOPR UNLIMIT ACCESS SPOOLED FILE */
IF ((&USER *EQ 'QSECOFR') *OR +
(&USER *EQ 'QSYSOPR')) +
THEN(GOTO OK)
/* LIMIT ONLY SPOOLED CREATION USER CAN BROWSE OWN'S SPOOLED FILE */
IF COND(&USER *NE &SPLUSR) +
THEN(GOTO NOT_OK)
/* LIMIT OUTQ FOR SPECIFIED USER */
IF COND(&USER *EQ 'JOE' *AND &P8 *EQ 'MYOUTQ') +
THEN(GOTO NOT_OK)
OK:
RETURN
NOT_OK: SNDPGMMSG MSGID(CPD0006) MSGF(QCPFMSG) +
MSGDTA('0000' *CAT 'You are not +
authorized to output queue MYOUTQ') +
MSGTYPE(*DIAG)
SNDPGMMSG MSGID( CPF0002 ) +
MSGF( QSYS/QCPFMSG ) +
MSGTYPE( *ESCAPE )
END: ENDPGM
CPYSPLF 命令語法檢核程式 for V5R2
因為 CHGSPLFA 命令於 OS V5R2 中的參數個數增加至 42 個，而 CLP 的 PARM 參數僅能
接收 40 個參數，所以我改用 RPGLE 來撰寫命令語法檢核程式。
File : QRPGLESRC
Member: CHGSPLFAVR
Type : RPGLE
OS version: V5R2 以後
Usage : CRTBNDRPG mylib/CHGSPLFAVR
CHGCMD CMD(CHGSPLFA) VLDCKR(mylib/CHGSPLFAVR)
若執行有問題或不使用命令語法檢核程式時，執行
CHGCMD CMD(CHGSPLFA) VLDCKR(*NONE)
****************************************************************************************
* CHGSPLFA VCP for iSeries V5R2
*
/* * Validity Checking program for command CHGSPLFA
/*
/* * Example : protecting an SPOOL From a USER
/* *
/* * CHGCMD CMD(CHGSPLFA) VLDCKR(MYLIB/CHGSPLFAVR)
/* * To reset (in case you made errors) :
/* * CHGCMD CMD(CHGSPLFA) VLDCKR(*NONE)
****************************************************************************************
****************************************************************************************
* D E F I N I T I O N S P E C I F I C A T I O N *
****************************************************************
*
* Program Status Data Structure
*
D PGMDS SDS
D Pgmq## *PROC
D ErrorSts *STATUS
D PrvStatus 16 20S 0
D SrcLinNum 21 28
D Routine *ROUTINE
D NumParms *PARMS
D ExcpType 40 42
D ExcpNum 43 46
*
D PgmLib 81 90
D ExcpData 91 170
D ExcpId 171 174
D LastFile 201 208
D FileErr 209 243
D JobName 244 253
D User 254 263
D JobNumA 264 269
D JobNum 264 269S 0
D JobDate 270 275S 0
D RunDate 276 281S 0
D RunTime 282 287S 0
D PgmCrtDt 288 293
D PgmCrtTm 294 299
D CmplrLvl 300 303
D SrcFile 304 313
D SrcLib 314 323
D SrcMbr 324 333
D ProcPgm 334 343
D ProcMod 344 353
D cmd_str S 1024 INZ
D cmd_len S 15P 5 INZ(1024)
D msg_str S 256
D vApiErrDs ds
D vbytpv 10i 0 inz(%size(vApiErrDs)) bytes provided
D vbytav 10i 0 inz(0) bytes returned
D vmsgid 7a error msgid
D vresvd 1a reserved
D vrpldta 50a replacement data
D qmhsndpm PR ExtPgm('QMHSNDPM') SEND MESSAGES
D 7 const ID
D 20 const FILE
D 73 const TEXT
D 10i 0 const LENGTH
D 10 const TYPE
D 10 const QUEUE
D 10i 0 const STACK ENTRY
D 4 const KEY
Db like(vApiErrDS)
* QCMDEXC - Prototyped Call
D qcmdexc PR EXTPGM('QCMDEXC')
D cmd_str 1024 OPTIONS(*VARSIZE) CONST
D cmd_len 15P 5 CONST
C *entry Plist
C Parm P1 1
C Parm P2 10 File
C Parm P3 26 Job
C Parm P4 4 Splnbr
C Parm P5 8 Sysname
C Parm P6 6
C Parm P7 44
C Parm P8 10 Device
C Parm P9 1
C Parm P10 20
C Parm P11 1
C Parm P12 1
C Parm P13 1
C Parm P14 1
C Parm P15 1
C Parm P16 1
C Parm P17 1 Outq
C Parm P18 1
C Parm P19 1
C Parm P21 1
C Parm P22 1
C Parm P23 1
C Parm P24 1
C Parm P25 1
C Parm P26 1
C Parm P27 1
C Parm P28 1
C Parm P29 1
C Parm P30 1
C Parm P31 1
C Parm P32 1
C Parm P33 1
C Parm P34 1
C Parm P35 1
C Parm P36 1
C Parm P37 1
C Parm P38 1
C Parm P39 1
C Parm P40 1
C Parm P41 1
C Parm P42 1
C
C If %Subst(P3:1:1) = '*'
C Eval %Subst(P3: 1:10)= JobName
C Eval %Subst(P3:11:10)= User
C Eval %Subst(P3:21: 6)= JobNumA
C EndIf
* Exclude highest authority user
C If User <> 'QSECOFR' and
C User <> 'QSYSOPR'
* Limit user can chgsplfa on their own spooled
C If %Subst(P3:11:10)<> User
C Eval msg_str =
C '0000 You are not authorized to ' +
C 'spooled file ' + P2
* Send diag message
C callp QMHSNDPM(
C 'CPD0006':'QCPFMSG *LIBL ':
C msg_str:
C 256:'*DIAG ':'*CTLBDY ': 1:' ':
C vApiErrDS)
C
* Send Excape message
C callp QMHSNDPM(
C 'CPF0002':'QCPFMSG *LIBL ':
C ' ' :
C 0 :'*ESCAPE':'*CTLBDY ': 1:' ':
C vApiErrDS)
C EndIf
C EndIf
C
C Eval *InLr = *On
2003-01-05 報表安全系列四：如何限制指令 CPYSPLF 的使用, 防止使用者複製其他人的報表 ?
如何限制指令 CPYSPLF 的使用, 防止使用者複製其他人的報表 ?
有鑑於 報表的安全性管理，iSeries(AS/400) 作業系統並未提供完善的保護，我將建議使用 VCP 命令
語法檢核程式來做安全空管，
報表安全系列一 ：如何限制指令 WRKSPLF 的使用, 防止使用者察看全系統的報表 ?
報表安全系列二 ：如何限制指令 DSPSPLF 的使用, 防止使用者於 WRKSPLF 畫面中瀏覽全系統的報表 ?
報表安全系列三 ：如何限制指令 DLTSPLF 的使用, 防止使用者刪除其他人的報表 ?
報表安全系列四 ：如何限制指令 CPYSPLF 的使用, 防止使用者複製其他人的報表 ?
有 *SPLCTL 權限的人可以複製系統上任何報表，要如何防止非授權使用者複製機密敏感
的報表資料，為了要防止這種情形發生，只能從命令檢核程式著手，此範例與其他相關報
表命令（WRKSPLF, DSPSPLF, DLTSPLF）的檢核程式一樣，限制除了 QSECOFR, QSYSOPR 之外，
使用者僅能刪除自己的報表，同樣也分 OS V5R1(含)以前及OS V5R2(含)以後的版本。
CPYSPLF 命令語法檢核程式 for V5R1
File : QCLSRC
Member: CPYSPLFVC
Type : CLP
OS version: V5R1 以前
Usage : CRTCLPGM mylib/CPYSPLFVC
CHGCMD CMD(CPYSPLF) VLDCKR(mylib/CPYSPLFVC)
若執行有問題或不使用命令語法檢核程式時，執行
CHGCMD CMD(DSPSPLF) VLDCKR(*NONE)
/* Program : CPYSPLFVC */
/* System : iSeries 400 FOR V5R1 */
/* */
/* Validity Checking program for command CPYSPLF */
/* */
/* Example : protecting an SPOOL From a USER */
/* */
/* CHGCMD CMD(CPYSPLF) VLDCKR(MYLIB/CPYSPLFVC) */
/* To reset (in case you made errors) : */
/* CHGCMD CMD(CPYSPLF) VLDCKR(*NONE) */
DSPSPLFVC: PGM PARM(&P1 &P2 &P3 &P4 &P5 +
&P6 &P7 &P8 &P9 &P10)
DCL VAR(&P1) TYPE(*CHAR) LEN(10) /* FILE */
DCL VAR(&P2) TYPE(*CHAR) LEN(20) /* TOFILE */
DCL VAR(&P3) TYPE(*CHAR) LEN(26) /* JOB */
DCL VAR(&P4) TYPE(*CHAR) LEN(4) /* SPLNBR */
DCL VAR(&P5) TYPE(*CHAR) LEN(10) /* MEMBER */
DCL VAR(&P6) TYPE(*CHAR) LEN(1) /* MBR OPTION */
DCL VAR(&P7) TYPE(*CHAR) LEN(1) /* CTLCHAR */
DCL VAR(&P8) TYPE(*CHAR) LEN(1)
DCL VAR(&P9) TYPE(*CHAR) LEN(1)
DCL VAR(&P10) TYPE(*CHAR) LEN(1)
DCL VAR(&SPLUSR) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
RTVJOBA JOB(&JOBNAME) USER(&USER) NBR(&JOBNBR)
IF (%SST(&P3 1 1) *EQ '*') DO
CHGVAR &SPLUSR &USER
CHGVAR %SST(&P3 1 10) &JOBNAME
CHGVAR %SST(&P3 11 10) &USER
CHGVAR %SST(&P3 21 6) &JOBNBR
ENDDO
ELSE +
CHGVAR &SPLUSR %SST(&P3 11 10)
/* QSECOFR, QSYSOPR CAN BROWSE ALL SPOOLED FILE */
IF COND((&USER *EQ 'QSECOFR') *OR +
(&USER *EQ 'QSYSOPR')) +
THEN(GOTO CMDLBL(OK))
/* LIMIT ONLY SPOOLED CREATION USER CAN BROWSE OWN'S SPOOLED FILE */
IF COND(&USER *NE &SPLUSR) +
THEN(GOTO NOT_OK)
OK:
RETURN
NOT_OK: SNDPGMMSG MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
*CAT 'You are not authorized to spooled +
file' *BCAT &P1) MSGTYPE(*DIAG)
SNDPGMMSG MSGID( CPF0002 ) +
MSGF( QSYS/QCPFMSG ) +
MSGTYPE( *ESCAPE )
ENDPGM
CPYSPLF 命令語法檢核程式 for V5R2
File : QCLSRC
Member: CPYSPLFVC
Type : CLP
OS version: V5R2 以後
Usage : CRTCLPGM mylib/CPYSPLFVC
CHGCMD CMD(CPYSPLF) VLDCKR(mylib/CPYSPLFVC)
若執行有問題或不使用命令語法檢核程式時，執行
CHGCMD CMD(DSPSPLF) VLDCKR(*NONE)
/* Program : CPYSPLFVC */
/* System : iSeries 400 FOR V5R2 */
/* */
/* Validity Checking program for command CPYSPLF */
/* */
/* Example : protecting an SPOOL From a USER */
/* */
/* CHGCMD CMD(CPYSPLF) VLDCKR(MYLIB/CPYSPLFVC) */
/* To reset (in case you made errors) : */
/* CHGCMD CMD(CPYSPLF) VLDCKR(*NONE) */
DSPSPLFVC: PGM PARM(&P1 &P2 &P3 &P4 &P5 &P6 +
&P7 &P8 &P9 &P10 &P11 &P12)
DCL VAR(&P1) TYPE(*CHAR) LEN(10) /* FILE */
DCL VAR(&P2) TYPE(*CHAR) LEN(20) /* TOFILE */
DCL VAR(&P3) TYPE(*CHAR) LEN(26) /* JOB */
DCL VAR(&P4) TYPE(*CHAR) LEN(4) /* SPLNBR */
DCL VAR(&P5) TYPE(*CHAR) LEN(8) /* SYSNAME*/
DCL VAR(&P6) TYPE(*CHAR) LEN(6) /* CRTDATE */
DCL VAR(&P7) TYPE(*CHAR) LEN(10) /* MEMBER */
DCL VAR(&P8) TYPE(*CHAR) LEN(1) /* MBR OPTION */
DCL VAR(&P9) TYPE(*CHAR) LEN(1) /* CTLCHAR */
DCL VAR(&P10) TYPE(*CHAR) LEN(1)
DCL VAR(&P11) TYPE(*CHAR) LEN(1)
DCL VAR(&P12) TYPE(*CHAR) LEN(1)
DCL VAR(&SPLUSR) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
RTVJOBA JOB(&JOBNAME) USER(&USER) NBR(&JOBNBR)
IF (%SST(&P3 1 1) *EQ '*') DO
CHGVAR &SPLUSR &USER
CHGVAR %SST(&P3 1 10) &JOBNAME
CHGVAR %SST(&P3 11 10) &USER
CHGVAR %SST(&P3 21 6) &JOBNBR
ENDDO
ELSE +
CHGVAR &SPLUSR %SST(&P3 11 10)
/* QSECOFR, QSYSOPR CAN BROWSE ALL SPOOLED FILE */
IF COND((&USER *EQ 'QSECOFR') *OR +
(&USER *EQ 'QSYSOPR')) +
THEN(GOTO CMDLBL(OK))
/* LIMIT ONLY SPOOLED CREATION USER CAN BROWSE OWN'S SPOOLED FILE */
IF COND(&USER *NE &SPLUSR) +
THEN(GOTO NOT_OK)
OK:
RETURN
NOT_OK: SNDPGMMSG MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
*CAT 'You are not authorized to spooled +
file' *BCAT &P1) MSGTYPE(*DIAG)
SNDPGMMSG MSGID( CPF0002 ) +
MSGF( QSYS/QCPFMSG ) +
MSGTYPE( *ESCAPE )
ENDPGM
2003-01-04 報表安全列三：如何限制指令 DLTSPLF 的使用, 防止使用者刪除其他人的報表 ?
報表安全列三：如何限制指令 DLTSPLF 的使用, 防止使用者刪除其他人的報表 ?
有鑑於 報表的安全性管理，iSeries(AS/400) 作業系統並未提供完善的保護，我將建議使用 VCP 命令語
法檢核程式來做安全空管，
報表安全系列一 ：如何限制指令 WRKSPLF 的使用, 防止使用者察看全系統的報表 ?
報表安全系列二 ：如何限制指令 DSPSPLF 的使用, 防止使用者於 WRKSPLF 畫面中瀏覽全系統的報表 ?
報表安全系列三 ：如何限制指令 DLTSPLF 的使用, 防止使用者刪除其他人的報表 ?
你是否常會遇到使用者反應他的報表不見了，有可能被其他有 *SPLCTL 權限的人刪除，
為了要防止這種情形發生，只能從命令檢核程式著手，此範例與其他相關報表命令
（WRKSPLF, DSPSPLF）的檢核程式一樣，限制除了 QSECOFR, QSYSOPR 之外，使
用者僅能刪除自己的報表，同樣也分 OS V5R1(含)以前及OS V5R2(含)以後的版本。
DLTSPLF 命令語法檢核程式 for V5R1
File : QCLSRC
Member: DLTSPLFVC
Type : CLP
OS version: V5R1 以前
Usage : CRTCLPGM mylib/DLTSPLFVC
CHGCMD CMD(DLTSPLF) VLDCKR(mylib/DLTSPLFVC)
若執行有問題或不使用命令語法檢核程式時，執行
CHGCMD CMD(DSPSPLF) VLDCKR(*NONE)
/* Program : DLTSPLFVC */
/* System : iSeries 400 FOR V5R1 */
/* */
/* Validity Checking program for command DLTSPLF */
/* */
/* Example : protecting an SPOOL From a USER */
/* */
/* CHGCMD CMD(DLTSPLF) VLDCKR(MYLIB/DLTSPLFVC) */
/* To reset (in case you made errors) : */
/* CHGCMD CMD(DLTSPLF) VLDCKR(*NONE) */
DSPSPLFVC: PGM PARM(&P1 &P2 &P3 &P4 &P5)
DCL VAR(&P1) TYPE(*CHAR) LEN(10) /* FUNC */
DCL VAR(&P2) TYPE(*CHAR) LEN(10) /* FILE */
DCL VAR(&P3) TYPE(*CHAR) LEN(26) /* JOB */
DCL VAR(&P4) TYPE(*CHAR) LEN(4) /* SPLNBR */
DCL VAR(&P5) TYPE(*CHAR) LEN(40) /* SELECT */
DCL VAR(&SPLUSR) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
RTVJOBA JOB(&JOBNAME) USER(&USER) NBR(&JOBNBR)
IF (%SST(&P3 1 1) *EQ '*') DO
CHGVAR &SPLUSR &USER
CHGVAR %SST(&P3 1 10) &JOBNAME
CHGVAR %SST(&P3 11 10) &USER
CHGVAR %SST(&P3 21 6) &JOBNBR
ENDDO
ELSE +
CHGVAR &SPLUSR %SST(&P3 11 10)
/* USER QSECOFR, QSYSOPR UNLIMIT ACCESS SPOOLED FILE */
IF ((&USER *EQ 'QSECOFR') *OR +
(&USER *EQ 'QSYSOPR')) +
THEN(GOTO OK)
/* LIMIT ONLY SPOOLED CREATION USER CAN BROWSE OWN'S SPOOLED FILE */
IF COND(&USER *NE &SPLUSR) +
THEN(GOTO NOT_OK)
OK:
RETURN
NOT_OK: SNDPGMMSG MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
*CAT 'You are not authorized to spooled +
file' *BCAT &P2) MSGTYPE(*DIAG)
SNDPGMMSG MSGID( CPF0002 ) +
MSGF( QSYS/QCPFMSG ) +
MSGTYPE( *ESCAPE )
ENDPGM
DLTSPLF 命令語法檢核程式 for V5R2
File : QCLSRC
Member: DLTSPLFVC
Type : CLP
OS version: V5R2 以後
Usage : CRTCLPGM mylib/DLTSPLFVC
CHGCMD CMD(DLTSPLF) VLDCKR(mylib/DLTSPLFVC)
若執行有問題或不使用命令語法檢核程式時，執行
CHGCMD CMD(DSPSPLF) VLDCKR(*NONE)
/* Program : DLTSPLFVC */
/* System : iSeries 400 FOR V5R2 */
/* */
/* Validity Checking program for command DLTSPLF */
/* */
/* Example : protecting an SPOOL From a USER */
/* */
/* CHGCMD CMD(DLTSPLF) VLDCKR(MYLIB/DLTSPLFVC) */
/* To reset (in case you made errors) : */
/* CHGCMD CMD(DLTSPLF) VLDCKR(*NONE) */
DSPSPLFVC: PGM PARM(&P1 &P2 &P3 &P4 &P5 &P6 &P7)
DCL VAR(&P1) TYPE(*CHAR) LEN(1) /* FUNC */
DCL VAR(&P2) TYPE(*CHAR) LEN(10) /* FILE */
DCL VAR(&P3) TYPE(*CHAR) LEN(26) /* JOB */
DCL VAR(&P4) TYPE(*CHAR) LEN(4) /* SPLNBR */
DCL VAR(&P5) TYPE(*CHAR) LEN(8) /* SYSNAME */
DCL VAR(&P6) TYPE(*CHAR) LEN(6) /* CRTDATE */
DCL VAR(&P7) TYPE(*CHAR) LEN(40) /* SELECT */
DCL VAR(&SPLUSR) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
RTVJOBA JOB(&JOBNAME) USER(&USER) NBR(&JOBNBR)
IF (%SST(&P3 1 1) *EQ '*') DO
CHGVAR &SPLUSR &USER
CHGVAR %SST(&P3 1 10) &JOBNAME
CHGVAR %SST(&P3 11 10) &USER
CHGVAR %SST(&P3 21 6) &JOBNBR
ENDDO
ELSE +
CHGVAR &SPLUSR %SST(&P3 11 10)
/* USER QSECOFR, QSYSOPR UNLIMIT ACCESS SPOOLED FILE */
IF ((&USER *EQ 'QSECOFR') *OR +
(&USER *EQ 'QSYSOPR')) +
THEN(GOTO OK)
/* LIMIT ONLY SPOOLED CREATION USER CAN BROWSE OWN'S SPOOLED FILE */
IF COND(&USER *NE &SPLUSR) +
THEN(GOTO NOT_OK)
OK:
RETURN
NOT_OK: SNDPGMMSG MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
*CAT 'You are not authorized to spooled +
file' *BCAT &P2) MSGTYPE(*DIAG)
SNDPGMMSG MSGID( CPF0002 ) +
MSGF( QSYS/QCPFMSG ) +
MSGTYPE( *ESCAPE )
ENDPGM
星期四, 11月 02, 2023
2003-01-03 如何限制指令 DSPSPLF 的使用, 防止使用者於 WRKSPLF 畫面中刪除全系統的報表 ?
如何限制指令 DSPSPLF 的使用, 防止使用者於 WRKSPLF 畫面中刪除全系統的報表 ?
使用者若有 *SPLCTL 特殊權限，於 WRKSPLF 指令可以指定其他使用者或全部使用者報表，
畫面中可以使用 選項 5 瀏覽全系統的報表，那要如何限制選項 5 瀏覽報表指令 DSPSPLF
的使用, 以保護機密資訊，不被未授權的人存取 ?
若要做到報表的安全防護，最佳的方式只有透過命令語法檢核程式(VCP - Validity Checking Program)，但這個命令語法檢核程式
有時需要隨 OS 版本升級而更改，因為某些命令會增加參數，如 DSPSPLF 命令，於
OS V5R2 時多了二個參數，所以需要更改才可以繼續使用，針對每個 Command 的所有參數
（含隱藏的常數），IBM 並未記錄於其手冊中，是需要透過系統擷取命令定義的 API 或利用工具 RTVCMD
http://www.iseriesnetwork.com/code/sharewarefiles/rtvcmd.zip
取得命令真正的定義(Command Source)，
相關報表的命令有
WRKSPLF
CHGSPLFA
DLTSPLF
DSPSPLF
上述指令可以設定命令語法檢核程式加以檢核哪些使用者可以存取其他人的報表，
我已於前一期電子報中介紹 "如何限制指令 WRKSPLF 的使用, 防止使用者察看全系統的報表 ?"
的VCP 命令語法檢核程式，因 WRKSPLF 參數數目 V5R1與 V5R2 相同，所以該程式不必修改即可用於 V5R2 中。
本期我再介紹 DSPSPLF 的 VCP 命令語法檢核程式 for OS V5R1 及 V5R2 ：
DSPSPLF VCP 命令語法檢核程式 for V5R1
File : QCLSRC
Member: DSPSPLFVC
Type : CLP
OS version: V5R1 以前
Usage : CRTCLPGM mylib/DSPSPLFVC
CHGCMD CMD(DSPSPLF) VLDCKR(mylib/DSPSPLFVC)
若執行有問題或不使用命令語法檢核程式時，執行
CHGCMD CMD(DSPSPLF) VLDCKR(*NONE)
/* Program : DSPSPLFVC */
/* System : iSeries 400 FOR V5R1 */
/* */
/* Validity Checking program for command DSPSPLF */
/* */
/* Example : protecting an SPOOL From a USER */
/* */
/* CHGCMD CMD(DSPSPLF) VLDCKR(MYLIB/DSPSPLFVC) */
/* To reset (in case you made errors) : */
/* CHGCMD CMD(DSPSPLF) VLDCKR(*NONE) */
DSPSPLFVC: PGM PARM(&P1 &P2 &P3 &P4)
DCL VAR(&P1) TYPE(*CHAR) LEN(10)
DCL VAR(&P2) TYPE(*CHAR) LEN(26)
DCL VAR(&P3) TYPE(*CHAR) LEN(4)
DCL VAR(&P4) TYPE(*CHAR) LEN(1)
DCL VAR(&SPLUSR) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
RTVJOBA JOB(&JOBNAME) USER(&USER) NBR(&JOBNBR)
IF (%SST(&P2 1 1) *EQ '*') DO
CHGVAR &SPLUSR &USER
CHGVAR %SST(&P2 1 10) &JOBNAME
CHGVAR %SST(&P2 11 10) &USER
CHGVAR %SST(&P2 21 6) &JOBNBR
ENDDO
ELSE +
CHGVAR &SPLUSR %SST(&P2 11 10)
/* USER QSECOFR, QSYSOPR UNLIMIT ACCESS SPOOLED FILE */
IF ((&USER *EQ 'QSECOFR') *OR +
(&USER *EQ 'QSYSOPR')) +
THEN(GOTO OK)
/* LIMIT ONLY SPOOLED CREATION USER CAN BROWSE OWN'S SPOOLED FILE */
IF COND(&USER *NE &SPLUSR) +
THEN(GOTO NOT_OK)
OK:
RETURN
NOT_OK: SNDPGMMSG MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
*CAT 'You are not authorized to spooled +
file' *BCAT &P1) MSGTYPE(*DIAG)
SNDPGMMSG MSGID( CPF0002 ) +
MSGF( QSYS/QCPFMSG ) +
MSGTYPE( *ESCAPE )
ENDPGM
DSPSPLF VCP 命令語法檢核程式 for V5R2
File : QCLSRC
Member: DSPSPLFVC
Type : CLP
OS version: V5R2 以後
Usage : CRTCLPGM mylib/DSPSPLFVC
CHGCMD CMD(DSPSPLF) VLDCKR(mylib/DSPSPLFVC)
若執行有問題或不使用檢核程式時，執行
CHGCMD CMD(DSPSPLF) VLDCKR(*NONE)
/* Program : DSPSPLFVC */
/* System : iSeries 400 FOR V5R2 */
/* */
/* Validity Checking program for command DSPSPLF */
/* */
/* Example : protecting an SPOOL From a USER */
/* */
/* CHGCMD CMD(DSPSPLF) VLDCKR(MYLIB/DSPSPLFVC) */
/* To reset (in case you made errors) : */
/* CHGCMD CMD(DSPSPLF) VLDCKR(*NONE) */
DSPSPLFVC: PGM PARM(&P1 &P2 &P3 &P4 &P5 &P6)
DCL VAR(&P1) TYPE(*CHAR) LEN(10) /* FILE */
DCL VAR(&P2) TYPE(*CHAR) LEN(26) /* FULLJOB */
DCL VAR(&P3) TYPE(*CHAR) LEN(4) /* SPLNBR */
DCL VAR(&P4) TYPE(*CHAR) LEN(8) /* SYSNAME */
DCL VAR(&P5) TYPE(*CHAR) LEN(6) /* CRTDATE */
DCL VAR(&P6) TYPE(*CHAR) LEN(1) /* FOLD */
DCL VAR(&SPLUSR) TYPE(*CHAR) LEN(10)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
RTVJOBA JOB(&JOBNAME) USER(&USER) NBR(&JOBNBR)
IF (%SST(&P2 1 1) *EQ '*') DO
CHGVAR &SPLUSR &USER
CHGVAR %SST(&P2 1 10) &JOBNAME
CHGVAR %SST(&P2 11 10) &USER
CHGVAR %SST(&P2 21 6) &JOBNBR
ENDDO
ELSE +
CHGVAR &SPLUSR %SST(&P2 11 10)
/* USER QSECOFR, QSYSOPR UNLIMIT ACCESS SPOOLED FILE */
IF ((&USER *EQ 'QSECOFR') *OR +
(&USER *EQ 'QSYSOPR')) +
THEN(GOTO OK)
/* LIMIT ONLY SPOOLED CREATION USER CAN BROWSE OWN'S SPOOLED FILE */
IF COND(&USER *NE &SPLUSR) +
THEN(GOTO NOT_OK)
OK:
RETURN
NOT_OK: SNDPGMMSG MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000' +
*CAT 'You are not authorized to spooled +
file' *BCAT &P1) MSGTYPE(*DIAG)
SNDPGMMSG MSGID( CPF0002 ) +
MSGF( QSYS/QCPFMSG ) +
MSGTYPE( *ESCAPE )
ENDPGM
2002-12-18 如何限制指令 WRKSPLF 的使用, 防止使用者指定參數 USER(*ALL) 察看全系統的報表 ?
如何限制指令 WRKSPLF 的使用, 防止使用者指定參數 USER(*ALL) 察看全系統的報表 ?
某些使用者只要授與 *SPLCTL 的特殊權限，那他對系統上所有報表均有最高的權限，
他可以搬移刪除檢視所有報表，當然包含重要的機密資料，如薪資資料，所以我們需
要做適當的限制，我們可以利用命令檢核程式(Validity Checking Program) 達
到控管的目的。你可以利用下述範例更改呈自己的需求。
File : QCLSRC
Member: WRKSPLFVC
Type : CLP
OS Version : All
Usage : CRTCLPGM PGM(your-lib/WRKSPLFVC)
Execute the following command :
CHGCMD CMD(QSYS/WRKSPLF) VLDCKR(your-lib/VALWRKSPLF)
To reset (If you made a mistake) :
CHGCMD CMD(QSYS/WRKSPLF) VLDCKR(*NONE)
/* The user is not authorised to use parameter USER *ALL */
/* (Except QSYSOPR, QSECOFR, QSRV) */
/* */
/* EXECUTE THE FOLLOWING COMMAND : */
/* */
/* CHGCMD CMD(QSYS/WRKSPLF) VLDCKR(MYLIB/WRKSPLFVC) */
/* */
/* TO RESET (IF YOU MADE A MISTAKE) : */
/* */
/* CHGCMD CMD(QSYS/WRKSPLF) VLDCKR(*NONE) */
/* */
WRKSPLFVC: PGM PARM(&P1 &P2 &P3 &P4)
DCL VAR(&P1) TYPE(*CHAR) LEN(44)
DCL VAR(&P2) TYPE(*CHAR) LEN(7)
DCL VAR(&P3) TYPE(*CHAR) LEN(10)
DCL VAR(&P4) TYPE(*CHAR) LEN(1)
DCL VAR(&USER) TYPE(*CHAR) LEN(10)
DCL VAR(&USERPARM) TYPE(*CHAR) LEN(10)
DCL VAR(&FORMTYPE) TYPE(*CHAR) LEN(10)
DCL VAR(&DEVICE) TYPE(*CHAR) LEN(10)
DCL VAR(&USERDATA) TYPE(*CHAR) LEN(10)
DCL VAR(&ASP_BIN) TYPE(*CHAR) LEN(2)
DCL VAR(&ASP_DEC) TYPE(*DEC) LEN(2 0)
RTVJOBA USER(&USER)
/* Return if the USER is authorized to use all parameter values */
IF COND(&USER *EQ QSYSOPR *OR &USER *EQ QSECOFR +
*OR &USER *EQ QSRV) THEN(RETURN)
/* Parse the command parameters */
CHGVAR VAR(&ASP_BIN) VALUE(%SST(&P1 43 2))
CHGVAR VAR(&ASP_DEC) VALUE(%BIN(&ASP_BIN 1 2))
CHGVAR VAR(&USERPARM) VALUE(%SST(&P1 3 10))
CHGVAR VAR(&FORMTYPE) VALUE(%SST(&P1 13 10))
CHGVAR VAR(&DEVICE) VALUE(%SST(&P1 23 10))
CHGVAR VAR(&USERDATA) VALUE(%SST(&P1 33 10))
/* Check the value of the parameter USER */
IF COND(&USERPARM *NE *ALL) THEN(RETURN)
/* User is not allowed to execute WRKSPLF with USER *ALL */
/* Send a diagnostic message to the user. */
NOT_OK: SNDPGMMSG MSGID(CPD0006) MSGF(QCPFMSG) MSGDTA('0000 +
You are not Authorized to use parameter +
USER *ALL.') MSGTYPE(*DIAG)
/* Message CPF0002 is used in validity checking programs to */
/* indicate an error condition */
SNDPGMMSG MSGID(CPF0002) MSGF(QSYS/QCPFMSG) +
MSGTYPE(*ESCAPE)
END: ENDPGM
2002-12-02 如何複製報表並可更改報表屬性(如報表擁有人, 報表名稱...) (Command DUPCHGSPLF)?
如何複製報表並可更改報表屬性(如報表擁有人, 報表名稱...) (Command DUPCHGSPLF)?
要複製報表並可更改報表屬性(如報表擁有人, 報表名稱...), 有多種方式, 利用
CPYSPLF, OVRPRTF, 及 CPYF 三個指令組合方式也可以完成, 但繁瑣耗時, 這裡介
紹直接用 API , 並製作成指令 DUPCHGSPLF.
File : QCLSRC
Member: DUPCHGSPLF
Type : CLP
Usage : CRTCLPGM DUPCHGSPLF
Version: ALL
/* Program : DUPCHGSPLF */
/* System : iSeries */
/* */
/* Description : Duplicate and Change Spooled File */
/* */
/* To compile : */
/* */
/* CRTCLPGM PGM(XXX/DUPCHGSPLF) SRCFILE(XXX/QCLSRC) */
/* */
DUPCHGSPLF: PGM PARM(&JOB &SPLFILE &SPLNBRBIN &LPI &CPI +
&FONT &PAGRTT &OUTQ &DRAWER &FORMTYPE +
&USRDTA &HOLD &SAVE &DUPLEX &OUTBIN +
&NEWUSER &NEWSPLNAME &DLTSPLF)
/* Parameters */
DCL VAR(&JOB) TYPE(*CHAR) LEN(26)
DCL VAR(&SPLFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&SPLNBRBIN) TYPE(*CHAR) LEN(4)
DCL VAR(&LPI) TYPE(*CHAR) LEN(4)
DCL VAR(&CPI) TYPE(*CHAR) LEN(4)
DCL VAR(&PAGRTT) TYPE(*CHAR) LEN(4)
DCL VAR(&DRAWER) TYPE(*CHAR) LEN(4)
DCL VAR(&FONT) TYPE(*CHAR) LEN(5)
DCL VAR(&OUTQ) TYPE(*CHAR) LEN(20)
DCL VAR(&FORMTYPE) TYPE(*CHAR) LEN(10)
DCL VAR(&USRDTA) TYPE(*CHAR) LEN(10)
DCL VAR(&HOLD) TYPE(*CHAR) LEN(10)
DCL VAR(&SAVE) TYPE(*CHAR) LEN(10)
DCL VAR(&DUPLEX) TYPE(*CHAR) LEN(10)
DCL VAR(&OUTBIN) TYPE(*CHAR) LEN(4)
DCL VAR(&NEWUSER) TYPE(*CHAR) LEN(10)
DCL VAR(&NEWSPLNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&DLTSPLF) TYPE(*CHAR) LEN(10)
/* Variables */
DCL VAR(&SPLNBRDEC) TYPE(*DEC) LEN(8 0)
DCL VAR(&SPLNBRCHR) TYPE(*CHAR) LEN(8)
DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBUSER) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6)
DCL VAR(&HANDLE) TYPE(*CHAR) LEN(4) /* Spooled +
file handle */
DCL VAR(&BUFFER) TYPE(*CHAR) LEN(4) /* number of +
buffers to get */
DCL VAR(&SPLATTR) TYPE(*CHAR) LEN(5000)
DCL VAR(&ATTRLEN) TYPE(*CHAR) LEN(4)
DCL VAR(&INDIC) TYPE(*CHAR) LEN(1)
/* Parameters for the QUSCRTUS API */
DCL VAR(&USPNAME) TYPE(*CHAR) LEN(10) /* user +
space name */
DCL VAR(&USPLIB) TYPE(*CHAR) LEN(10) /* user +
space library */
DCL VAR(&USPQUAL) TYPE(*CHAR) LEN(20) /* user +
space qualified name */
DCL VAR(&USPTYPE) TYPE(*CHAR) LEN(10) /* user +
space type */
DCL VAR(&USPSIZE) TYPE(*CHAR) LEN(4) /* user +
space size */
DCL VAR(&USPFILL) TYPE(*CHAR) LEN(1) /* user +
space fill character */
DCL VAR(&USPAUT) TYPE(*CHAR) LEN(10) /* user +
space authority */
DCL VAR(&USPTEXT) TYPE(*CHAR) LEN(50) /* user +
space text */
/* Parameters for the QUSRTVUS API */
DCL VAR(&STARTPOS) TYPE(*CHAR) LEN(4)
DCL VAR(&DATALEN ) TYPE(*CHAR) LEN(4)
DCL VAR(&HEADER) TYPE(*CHAR) LEN(150)
CHGVAR VAR(%BIN(&ATTRLEN)) VALUE(5000)
/* Create User space */
CHGVAR VAR(&USPNAME) VALUE('DUPCHGSPLF') /* set +
user space name */
CHGVAR VAR(&USPLIB) VALUE('QTEMP') /* set user +
space library */
CHGVAR VAR(&USPQUAL) VALUE(&USPNAME *CAT &USPLIB) +
/* set user space qualified name */
CHGVAR VAR(&USPTYPE) VALUE('MYTYPE') /* set user +
space type */
CHGVAR VAR(%BIN(&USPSIZE)) VALUE(64000) /* set +
user space size */
CHGVAR VAR(&USPFILL) VALUE(' ') /* set user space +
fill character */
CHGVAR VAR(&USPAUT) VALUE('*USE') /* set user +
space authority */
CHGVAR VAR(&USPTEXT) VALUE('my user space') +
/* set user space text */
CALL PGM(QUSCRTUS) PARM(&USPQUAL &USPTYPE +
&USPSIZE &USPFILL &USPAUT &USPTEXT)
/* Open spooled file */
CHGVAR VAR(&BUFFER) VALUE(X'FFFFFFFF')
CALL PGM(QSPOPNSP) PARM(&HANDLE &JOB ' ' ' ' +
&SPLFILE &SPLNBRBIN &BUFFER X'00000000')
/* Get spooled file data */
CALL PGM(QSPGETSP) PARM(&HANDLE &USPQUAL +
'SPFR0200' &BUFFER '*WAIT' X'00000000')
/* Close spooled file */
CALL PGM(QSPCLOSP) PARM(&HANDLE X'00000000')
/* Retrieve Spooled file attributes */
CALL PGM(QUSRSPLA) PARM(&SPLATTR &ATTRLEN +
'SPLA0200' &JOB ' ' ' ' &SPLFILE &SPLNBRBIN)
IF COND(%BIN(&LPI) *NE 0) THEN(CHGVAR +
VAR(%SST(&SPLATTR 181 4)) VALUE(&LPI))
IF COND(%BIN(&CPI) *NE 0) THEN(CHGVAR +
VAR(%SST(&SPLATTR 185 4)) VALUE(&CPI))
IF COND(&FONT *NE *SAME) THEN(CHGVAR +
VAR(%SST(&SPLATTR 537 4)) VALUE(&FONT))
IF COND(%BIN(&PAGRTT) *NE -4) THEN(CHGVAR +
VAR(%SST(&SPLATTR 553 4)) VALUE(&PAGRTT))
IF COND(&OUTQ *NE *SAME) THEN(CHGVAR +
VAR(%SST(&SPLATTR 191 20)) VALUE(&OUTQ))
IF COND(%BIN(&DRAWER) *NE 0) THEN(CHGVAR +
VAR(%SST(&SPLATTR 533 4)) VALUE(&DRAWER))
IF COND(%BIN(&OUTBIN) *NE -1) THEN(CHGVAR +
VAR(%SST(&SPLATTR 3313 4)) VALUE(&OUTBIN))
IF COND(&FORMTYPE *NE *SAME) THEN(CHGVAR +
VAR(%SST(&SPLATTR 89 10)) VALUE(&FORMTYPE))
IF COND(&USRDTA *NE *SAME) THEN(CHGVAR +
VAR(%SST(&SPLATTR 99 10)) VALUE(&USRDTA))
IF COND(&HOLD *NE *SAME) THEN(CHGVAR +
VAR(%SST(&SPLATTR 129 10)) VALUE(&HOLD))
IF COND(&SAVE *NE *SAME) THEN(CHGVAR +
VAR(%SST(&SPLATTR 139 10)) VALUE(&SAVE))
IF COND(&DUPLEX *NE *SAME) THEN(CHGVAR +
VAR(%SST(&SPLATTR 561 10)) VALUE(&DUPLEX))
IF COND(&NEWUSER *NE *SAME) THEN(CHGVAR +
VAR(%SST(&SPLATTR 59 10)) VALUE(&NEWUSER))
CHGVAR VAR(&JOBNAME) VALUE(%SST(&SPLATTR 49 10))
CHGVAR VAR(&JOBUSER) VALUE(%SST(&SPLATTR 59 10))
IF COND(&NEWSPLNAME *EQ *JOBNAME) THEN(CHGVAR +
VAR(&NEWSPLNAME) VALUE(&JOBNAME))
IF COND(&NEWSPLNAME *EQ *USER) THEN(CHGVAR +
VAR(&NEWSPLNAME) VALUE(&JOBUSER))
IF COND(&NEWSPLNAME *NE *SAME) THEN(CHGVAR +
VAR(%SST(&SPLATTR 75 10)) VALUE(&NEWSPLNAME))
/* Create Spooled file */
CALL PGM(QSPCRTSP) PARM(&HANDLE &SPLATTR +
X'00000000')
/* Put Spooled File data */
CALL PGM(QSPPUTSP) PARM(&HANDLE &USPQUAL +
X'00000000')
/* Close Spooled file */
CALL PGM(QSPCLOSP) PARM(&HANDLE X'00000000')
/* Retrieve User space HEADER information */
CHGVAR VAR(%BIN(&STARTPOS)) VALUE(1) /* set start +
position */
CHGVAR VAR(%BIN(&DATALEN)) VALUE(140) /* set data +
length */
CALL PGM(QUSRTVUS) PARM(&USPQUAL &STARTPOS +
&DATALEN &HEADER)
DLTUSRSPC USRSPC(&USPLIB/&USPNAME)
CHGVAR VAR(&INDIC) VALUE(%SST(&HEADER 87 1))
IF COND(&INDIC *EQ C) THEN(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Spooled +
file' *BCAT &SPLFILE *BCAT 'duplicated') +
MSGTYPE(*COMP)
ENDDO
ELSE CMD(DO)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Spooled +
file' *BCAT &SPLFILE *BCAT 'not +
completely duplicated') MSGTYPE(*ESCAPE)
ENDDO
/* Delete Original Spooled File */
IF COND(&DLTSPLF *EQ *NO) THEN(RETURN)
IF COND(&JOB *EQ '*') THEN(RTVJOBA +
JOB(&JOBNAME) USER(&JOBUSER) NBR(&JOBNBR))
ELSE CMD(DO)
CHGVAR VAR(&JOBNAME) VALUE(%SST(&JOB 1 10))
CHGVAR VAR(&JOBUSER) VALUE(%SST(&JOB 11 10))
CHGVAR VAR(&JOBNBR) VALUE(%SST(&JOB 21 6))
ENDDO
IF COND(%BIN(&SPLNBRBIN) *EQ 0) THEN(CHGVAR +
VAR(&SPLNBRCHR) VALUE(*ONLY))
IF COND(%BIN(&SPLNBRBIN) *EQ -1) THEN(CHGVAR +
VAR(&SPLNBRCHR) VALUE(*LAST))
IF COND(%BIN(&SPLNBRBIN) *GT 0) THEN(DO)
CHGVAR VAR(&SPLNBRDEC) VALUE(%BIN(&SPLNBRBIN))
CHGVAR VAR(&SPLNBRCHR) VALUE(&SPLNBRDEC)
ENDDO
DLTSPLF FILE(&SPLFILE) +
JOB(&JOBNBR/&JOBUSER/&JOBNAME) +
SPLNBR(&SPLNBRCHR)
MONMSG MSGID(CPF0000)
END: ENDPGM
File : QCMDSRC
Member: DUPCHGSPLF
Type : CMD
Usage : CRTCMD CMD(DUPCHGSPLF) PGM(DUPCGHSPLF)
Version: ALL
/* */
/* \\\\\\\ */
/* ( o o ) */
/*------------------------oOO----(_)----OOo-------------------------*/
/* */
/* Command : DUPCHGSPLF */
/* System : iSeries */
/* */
/* Description : Duplicate and Change Spooled file */
/* */
/* ooooO Ooooo */
/* ( ) ( ) */
/*----------------------( )-------------( )---------------------*/
/* (_) (_) */
/* */
/* To compile : */
/* */
/* CRTCMD CMD(XXX/DUPCHGSPLF) PGM(XXX/DUPCHGSPLF) + */
/* SRCFILE(XXX/QCMDSRC) */
/* */
DUPCHGSPLF: CMD PROMPT('Duplicate and change SPLF')
PARM KWD(JOB) TYPE(JOBNAME) DFT(*) SNGVAL((*)) +
PROMPT('Job name')
PARM KWD(SPLFILE) TYPE(*NAME) LEN(10) DFT(QPRINT) +
PROMPT('Spooled file name')
PARM KWD(SPLNBR) TYPE(*INT4) DFT(*LAST) RANGE(1 +
9999) SPCVAL((*ONLY 0) (*LAST -1)) MIN(0) +
PROMPT('Spooled file number')
PARM KWD(LPI) TYPE(*INT4) RSTD(*YES) DFT(*SAME) +
SPCVAL((*SAME 0) (6 60) (8 80) (3 30) (4 +
40) (7.5 75) (7,5 75) (9 90) (12 120)) +
MIN(0) PROMPT('Lines per inch')
PARM KWD(CPI) TYPE(*INT4) RSTD(*YES) DFT(*SAME) +
SPCVAL((*SAME 0) (10 100) (5 50) (12 120) +
(13.3 133) (13,3 133) (15 150) (16.7 167) +
(16,7 167) (18 180) (20 200)) MIN(0) +
PROMPT('Characters per inch')
PARM KWD(FONT) TYPE(*CHAR) LEN(5) RSTD(*YES) +
DFT(*SAME) VALUES(*SAME *CPI) PROMPT('Font')
PARM KWD(PAGRTT) TYPE(*INT4) RSTD(*YES) +
DFT(*SAME) VALUES(0 90 180 270) +
SPCVAL((*AUTO -1) (*DEVD -2) (*COR -3) +
(*SAME -4)) PROMPT('Degree of page rotation')
PARM KWD(OUTQ) TYPE(OUTQ) DFT(*SAME) +
SNGVAL((*SAME)) MIN(0) PROMPT('Output queue')
PARM KWD(DRAWER) TYPE(*INT4) DFT(*SAME) RANGE(1 +
255) SPCVAL((*SAME 0) (*E1 -1)) +
PROMPT('Source drawer')
PARM KWD(FORMTYPE) TYPE(*CHAR) LEN(10) DFT(*SAME) +
SPCVAL((*SAME) (*STD)) PROMPT('Formtype')
PARM KWD(USRDTA) TYPE(*CHAR) LEN(10) DFT(*SAME) +
SPCVAL((*SAME)) PROMPT('User specified data')
PARM KWD(HOLD) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*SAME) VALUES(*YES *NO) +
SPCVAL((*SAME)) PROMPT('Hold file before +
written')
PARM KWD(SAVE) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*SAME) VALUES(*YES *NO) +
SPCVAL((*SAME)) PROMPT('Save file after +
written')
PARM KWD(DUPLEX) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*SAME) VALUES(*YES *NO *TUMBLE +
*FORMDF) SPCVAL((*SAME)) PROMPT('Print on +
both sides (Duplex)')
PARM KWD(OUTBIN) TYPE(*INT4) DFT(*SAME) RANGE(1 +
65535) SPCVAL((*SAME -1) (*DEVD 0)) +
PROMPT('Output bin')
PARM KWD(NEWUSER) TYPE(*NAME) LEN(10) DFT(*SAME) +
SPCVAL((*SAME)) PROMPT('New User')
PARM KWD(NEWSPLNAME) TYPE(*NAME) LEN(10) +
DFT(*SAME) SPCVAL((*SAME) (*JOBNAME) +
(*USER)) PROMPT('New Spool file name')
PARM KWD(DLTSPLF) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*NO) VALUES(*YES *NO) PROMPT('Delete +
file after duplication')
OUTQ: QUAL TYPE(*NAME) LEN(10) MIN(1)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*CURLIB) (*LIBL)) PROMPT('Library')
JOBNAME: QUAL TYPE(*NAME) LEN(10) MIN(1)
QUAL TYPE(*NAME) LEN(10) DFT(' ') SPCVAL((' ')) +
CHOICE('Name') PROMPT('User')
QUAL TYPE(*CHAR) LEN(6) DFT(' ') RANGE(000000 +
999999) SPCVAL((' ')) FULL(*YES) +
CHOICE('000000-999999') PROMPT('Number')
2002-09-11 如何讓報表管理自動化？
2002-09-11 如何讓報表管理自動化？
報表管理通常是一般系統管理的工作，AS/400(iSeries) 系統已包含以使用者及使用者自己的報表連結相關
的印表機及輸出佇列（Outq -- Output Queue）的報表管理技術，通常管理人員會允許使用者使用指令
WRKSPLF(Work with Spool Files) 及 WRKOUTQ(Work with Output Queues) 截取報表資料，這些指令讓使
用者管理他們自己的報表，及若某使用者同時擁有 *SPLCTL 特殊權限時，該使用者同時可以管理其他人的
報表，然而使用這些指令仍然無法讓報表管理自動化。使用者仍然需要從一個輸出佇列搬移報表至另一個輸
出佇列或從一台印表機搬移報表至另一台印表機。
為什麼有人想要讓報表管理自動化？因為當報表很多時，如週報月報季報年報累計一段時間後，就會有報表
儲存的需求，因為報表本身於 AS/400(iSeries)系統上並不是一個物件，所以無法利用 SAVE 指令儲存，所
以需要採用某些技巧才將報表儲存起來，當然報表可以利用複製報表至資料庫檔案儲存在 AS/400(iSeries)
或下載至 PC 上，但報表非常多時便無法一一用手動的方式來完成，所以可以利用其他廠商所開發的報表管
理軟體，所以仍需要額外的成本才能完成報表管理自動化的工作，基於成本考量，我將教您如何達成報表管
理自動化的方式。其步驟如下：
１：取得哪些報表放置於輸出佇列中的詳細資料，即報表管理自動化的先決條件是以輸出佇列(Outq)為管理
單位。
２：使用指令 CPYSPLF 複製報表資料至資料庫檔案(PF -- Physical file)。
３：
ａ 若僅需儲存報表於 AS/400(iSeries)上，則定期備份步驟２所產生的資料庫檔案（需要自行定義資
料庫檔案名稱及其 member 成員名稱，方便於備份及回複管理）。
ｂ 若僅需儲存報表於 PC 上，則有三種方式：
一： 使用指令 CPYTOSTMF 複製步驟２所產生的資料庫檔案至 IFS 的一般 PC 檔案即可使用
SAV/RST 指令備份/回複或
二： 使用 FTP 方式將步驟２所產生的資料庫檔案傳送到 PC 的 FTP 伺服器或
三： 於 AS/400(iSeries) 及 PC 端撰寫 Socket 程式，傳送步驟２所產生的資料庫檔案至 PC。
在這裡我僅以方式一來做例子。
要如何將上述三個步驟組合自動處理而不用人工介入輸入指令呢？
這起始點是如何取得放置於輸出佇列中報表的詳細資料，您可以藉由系統所提供用以連結輸出佇列(Outq)的
資料佇列(DTAQ -- Data Queue)來取得放置於輸出佇列(Outq)中報表的詳細資料，來完成第一個步驟，所以
第一步是藉由下述指令新增一個資料佇列(DTAQ -- Data Queue)，
CRTDTAQ DTAQ(lib/AUTOSPLDTAQ) MAXLEN(128)
然後新增一個輸出佇列(Outq)，同時指定 DTAQ(Data Queue) 參數連結上述指令所新增的資料佇列(DTAQ --
Data Queue)，指令如下，
CRTOUTQ OUTQ(lib/AUTOSPLOUTQ) DTAQ(lib/AUTOSPLDTAQ)
在上述例子中 "lib" 是您所希望放置輸出佇列Outq(Output Queue)及 資料佇列DTAQ(Data Queue) 物件的程
式庫（附註：Outq 及 Dtaq 可以放置於不同的程式庫）。
上述指令在輸出佇列 AUTOSPLOUTQ 及資料佇列 AUTOSPLDTAQ 間建立了一個連結關係，所以當有報表放置於輸
出佇列 AUTOSPLOUTQ 時，同時會有一筆該報表的相關資料放置於資料佇列 AUTOSPLDTAQ 中。
放置於資料佇列 AUTOSPLDTAQ 中資訊的長度有 128 位，包含如下資訊：
報表資訊放置於資料佇列DTAQ(Data Queue)的資料格式
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
起始位置 長度 說明
＝＝＝＝ ＝＝＝＝ ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
1 CHAR(10) Function "*SPOOL" 表此筆記錄是報表相關資訊（不需要）
11 CHAR(02) Record type "01" 表示已放置至輸出佇列的報表狀態為 Ready（不需要）
13 CHAR(26) Qualified job name 產生此報表的 Job 全名
CHAR(10) Job name
CHAR(10) User name
CHAR(6) Job number
39 CHAR(10) Spool file name 表示已放置至輸出佇列報表的報表名稱
49 BINARY(4) Spool file number 表示已放置至輸出佇列報表的報表序號
53 CHAR(20) Qualified output queue name 表示此報表所放置的輸出佇列名稱全名
CHAR(10) Output queue name
CHAR(10) Library of the output queue
73 CHAR(56) 56 bytes of filler 此 56 位保留不用（不需要）
上述資訊可能用於指令 CPYSPLF 及 CPYTOSTMF。
要記住當有有一份新的報表放置於輸出佇列Outq(Output Queue)中時，而且該報表的狀態是 Ready(RDY)，此時
即有一筆報表紀錄放置於資料佇列 DTAQ(Data Queue)中，所以我們需要一個批次工作用以監控是否有新的報表
資訊放置於資料佇列 DTAQ(Data Queue) 中。
下列是用於處理這個程序的 RPGIV 程式片斷，底下是依照報表資訊放置於資料佇列DTAQ(Data Queue)的資料格
式用於接收資料佇列 DTAQ(Data Queue)資料的資料結構：
D SpoolInfo DS
D Function 10
D RecordType 2
D QualJobName 26
D JobName 10 Overlay(QualJobName:1)
D JobUser 10 Overlay(QualJobName:11)
D JobNumber 6 Overlay(QualJobName:21)
D FileName 10
D FileNumber 9B 0
D QualQueueName 20
D QueueName 10 Overlay(QualQueueName:1)
D QueueLibrary 10 Overlay(QualQueueName:11)
D Filler 56
這個資料結構包含從資料佇列 DTAQ(Data Queue) 所取得的資訊，job name，job user，job number，file name
及 file number 是重要的資訊，並提供給指令 CPYSPLF 使用。
下列是要擷取資料佇列 DTAQ(Data Queue) 報表資訊所需要使用的資料欄位範例：
* Data Queue Variables
D RcvQueueName S 10 Inz(‘AUTOSPLDTAQ’)
D RcvQueueLib S 10 Inz('*LIBL')
D RcvMsgSize S 5 0 Inz(%Size(RcvMsg))
D RcvMsg S 128
D RcvWaitTime S 5 0 Inz(-1)
下列是接收資料佇列 DTAQ(Data Queue) 報表資訊所使用的 RPGIV 運算：
C Call 'QRCVDTAQ'
C Parm RcvQueueName
C Parm RcvQueueLib
C Parm RcvMsgSize
C Parm RcvMsg
C Parm RcvWaitTime
欄位 RcvWaitTime 值為 -1，表示接收資料佇列 DTAQ(Data Queue) 報表資訊時，若資料佇列 DTAQ(Data Queue)
沒有報表資訊紀錄時，即一直等待至有資訊時才讀取，等待時並不會耗用系統資源。如果程式還要執行除了處理
資料佇列 DTAQ(Data Queue) 之外的其他工作時，RcvWaitTime 值也可以設定一個以秒為單位的值，以符合您的
需求。
當然這個程序也可以使用 CL 程式而不用 RPGIV 來開發，由於 RPGIV 的字串處理函數功能比 CL 好，所以我選擇
RPGIV。
接著要進行第二個步驟，也就是要使用指令 CPYSPLF 複製報表資料至資料庫檔案。
這個工作類似大部分系統管理人員所要做的，有時候系統管理人員需要拷貝報表資料給公司內部人員或廠商使用，
或將儲存報表資料並拷貝至磁帶後，再將報表及儲存報表的資料庫檔案刪除，才能釋放系統儲存空間，有需要使用
時再回複(restore)回系統。在這裡我想將報表分享給 PC 使用者，所以我將儲存報表的資料庫檔案拷貝至 IFS 的
一個目錄，並將該目錄分享出來，如同一般 PC 的網路磁碟機，PC 使用者可以透過網路磁碟機，直接讀取報表。
您可以使用 Client Access Operation Navigator 將在 IFS 下放置報表的目錄分享出來。
對我而言，RPGIV 處理字串的功能比 CL 好，所以我仍使用 RPGIV 來執行系統指令。我於 RPGIV 中使用系統所提
供的 QCMDEXC 程式來執行系統指令，
在呼叫 QCMDEXC 前需要定義所要使用的二個參數宣告：
D CmdStr S 512
D CmdLen S 15 5
接著呼叫 QCMDEXC 的傳統方式如下：
C Eval CmdStr = ‘WRKSPLF’
C Eval CmdLen = %Len(%Trim(CmdLine))
C Call 'QCMDEXC'
C Parm CmdLine
C Parm CmdLength
"CmdLine" 包含所要執行的指令，及 "CmdLength" 包含所要執行指令的長度。
另一種呼叫 QCMDEXC 的方式是如 C 語言藉由宣告外部函式，我較喜歡此種方式，因為可以使用 RPGIV 的錯誤偵測
功能，下列是宣告外部函式的例子：
D Cmd PR ExtPgm('QCMDEXC')
D 512 Options(*VarSize)
D Const
D 15 5 Const
我使用上述相同的 CmdStr 及 CmdLen 定義。
下列是使用外部函式呼叫 QCMDEXC 的範例：
C Eval CmdStr = 'WRKSPLF’
C Eval CmdLen = %Len(%Trim(CmdStr))
C CallP(E) Cmd(CmdStr:CmdLen)
C If %Error
* (error handling code here)
C EndIf
在 CallP(Call a Prototype Procedure or Program) 後指定一個 "E" 運算元延伸器，當 CallP 指令執行有錯誤時
，我能擷取錯誤並做適當的處理，這就如同 CLP 中的 MOMMSG(Monitor Message) 功能。您覺得哪一個比較好用？
複製報表資料至資料庫檔案包含二個步驟，首先，新增一個資料庫檔案用以存放報表資料，接著，複製報表資料至資
料庫檔案。我新增一個資料庫檔案於程式館 QTEMP 中，並給予該新增的資料庫檔案一個由時間產生的唯一的名稱，
該名稱您可依據自己的需求定義之，下列是我設定的資料庫檔案名稱的定義：
D TimeStamp S Z
D CharTimeStamp S 26
我以 CPY 開頭，後加上時間的微秒(microseconds) 部分當成資料庫檔案名稱，這確保有唯一的名稱，我使用 TIME
運算元，放置程式執行至 TIME 運算元的當時系統時間至 TimeStamp 變數中，然後使用內建函數 %CHAR 將 TimeStamp
值轉換成文字，接著使用內建函數 %SUBST 擷取微秒(microseconds)部分，然後新增一個命令字串如下：
CRTPF FILE(CPYxxxxxx) RCDLEN(200) SIZE(*NOMAX) IGCDTA(*YES) AUT(*ALL)
"xxxxxx" 表示時間的微秒(microseconds)部分，而 "200" 表是報表每行的最大長度，IGCDTA(*YES) 表可容納中文 DBCS。
* Create the file to receive CPYSPLF output in QTEMP.
C CrtFile BegSr
C Time TimeStamp
C Eval CharTimeStamp = %Char(TimeStamp)
C Eval CmdStr = 'CRTPF FILE(QTEMP/' +
C 'CPY' +
C %SubSt(CharTimeStamp:21:6) +
C ')' + ' ' + 'RCDLEN(200) +
C SIZE(*NOMAX) +
C IGCDTA(*YES) +
C AUT(*ALL)'
C Eval CmdLen = %Len(%Trim(CmdStr))
C CallP(E) Cmd(CmdStr:CmdLen)
* (error handling code here)
C EndSr
上述程式片斷新增一個唯一名稱的資料庫檔案於程式館 QTEMP 中。
下一個指令是複製報表資料至資料庫檔案，此時需要使用先前從資料佇列 DTAQ(Data Queue)中收到的資料 ，
當有有一份新的報表放置於輸出佇列Outq(Output Queue)中時，而且該報表的狀態是 Ready(RDY)，同時也有一
筆報表紀錄放置於資料佇列 DTAQ(Data Queue)中，而這筆記錄由程式讀入，並放置於一個資料結構中，資料結
構中的資訊可以用來擷取指定的報表，為了便於參照，這裡再將資料佇列 DTAQ(Data Queue)中報表相關資料的
資料格式列出：
D SpoolInfo DS
D Function 10
D RecordType 2
D QualJobName 26
D JobName 10 Overlay(QualJobName:1)
D JobUser 10 Overlay(QualJobName:11)
D JobNumber 6 Overlay(QualJobName:21)
D FileName 10
D FileNumber 9B 0
D QualQueueName 20
D QueueName 10 Overlay(QualQueueName:1)
D QueueLibrary 10 Overlay(QualQueueName:11)
D Filler 56
複製報表資料至資料庫檔案的指令如下：
CPYSPLF FILE(FILENAME) TOFILE(CPYxxxxxx) JOB(QUALJOBNAME) SPLNBR(FILENUMBER)
"FileName" 表從資料佇列 DTAQ(Data Queue) 所取得的報表名稱，
"CPYxxxxxx" 是前一步驟所新增的資料庫檔案名稱，
"QualJobName" 表從資料佇列 DTAQ(Data Queue) 所取得產生報表 Job，
"FileNumber" 表從資料佇列 DTAQ(Data Queue) 所取得的報表序號。
* Execute a CPYSPLF to file in QTEMP.
C CpyFile BegSr
C
C Eval ZoneNumber = FileNumber
C Move ZoneNumber CharNumber
C Eval CmdStr = 'CPYSPLF FILE(' +
C %Trim(FileName) +')' + ' ' +
C 'TOFILE(QTEMP/' +
C 'CPY' +
C %SubSt(CharTimeStamp:21:6) +
C ')' +
C ' ' + 'JOB(' +
C %Trim(JobNumber) + '/' +
C %Trim(JobUser) + '/' +
C %Trim(JobName) +
C ')' + ' ' +
C 'SPLNBR(' + CharNumber + ')'
C Eval CmdLen = %Len(%Trim(CmdStr))
C CallP(E) Cmd(CmdStr:CmdLen)
* (error handling code here)
C EndSr
上述程式片斷，複製報表資料至資料庫檔案。
在步驟一及步驟二已完成了擷取報表相關資訊及複製報表資料至資料庫檔案，接著步驟三要拷貝含有報表資料的
資料庫檔案至 IFS 分享目錄的 stream file，所謂的 stream file 是一個以位元(Byte)為單位的檔案，他是一
個連續性的檔案，而不是 AS/400(iSeries) 資料庫以欄位為基礎的紀錄格式(record format)檔案，stream file
並沒有欄位，而是像 PC 的純文字格式的檔案，所以是由程式來決定它的結構，stream file 使用於非資料庫結
構的資料，如影像檔，聲音檔，最重要的是文件檔。
使用指令
CPYTOSTMF(Copy to Stream File) 或 CPYTOIMPF(Copy to Import File)，拷貝資料庫檔案至 IFS 分享目錄的
stream file，其中 CPYTOIMPF 較適用於拷貝大量資料，下列是執行範例：
CPYTOSTMF FROMMBR('/QSYS.LIB/QTEMP.LIB/CPY123456.FILE/CPY123456.MBR')
TOSTMF('/spool/QSYSPRT-201134-0001.txt') STMFOPT(*REPLACE) STMFCODPAG(*PCASCII)
CPYTOSTMF FROMMBR('/QSYS.LIB/QTEMP.LIB/CPY123456.FILE/CPY123456.MBR')
TOSTMF('/spool/QSYSPRT-201134-0001.txt') STMFOPT(*REPLACE) STMFCODPAG(950)
CPYTOSTMF FROMMBR('/QSYS.LIB/QTEMP.LIB/CPY123456.FILE/CPY123456.MBR')
TOSTMF('/spool/QSYSPRT-201134-0001.txt') STMFOPT(*REPLACE)
CVTDTA(*AUTO) DBFCCSID(*FILE) STMFCODPAG(950)
參數 CVTDTA(*AUTO) 及 DBFCCSID(*FILE) 是預設值可以不用設，在此僅列出參考。
或
CPYTOIMPF FROMFILE(QTEMP/CPY123456) TOSTMF('/spool/QSYSPRT-201134-0001.txt') MBROPT(*REPLACE)
STMFCODPAG(*PCASCII) RCDDLM(*CRLF) STRDLM(*NONE)
CPYTOIMPF FROMFILE(QTEMP/CPY123456) TOSTMF('/spool/QSYSPRT-201134-0001.txt') MBROPT(*REPLACE)
STMFCODPAG(950) RCDDLM(*CRLF) STRDLM(*NONE)
上述 STMFCODPAG 指的是 PC 的字元頁碼，您可以特別指定 950 是中文 Big5 的字元頁碼，若使用 *PCASCII，
則系統會自行依照相關系統資訊運算出您的 PC 字元頁碼，這會花少許時間，不過使用者不會有延遲的感覺，我傾
像使用較明確的指定 PC 的字元頁碼，這樣較不會混淆。不過我於範例中使用 STMFCODPAG(*PCASCII)。
當轉換中文時，系統會自動將中文控制碼 0E 及 0F 裁掉，所以資料會往左靠，您將需要於轉換前作額外的處理，
如將加一個空白於 0E 前及 0F 後，下列詳細說明整個 0E 及 0F 的處理方式：
位置 .123456789012
原來資料 .0 0
.E中文F123
轉換後的資料 .中文123 ====> 資料會往左靠，造成有中文的報表格式位移
位置 .123456789012
.0 0
原來資料 .E中文F123
. 0 0
原來資料插入空白後 . E中文F 123 <==== 於 0E 前插入一個空白及 0F 後插入一個空白
轉換後的資料 . 中文 123 ====> 將中文控制碼 0E 及 0F 裁掉後，資料與原來資料格式一樣，
所以中文的報表格式正確
我在範例中使用 CPYTOSTMF 執行拷貝的動作，我仍然使用先前所定義的呼叫外部函式的方式如下：
宣告呼叫執行系統指令的系統外部函式：
D Cmd PR ExtPgm('QCMDEXC')
D 512 Options(*VarSize)
D Const
D 15 5 Const
宣告外部函式所要使用的參數定義：
D CmdStr S 512
D CmdLen S 15 5
* single quote 單引號
D Quote S 1 Inz(X'7D')
下列 SndFile 副程序是用於產生指令 CPYTOSTMF 及使用 QCMDEXC 執行指令：
C SndFile Begsr
* Send the spooled file output to the appropriate IFS directory.
C Eval CmdLine = 'CPYTOSTMF +
C FROMMBR(' + Quote +
C '/QSYS.LIB/QTEMP.LIB/' +
C 'CPY' +
C %SubSt(CharTimeStamp:21:6) +
C '.FILE' + '/' +
C 'CPY' +
C %SubSt(CharTimeStamp:21:6) +
C '.MBR' + Quote + ')' + ' ' +
C 'TOSTMF(' + Quote +
C '/spool' + ‘/’ +
C %Trim(FileName) + '_' +
C JobNumber + '_' +
C CharNumber +
C Quote + ')' + ' ' +
C 'STMFCODPAG(*PCASCII)' + ' ' +
C 'STMFOPT(*REPLACE)'
C Eval CmdLen = %Len(%Trim(CmdStr))
C CallP(E) Cmd(CmdStr:CmdLen)
* (error handling code here)
C EndSr
上述程式碼中參數 FROMMBR 指定 CPYSPLF 指令所輸出的資料庫檔案名稱，FROMMBR 參數所指定的格式
不同於 AS/400(iSeries)的傳統檔案格式，我雖指定 AS/400(iSeries) 的傳統檔案，但使用 IFS 的檔
案結構格式，檔名以 "/QSYS.LIB" 開頭表示指定 AS/400(iSeries) 的傳統檔案，接著下一層是
"/QTEMP.LIB"，最後加上以 "CPY" 加上時間的微秒部分組合成檔案名稱，且也需要指定檔案成員名稱。
一個於 AS/400(iSeries)的傳統(QSYS)檔案中的物件均需要以 ".LIB"，".FILE"，".MBR" 結尾，這是
CPYTOSTMF 指令及其他相關 IFS 整合性檔案系統的指令所必須的，就如同 PC 或 Unix 的目錄架構。
這個 TOSTMF(To Stream File) 參數是由一個目錄（在這個例子中是指定 "/spool"，但您也可以自行指定）
及報表名稱、Job Number、報表序號組成的檔名所組成。
這個 STMFCODPAG(Stream File Code Page) 有多個參數值，其中二個重要的參數值 *PCASCII 及 *STDASCII
，STDASCII 參數值是使用於 IBM PC 所使用的字元編碼，一般是使用 *PCASCII，所指的是一般 Windows 應
用軟體所使用的格式，而 STMFOPT (File Options) 參數是所拷貝的資料是要加入檔尾或覆蓋原有資料的選項
，並利用呼叫函式 QCMDEXC 執行 CPYTOSTMF 指令，拷貝資料庫檔案的報表內容至 IFS 的目錄中。
您可能也需要設定一個 AS/400 NetServer 的目錄分享，AS/400 NetServer 提供分享 IFS 目錄的功能，來讓
Windows PC 當成網路磁碟機，新增目錄分享只要執行一次，AS/400 會保留目錄分享直到刪除該目錄的分享設
定，此刪除動作並不會刪除該分享目錄的資料而僅刪除該目錄的分享設定。
設定 AS/400 NetServer 目錄分享，可以藉由 Operations Navigator 或 APIs 完成，有許多的 AS/400 NetServer
API 可供使用，底下列出部分 APIs 即其使用方法（附註：V5R2 已提供所有 NetServer API 工具於程式庫
QUSRTOOL 中 http://www-1.ibm.com/servers/eserver/iseries/netserver/qusrtool.htm）：
* 新增目錄分享 Add File Server Share (QZLSADFS)
CALL QZLSADFS PARM(ROOT '/' x'00000001' x'00000000' 'Root File System Share' x'00000002' x'ffffffff' x'00000000')
* 更改目錄分享 Change File Server Share (QZLSCHFS) 更改目錄分享
CALL QZLSCHFS PARM(ROOT '/' x'00000001' x'00000000' 'Root File System Share' x'00000002' x'ffffffff' x'00000000')
Add and change file server share.
ROOT - 分享名稱 share name
'/' - 分享路徑 path name
x'00000001' - 分享路徑長度 length of path name
x'00000000' - 路徑名稱的字元頁碼 CCSID encoding of path name (0 indicates same as job)
'Root File System Share' - 分享說明 text description
x'00000002' - 分享權限 permissions (2 指可讀寫 indicates r/w)
x'ffffffff' - 同時可以幾個人存取分響目錄 maximum users (-1 只不限制 indicates no max)
x'00000000' - used in error code structure
* Add Print Server Share (QZLSADPS)
CALL QZLSADPS PARM(OUTQ 'QPRINT QGPL ' 'default iSeries outq' x'00000001' 'IBM 4039 LaserPrinter' x'00000000')
* Change Print Server Share (QZLSCHPS)
CALL QZLSCHPS PARM(OUTQ 'QPRINT QGPL ' 'default iSeries outq' x'00000001' 'IBM 4039 LaserPrinter' x'00000000')
Add and change print server share.
OUTQ - share name
'QPRINT QGPL ' - qualified output queue (10 spaces needed for queue, and 10 for library)
'default iSeries outq' - text description
x'0000001' - spool file type (1 indicates *USERASCII, 2 *AFP, 3 *SCS)
'IBM 4039 LaserPrinter' - print driver type (indentifes appropriate print driver for share)
x'00000000' - used in error code structure
* Change Server Guest (QZLSCHSG)
CALL QZLSCHSG PARM(lowauth x'00000000')
lowauth - name of guest user profile
x'00000000' - used in error code structure
* Change Server Information (QZLSSCHSI)
CALL QZLSCHSI PARM(RequestVar x'00000112' ZLSS0100 x'00000000')
RequestVar - variable holding input data structure
x'00000112' - length of variable data
ZLSS0100 - format requested for change (ZLSS0100 indicates server information)
x'00000000' - used in error code structure
* 更改 NetServer 名稱 Change Server Name (QZLSCHSN)
CALL QZLSCHSN PARM(qas400 smbmania 'demo server' x'00000000')
qas400 - server name
smbmania - domain name
'demo server' - text description
x'00000000' - used in error code structure
* 停止NetServer End Server (QZLSENDS)
CALL QZLSENDS PARM(x'00000000')
* End Server Session (QZLSENSS)
CALL QZLSENSS PARM(bucky x'00000000')
bucky - workstation name
x'00000000' - used in error code structure
* List Server Information (QZLSLSTI)
CALL QZLSLSTI PARM('OUTDATA TEST ' ZLSL0100 *ALL x'00000000')
'OUTDATA TEST ' - name of user space to receive information (10 spaces needed for space name, 10 for library)
ZLSL0300 -format of data requested (ZLSL0100 indicates configuration information)
*ALL - information qualifier
x'00000000' - used in error code structure
* Open List of Server Information (QZLSOLST)
* 移除目錄分享設定 Remove Server Share (QZLSRMS)
CALL QZLSRMS PARM(OUTQ x'00000000')
OUTQ - share name
x'00000000' - used in lieu of error code structure
* 啟動NetServer Start Server (QZLSSTRS)
CALL QZLSSTRS PARM('0' x'00000000')
這個 QZLSADFS API 使用於設定目錄分享，底下是如何使用 QZLSADFS API 的範例：
* Call the create share API.
C CreateShare BegSr
C Call 'QZLSADFS'
C Parm ShrName
C Parm ShrPath
C Parm ShrPathLen
C Parm PathCcsid
C Parm ShrTextDesc
C Parm Permissions
C Parm ShrMaxUsrs
C Parm ErroeCode
C EndSr
"ShrName" 指的是 Windows 環境中所看到的目錄分享的名稱，"ShrPath" 指的是 IFS 所要分享的目錄
全名，"ShrTextDesc" 是目錄分享的說明，"ShrPathLen" 是分享目錄全名即 "ShrPath" 的長度，執行
這個副程序會指定一個 IFS 的目錄路徑分享，這允許 Windows 使用者從網路芳鄰看到此分享目錄的檔
案，並且可以存取分享目錄下的檔案。
有關 As/400(iSeries) NetServer 詳細資料請參照 http://www-1.ibm.com/servers/eserver/iseries/netserver/
在這篇文章中，我們提到從拷貝報表資料至資料庫檔案，再從資料庫檔案拷貝至 IFS 的分享目錄中，並
設定目錄分享，讓 Windows 使用者可以可以從網路磁碟機存取資料，藉由這些步驟，您能自行整合從
AS/400 的報表至 Windows PC 的文字檔，並將此流程自動化。我想留這個如何自動化的工作給您自行完
成，因為我知道您可以完成。 在此我僅給您一個間單的 Outq 監控的範例 MONOUTQC CLP 範例。
/* */
/* *********************************************************** */
/* * * */
/* * PROGRAM MONOUTQC * */
/* * * */
/* * By Vengoal Chang * */
/* * DATE 8/29/2002 * */
/* * * */
/* *********************************************************** */
/* */
/* */
/* MONOUTQC - READ DTAQ AND CONVERT SPOOL FILE */
/* */
/* This Program: */
/* - Wait up to 300 seconds to receive an entry from */
/* the data queue */
/* - If no entry read, it check if the program should end */
/* The program stop if: */
/* - Job was cancel with a ENDJOB command */
/* - Subsystem was stop ENDSBS command */
/* - System shut down PWRDWNSYS command */
/* - If the entry is "STOP" program stop immediately */
/* - Split the entry in fields */
/* - Call program CVTSSPL to do the spool file conversion */
/* - Move or Delete the spool file */
/* - Return wait for an entry */
/* */
/*-------------------------------------------------------------*/
/* */
/* PROGRAM CHANGES */
/* */
/* VERSION DATE PROGRAMMER DETAIL */
/* YY/MM/DD */
/* */
/* 1.0 02/08/29 Vengoal INITIAL VERSION */
/* */
/*-------------------------------------------------------------*/
PGM
DCL &DTAQNAME *CHAR 10 VALUE(CVTSDTAQ)
DCL &DTAQLIB *CHAR 10 VALUE(*LIBL)
DCL &ENTLEN *DEC 5 VALUE(128)
DCL &ENTRY *CHAR 128
DCL &WAIT *DEC 5 VALUE(300)
DCL &ENDSTS *CHAR 1
DCL &SPLFIL *CHAR 10
DCL &JOBNAM *CHAR 10
DCL &JOBUSR *CHAR 10
DCL &JOBNBR *CHAR 6
DCL &SPLNBRB *CHAR 4 /* BINARY */
DCL &SPLNBRD *DEC 6 /* DECIMAL */
DCL &SPLNBR *CHAR 6 /* CHARACTER */
DCL &OUTQN *CHAR 10
DCL &OUTQL *CHAR 10
DCL &USRDTA *CHAR 10
/* ----------------------------------------------------------------- */
/* RECEIVE AN ENTRY FROM THE DTAQ (FIRST IN FIRST OUT) */
/* ----------------------------------------------------------------- */
RCVDTAQ: CALL PGM(QRCVDTAQ) PARM(&DTAQNAME &DTAQLIB +
&ENTLEN &ENTRY &WAIT)
/* ----------------------------------------------------------------- */
/* CHECK IF AN ENTRY WAS RECEIVE OR TIMEOUT */
/* ----------------------------------------------------------------- */
IF COND(&ENTLEN *EQ 0) THEN(GOTO CMDLBL(TIMEOUT))
/* ----------------------------------------------------------------- */
/* CHECK IF THE ENTRY RECEIVE IS THE "STOP" COMMAND */
/* ----------------------------------------------------------------- */
IF COND(%SST(&ENTRY 1 4) *EQ 'STOP') THEN(GOTO +
CMDLBL(END))
/* ----------------------------------------------------------------- */
/* READ THE FIELD FROM THE RECEIVE ENTRY */
/* ----------------------------------------------------------------- */
CHGVAR &JOBNAM VALUE(%SST(&ENTRY 13 10))
CHGVAR &JOBUSR VALUE(%SST(&ENTRY 23 10))
CHGVAR &JOBNBR VALUE(%SST(&ENTRY 33 6))
CHGVAR &SPLFIL VALUE(%SST(&ENTRY 39 10))
CHGVAR &SPLNBRB VALUE(%SST(&ENTRY 49 4))
CHGVAR &SPLNBRD VALUE(%BIN(&SPLNBRB))
CHGVAR &SPLNBR &SPLNBRD
/* ----------------------------------------------------------------- */
/* CALL PROGRAM CVTSPL TO WORK WITH THE SPOOL */
/* 您需要依自己的需求自行撰寫 CVTSPL */
/* 於 CVTSPL 中可以 CPYSPLF Copy spooled file TO DB */
/* 並 CPYTOSTMF Copy to Stream File */
/* ----------------------------------------------------------------- */
CALL PGM(CVTSPL) PARM(&ENTRY &OUTQN &OUTQL +
&USRDTA)
/* ----------------------------------------------------------------- */
/* Move or Delete the spool file */
/* ----------------------------------------------------------------- */
IF COND(&OUTQN *EQ '*DELETE') THEN(DLTSPLF +
FILE(&SPLFIL) +
JOB(&JOBNBR/&JOBUSR/&JOBNAM) +
SPLNBR(&SPLNBR) SELECT(*ALL))
ELSE CMD(CHGSPLFA FILE(&SPLFIL) +
JOB(&JOBNBR/&JOBUSR/&JOBNAM) +
SPLNBR(&SPLNBR) SELECT(*ALL) +
OUTQ(&OUTQL/&OUTQN) USRDTA(&USRDTA))
/* ----------------------------------------------------------------- */
/* GO READ NEXT ENTRY IN THE DTAQ */
/* ----------------------------------------------------------------- */
GOTO CMDLBL(RCVDTAQ)
/* ----------------------------------------------------------------- */
/* TIME OUT (CHECK IF THE JOB MUST END) */
/* ----------------------------------------------------------------- */
TIMEOUT: RTVJOBA ENDSTS(&ENDSTS)
IF COND(&ENDSTS *EQ '1') THEN(GOTO CMDLBL(END))
ELSE CMD(GOTO CMDLBL(RCVDTAQ))
GOTO CMDLBL(RCVDTAQ)
/* ----------------------------------------------------------------- */
/* ERROR HANDLING */
/* */
/* ----------------------------------------------------------------- */
ERROR:
GOTO CMDLBL(RCVDTAQ)
END: ENDPGM
新增 OS/400 的目錄分享指令範例
使用範例：
分享 OS/400 CD Drive 給 Windows 使用者
ADDSHARE SHARENAME(AS400CD) PATHNAME('/QOPT') TEXTDESC('AS400 CD DRIVER')
-----------------------------------------------------------------------
CMD Creation
CRTCMD CMD(yourlib/ADDSHARE) PGM(yourlib/ADDSHARE) +
SRCFILE(yourlib/yourPFSourceFile) SRCMBR(ADDSHARECM)
-----------------------------------------------------------------------
ADDSHARECM.CMD Source
CMD
PARM KWD(SHARENAME) TYPE(*CHAR) LEN(12) +
CHOICE('New Share Name (MAX:12 chars)') +
PMTCTL(*PMTRQS) PROMPT('Share Name')
PARM KWD(PATHNAME) TYPE(*CHAR) LEN(20) +
CHOICE('First char must be slash U/U') +
PMTCTL(*PMTRQS) PROMPT('Share Path') /* +
'First char must be slash U/U' */
PARM KWD(TEXTDESC) TYPE(*CHAR) LEN(50) +
CHOICE('Share Comment') PMTCTL(*PMTRQS) +
PROMPT('Share comment') /* 'Share comment' */
PARM KWD(PERMS) TYPE(*CHAR) LEN(4) RTNVAL(*NO) +
RSTD(*YES) DFT(1) VALUES(1 2) +
CHOICE('Permissions (1: R/O, 2:R/W)') +
PMTCTL(*PMTRQS) PROMPT('Permissons') /* +
'1: READ/ONLY 2:READ/WRITE' */
PARM KWD(MAXUSERS) TYPE(*CHAR) LEN(4) RSTD(*NO) +
DFT(-1) RANGE(-1 255) CHOICE('Max users +
(-1 to 255,-1:NOMAX)') PMTCTL(*PMTRQS) +
PROMPT('Max users')
-----------------------------------------------------------------------
ADDSHARE.CLP Source
/*****************************************************************/
/* */
/* ADD WINDOWS SHARE FOR AS/400 */
/* 21.02.2002 MAB13 */
/*****************************************************************/
PGM PARM(&SHARENAME &PATHNAME &TEXTDESC &PERMS &MAXUSERS)
DCL VAR(&SHARENAME ) TYPE(*CHAR) LEN(12)
DCL VAR(&PATHNAME ) TYPE(*CHAR) LEN(20)
DCL VAR(&PATHNAMEL) TYPE(*CHAR) LEN(4)
DCL VAR(&CCSPATHN) TYPE(*CHAR) LEN(4)
DCL VAR(&TEXTDESC) TYPE(*CHAR) LEN(50)
DCL VAR(&PERMS) TYPE(*CHAR) LEN(4)
DCL VAR(&PERMSP) TYPE(*CHAR) LEN(4)
DCL VAR(&MAXUSERS) TYPE(*CHAR) LEN(4)
DCL VAR(&MAXUSERSP) TYPE(*CHAR) LEN(4)
DCL VAR(&ERRORCODE) TYPE(*CHAR) LEN(255)
DCL &LENGTH *DEC LEN(2) VALUE(20)
DCL &LENGTHC *CHAR LEN(4)
CHGVAR VAR(%BIN(&CCSPATHN)) VALUE(0)
CHGVAR VAR(%BIN(&MAXUSERSP)) VALUE(&MAXUSERS)
CHGVAR VAR(%BIN(&PERMSP)) VALUE(&PERMS)
LOOP:
IF (%SUBSTRING(&PATHNAME &LENGTH 1) *EQ ' ') (DO)
CHGVAR VAR(&LENGTH) VALUE(&LENGTH - 1)
IF (&LENGTH *EQ 0) GOTO CMDLBL(EXIT)
GOTO CMDLBL(LOOP)
ENDDO
CHGVAR VAR(&LENGTHC) VALUE(&LENGTH)
CHGVAR VAR(%BIN(&PATHNAMEL)) VALUE(&LENGTHC)
CALL PGM(QZLSADFS) +
PARM(&SHARENAME +
&PATHNAME +
&PATHNAMEL +
&CCSPATHN +
&TEXTDESC +
&PERMSP +
&MAXUSERS +
&ERRORCODE)
IF (&ERRORCODE *NE '*') +
SNDPGMMSG MSG('ERROR CODE:' *CAT &ERRORCODE)
ELSE SNDPGMMSG MSG('SHARED RESOURCES SUCCESSFULY ADDED')
EXIT:
ENDPGM
-----------------------------------------------------------------------
Add File Server Share (QZLSADFS) API Parameters
Required Parameter Group:
1 Share name Input CHAR(12)
2 Path name Input CHAR(*)
3 Length of path name Input BINARY(4)
4 CCSID encoding of path name Input BINARY(4)
5 Text description Input CHAR(50)
6 Permissions Input BINARY(4)
7 Maximum users Input BINARY(4)
8 Error code I/O CHAR(*)
-----------------------------------------------------------------------
API Error Messages
CPF3C1E E Required parameter &1 omitted.
CPF3C36 E Number of parameters, &1, entered for this API was not valid.
CPF3CF1 E Error code parameter not valid.
CPF3CF2 E Error(s) occurred during running of &1 API.
CPFA0D4 E File system error occurred.
CPFB682 E API &1 failed with reason code &2.
CPFB683 E Data conversion failed for API &1.
CPFB684 E User does not have the correct authority for API &1.
CPFB68A E Error occurred while working with shared resource &2.
CPFB68B E Character is not valid for value &3.
CPFB68D E Length specified in parameter &2 for API &1 not valid.
CPFB693 E Data conversion failed for &5 API.
CPIB685 E Error occurred on AS/400 Support for Windows Network Neighborhood (AS/400 NetServer) request.
更詳細資訊請參照手冊 OS/400 Printer Device Programming V4R4
http://publib.boulder.ibm.com/cgi-bin/bookmgr/books/qb3auj03/COVER
AS/400 印表機相關列印的手冊
http://www.printers.ibm.com/R5PSC.NSF/Web/4man
訂閱：
文章 (Atom)