如何將 outq 中所有報表搬移至另一個 outq ?(Command MOVOUTQ with List Spooled Files (QUSLSPL) API)
File : QCLSRC
Member: MOVOUTQ
Type : CLP
Usage : CRTCLPGM MOVOUTQ TGTRLS(V5R4M0)
OS : V5R4 later
/* =============================================================== */
/* = Command MovOutQ CPP = */
/* = MovOutQ CLP = */
/* = Paramater notes: = */
/* = FromOutq: from outq = */
/* = ToOutq : to outq = */
/* = = */
/* = Only spooled file status RDY, SAV, HLD selected to move = */
/* =============================================================== */
/* = Date : 2013/07/02 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Pgm (&qfromoutq &qtooutq)
Dcl &qfromoutq *CHAR 20
Dcl &qtooutq *CHAR 20
Dcl &FROMLIB *CHAR 10
Dcl &FROMOUTQ *CHAR 10
Dcl &FROMQUAL *CHAR 20
Dcl &TOLIB *CHAR 10
Dcl &TOOUTQ *CHAR 10
Dcl &PDATA *PTR
Dcl &PGENERIC *PTR
Dcl &PUSRSPC *PTR
Dcl &SFJNAME *CHAR 10
Dcl &SFJUSER *CHAR 10
Dcl &SFJNBR *CHAR 6
Dcl &SFNAME *CHAR 10
Dcl &SFNBR *CHAR 4
Dcl &SFSTS *UINT 4
Dcl &USGENERIC *CHAR STG(*BASED) +
LEN(256) BASPTR(&PGENERIC)
Dcl &USDTAOFF *UINT 4
Dcl &USDTACNT *UINT 4
Dcl &USDTASIZ *UINT 4
Dcl &USDTAENT *CHAR STG(*BASED) +
LEN(256) BASPTR(&PDATA)
Dcl &CH4 *CHAR 4
Dcl &CH4A *CHAR 4
Dcl &CH4B *CHAR 4
Dcl &OFFSET *UINT 4
Dcl &OFFSET2 *UINT 4
Dcl &USRSPC *CHAR 20
Dcl &USRSPCL *CHAR 10 'QTEMP '
Dcl &USRSPCS *CHAR 10
Dcl &X *UINT 4 0
MonMsg CPF0000 *N GoTo Error
/* First ensure that variables are extracted correctly */
ChgVar &FromOutQ %SST(&qfromoutq 1 10)
ChgVar &FromLib %SST(&qfromoutq 11 10)
ChgVar &ToOutQ %SST(&qtooutq 1 10)
ChgVar &ToLib %SST(&qtooutq 11 10)
/* Resolve special values */
If (&ToOutQ *EQ '*FROMOUTQ') +
ChgVar &ToOutQ &FromOutQ
RtvObjD Obj(&FromLib/&FromOutQ) ObjType(*OUTQ) +
RtnLib(&FromLib)
RtvObjD Obj(&ToLib/&ToOutQ) ObjType(*OUTQ) +
RtnLib(&ToLib)
/* If both from and to are the same then issue an error */
If ((&FromLib *EQ &ToLib) *AND +
(&FRomOutQ *EQ &ToOutQ)) DO
SndPgmMsg MsgID(CPF9898) MsgF(QCPFMSG) +
MsgDta('FromOutQ could not same as +
ToOutQ') MsgType(*ESCAPE)
Return
EndDO
SndPgmMsg MsgID(CPF9898) MsgF(QCPFMSG) +
MsgDta('Retrieving output queue entries') +
ToPgmQ(*EXT) MsgType(*STATUS)
ChgVar &USRSPCS 'MOVOUTQSPC'
ChgVar &USRSPC (&USRSPCS *CAT &USRSPCL)
ChgVar &FROMQUAL (&FROMOUTQ *CAT &FROMLIB)
DltUsrSpc UsrSpc(&USRSPCL/&USRSPCS)
MonMsg CPF0000
Call QUSCRTUS (&USRSPC 'MOVOUTQ ' +
X'00000100' x'00' '*ALL ' 'User space +
for MOVOUTQ ')
Call QUSLSPL (&USRSPC 'SPLF0300' +
'*ALL ' &FROMQUAL '*ALL ' +
'*ALL ')
/* Get header information pointer */
Call QUSPTRUS (&USRSPC &PUSRSPC)
/* Generic Header is at offset x'6C'-decimal 108 */
ChgVar &PGENERIC &PUSRSPC
ChgVar &OFFSET %OFFSET(&PGENERIC)
ChgVar &OFFSET2 (&OFFSET + 108)
ChgVar %OFFSET(&PGENERIC) &OFFSET2
/* Get user data offset */
ChgVar &CH4 %SST(&USGENERIC 17 4)
ChgVar &USDTAOFF %BIN(&CH4)
/* Get user data size */
ChgVar &CH4 %SST(&USGENERIC 29 4)
ChgVar &USDTASIZ %BIN(&CH4)
/* Get number of entries for status message */
ChgVar &CH4 %SST(&USGENERIC 25 4)
ChgVar &USDTACNT %BIN(&CH4)
/* If no entries, then bypass processing */
If (&USDTACNT *EQ 0) +
Goto END
/* link to first data entry */
ChgVar &PDATA &PUSRSPC
ChgVar &OFFSET %OFFSET(&PDATA)
ChgVar &OFFSET2 (&OFFSET + &USDTAOFF)
ChgVar %OFFSET(&PDATA) &OFFSET2
ChgVar &X 1
ChgVar %BIN(&CH4A) &X
ChgVar %BIN(&CH4B) &USDTACNT
/* Process the list of entries on the usrspc */
LOOP:
ChgVar &SFJNAME %SST(&USDTAENT 1 10)
ChgVar &SFJUSER %SST(&USDTAENT 11 10)
ChgVar &SFJNBR %SST(&USDTAENT 21 6)
ChgVar &SFNAME %SST(&USDTAENT 27 10)
ChgVar &CH4 %SST(&USDTAENT 37 4)
ChgVar &SFNBR %BIN(&CH4)
ChgVar &CH4 %SST(&USDTAENT 41 4)
ChgVar &SFSTS %BIN(&CH4)
If (&SFSTS *EQ 1 *OR +
&SFSTS *EQ 4 *OR +
&SFSTS *EQ 6 ) Do
ChgSplFa File(&SFNAME) +
Job(&SFJNBR/&SFJUSER/&SFJNAME) +
SplNbr(&SFNBR) OutQ(&TOLIB/&TOOUTQ)
EndDo
Else Do
SndPgmMsg MsgID(CPF9898) MsgF(QCPFMSG) +
MsgDta('Spooled file' *BCAT +
&SFNAME *Bcat 'in job' *BCAT +
&SFJNBR *CAT '/' *CAT +
&SFJUSER *TCAT '/' *CAT +
&SFJNAME *BCAT 'in' *BCAT +
&FROMLIB *TCAT '/' *CAT +
&FROMOUTQ *BCAT +
'is not moved.') +
ToPgmQ(*EXT) MsgType(*STATUS)
EndDo
IF (&X *LT &USDTACNT) DO
ChgVar &OFFSET %OFFSET(&PDATA)
ChgVar &OFFSET2 (&OFFSET + &USDTASIZ)
ChgVar %OFFSET(&PDATA) &OFFSET2
ChgVar &X (&X + 1)
ChgVar %BIN(&CH4A) &X
Goto LOOP
EndDo
END:
DltUsrSpc UsrSpc(&USRSPCL/&USRSPCS)
Return:
Return
/*-- Error handling: -----------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: MOVOUTQ
Type : CMD
Usage : CRTCMD CMD(MOVOUTQ) PGM(MOVOUTQ)
/* =============================================================== */
/* = Command....... MovOutQ = */
/* = CPP........... MovOutQ CLP = */
/* = Description... Move output queue spooled files to another = */
/* = output queue = */
/* = = */
/* = CrtCmd Cmd( MovOutQ ) = */
/* = Pgm( MovOutQ ) = */
/* = SrcFile( YourSourceFile ) = */
/* =============================================================== */
/* = Date : 2013/07/02 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('Move Output Queue')
PARM KWD(FROMOUTQ) TYPE(FROM) PROMPT('From output +
queue')
PARM KWD(TOOUTQ) TYPE(TO) PROMPT('To output queue')
FROM: QUAL TYPE(*NAME) LEN(10) MIN(1)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) PROMPT('Library')
TO: QUAL TYPE(*NAME) LEN(10) DFT(*FROMOUTQ) +
SPCVAL((*FROMOUTQ))
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) PROMPT('Library')
參考資訊:
List Spooled Files (QUSLSPL) API
A blog about IBM i (AS/400), MQ and other things developers or Admins need to know.
星期四, 11月 09, 2023
2013-07-03 如何將 outq 中所有報表搬移至另一個 outq ?(Command MOVOUTQ with List Spooled Files (QUSLSPL) API)
訂閱:
張貼留言 (Atom)
沒有留言:
張貼留言