如何依照指定保留天數清除逾期的報表 ? (Command: PRGSPLF)
File : QRPGLESRC
Member: PRGSPLF
Type : RPGLE
Usage : CRTBNDRPG PRGSPLF
H**************************************************************
H*
H* FUNTION: THIS APPLICATION WILL DELETE OLD SPOOLED FILES
H* FROM THE SYSTEM, BASED ON THE INPUT PARAMETERS.
H*
H* API USED: QUSCRTUS CREATE USER SPACE
H* QUSLSPL GENERATE SPOOLED FILE LIST
H* QUSRTVUS RETRIEVE USER SPACE INFORMATION
H* QUSRSPLA RETRIEVE SPOOLED FILE ATR INFORMATION
H*
H DEBUG
D PrgSplf PR ExtPgm('PRGSPLF')
D nDaysOld 5U 0 OPTIONS(*NOPASS)
D szUsrPrf 10A OPTIONS(*NOPASS)
D szDltSav 4A OPTIONS(*NOPASS)
D szDltHld 4A OPTIONS(*NOPASS)
D PrgSplf PI
D nDaysOld 5U 0 OPTIONS(*NOPASS)
D szUsrPrf 10A OPTIONS(*NOPASS)
D szDltSav 4A OPTIONS(*NOPASS)
D szDltHld 4A OPTIONS(*NOPASS)
D RunCLCmd PR EXTPGM('QCMDEXC')
D CmdStr 512 CONST OPTIONS(*VARSIZE)
D CmdLen 15 5 CONST
D SndPgmMsg PR ExtPgm( 'QMHSNDPM' )
D MsgID 7
D QualMsgF 20
D MsgDta 256
D MsgDtaLen 10I 0
D EscMsgType 10
D CallStkEnt 10
D CallStkCnt 10I 0
D MsgKey 4
D Error 8
D RcvPgmMsg PR ExtPgm( 'QMHRCVPM' )
D MsgDta 256
D MsgDtaLen 10I 0
D MsgFormat 8
D CallStkEnt 10
D CallStkCnt 10I 0
D MsgType 10
D MsgKey 4
D MsgWait 10I 0
D MsgAction 10
D Error 8
* SndMsg Parameter declare
D QualMsgF DS
D MsgFName 10 Inz( 'QCPFMSG' )
D MsgFLib 10 Inz( 'QSYS' )
D MsgID s 7 inz('CPF9898')
D MsgDta S 256
D MsgType S 10 Inz( '*COMP')
D MsgDtaLen S 10I 0 Inz(512)
D CallStkEnt S 10 Inz( '*' )
D CallStkCnt S 10I 0 Inz( 2 )
D MsgKey S 4 Inz(*blanks)
D MsgError S 8 Inz( *AllX'00' )
* MSGTYPE ENT CallStkcnt Joblog End(line 24) X:message N: No Message
* INFO * 2 XX X
* COMP * 2 XX X
* INFO * 1 X N
* COMP * 1 X N
* INFO * 0 X N
* COMP * 0 X N
* STATUS * 2 Error Error
* STATUS * 1 N N
* STATUS * 0 N N
* RcvMsg Parameter declare
D MsgFormat s 8 inz('RCVM0100')
D RMsgType S 10 Inz( '*LAST')
D MsgWait s 10I 0 inz( 0 )
D MsgAction s 10 inz('*OLD')
D CurrMsgStk S 10I 0 inz( 0 )
* API Error data structure
DQUSEC DS
D QUSBPRV 10I 0 Inz(%size(QUSEC))
D QUSBAVL 10I 0
D QUSEI 7
D QUSERVED 1
D*MSGDTA 256
D*
*
* Parameter for Create User Space Begin
D USRSPC DS
D USNAME 1 10 INZ('USRSPC ')
D USLIB 11 20 INZ('QTEMP ')
*
D DS
D EXTATR 1 10 INZ('QUSLSPL ')
D USINIT 11 11 INZ(X'00')
D FMTNME 12 21 INZ('SPLF0100')
D FMTNM1 22 31 INZ('SPLA0100')
*
D DS
D USSIZE 10I 0 INZ(640000)
* Parameter for Create User Space End
* Retrive User Space Entry data
D RCVVAR DS
D OFFSET 1 4B 0
D NOENTR 9 12B 0
D LSTSIZ 13 16B 0
* Retrive User Space Spooled data
D RCVAR1 DS
D USRNM1 1 10
D OUTQNA 11 30
D USRDT1 31 40
D FRMTY1 41 50
D IJOBID 51 66
D ISPLID 67 82
* Spooled file Attributes parameter Begin
D RCVAR2 DS
D BYTRTN 1 4B 0
D BYTVAL 5 8B 0
D JOBID 9 24
D SPLFID 25 40
D JOBNAM 41 50
D USRNAM 51 60
D JOBNUM 61 66
D FILNAM 67 76
D FILNUM 77 80B 0
D FRMTYP 81 90
D USRDTA 91 100
D STATUS 101 110
D FILVAL 111 120
D HLDF 121 130
D SAVF 131 140
D TOTPAG 141 144B 0
D PAGWRT 145 148B 0
D STRPAG 149 152B 0
D ENDPAG 153 156B 0
D LASPAG 157 160B 0
D RESPRT 161 164B 0
D TOTCPY 165 168B 0
D CPYLFT 169 172B 0
D LPI 173 176B 0
D CPI 177 180B 0
D OUTPRI 181 182
D OUTQNM 183 192
D OUTQLB 193 202
D DATFOP 203 209
D DATCEN 203 203
D DATYR 204 205
D DATMTH 206 207
D DATDAY 208 209
D TIMFOP 210 215
D DEVFNA 216 225
D DEVFLB 226 235
D PGMOPF 236 245
D PGMOPL 246 255
D ACCCOD 256 270
D PRTTXT 271 300
D RCDLEN 301 304B 0
D MAXRCD 305 308B 0
D DEVCLS 309 318
D PRTTYP 319 328
D DOCNAM 329 340
D FLDNAM 341 404
D S36PRC 405 412
D PRTFID 413 422
D RPLUN 423 423
D RPLCHR 424 424
D PAGLEN 425 428B 0
D PAGWID 429 432B 0
D NUMSEP 433 436B 0
D OVRLIN 437 440B 0
D DBCSDA 441 450
D DBCSEC 451 460
D DBCSSO 461 470
D DBCSCR 471 480
D DBCSCI 481 484B 0
D GRAPHI 485 494
D CODPAG 495 504
D FORNAM 505 514
D FORLIB 515 524
D SRCDRW 525 528 0
D PRTFON 529 538
D S36SPL 539 544
D PAGROT 545 548B 0
D JUSTIF 549 552B 0
D PRTBOT 553 562
D FLDRCD 563 572
D CTLCHR 573 582
D ALGFRM 583 592
D PRTQUA 593 602
D FRMFED 603 612
D VOLUME 613 683
D FLABID 684 700
D EXCTYP 701 710
D CHRCOD 711 720
D TOTRCD 721 724B 0
D PGPSID 725 728B 0
D FOVNAM 729 738
D FOVLIB 739 748
D FOVOFD 749 756P 5
D FOVOFA 757 764P 5
D BOVNAM 765 774
D BOVLIB 775 784
D BOVOFD 785 792P 5
D BOVOFA 793 800P 5
D UOM 801 810
D PAGNAM 811 820
D PAGLIB 821 830
D LINSPC 831 840
D PNTSIZ 841 848P 5
* Spooled file Attributes parameter End
* Retrive User Space Parameter Begin
D DS
D LENDTA 1 4B 0
D STRPOS 5 8B 0
D SPLF# 9 12B 0
D RCVLE1 13 16B 0
D FIL# 17 22
D RCVLE2 23 26B 0
* Retrive User Space Parameter End
* Work area variable
D WRKSTR S 100
D UsrId S 10
D RcvMsgId S 7
** How long before we delete the SPLF?
D DFTExpired C Const(14)
D dltSav S 4A
D dltHld S 4A
D szUser S 10A Inz(*USER)
D today S D Inz(*SYS)
D crtDate S D DatFmt(*ISO)
D nExpired S 10I 0
D nDays S 10I 0
*
*
C*********************************************************
C*
C* OPERABLE CODE STARTS HERE
C*
C*********************************************************
C*
C Eval *InLR = *On
** If the caller passed in the number of days-old to delete,
** use that value, other use the default of 14 days.
C if %Parms >= 1
C eval nExpired = nDaysOld
C else
C eval nExpired = DFTExpired
C endif
** If the caller passed in a specific user profile,
** use that profile, otherwise use the default *CURRENT.
C if %Parms >= 2
C if szUsrPrf <> *BLANKS
C and %subst(szUsrPrf:1:1) <> '*C'
C eval szUser = szUsrPrf
C endif
C endif
C if %Parms >= 3
C if szDltSav <> *BLANKS
C eval dltSav = szDltSav
C else
C eval dltSav = '*NO'
C endif
C endif
C if %Parms >= 4
C if szDltHld <> *BLANKS
C eval dltHld = szDltHld
C else
C eval dltHld = '*NO'
C endif
C endif
C Z-ADD 0 DLTCNT 10 0
C*
C* CREATE USER SPACE USING TE PARAMETERS FROM THE CL COMMAND
C*
C Z-ADD 16 QUSBPRV
*
C CALL 'QUSCRTUS'
C PARM USRSPC
C PARM EXTATR
C PARM USSIZE
C PARM USINIT
C PARM '*ALL' USAUTH 10 AUTHORITY
C PARM *BLANKS USTEXT 50
C PARM '*YES' USRPLC 10 REPLACE
C PARM QUSEC
*
C*
C* FILL THE USER SPACE JUST CREATED WITH SPOOLED FILES AS
C* DEFINED IN THE CL COMMAND
C*
C CALL 'QUSLSPL'
C PARM USRSPC
C PARM FMTNME
C PARM szUser USRNME 10
C PARM '*ALL' OUTQ 20
C PARM '*ALL' FRMTYP 10
C PARM '*ALL' USRDTA 10
C******************************************************
C*
C* BEGINNING OF LOOP
C*
C******************************************************
C*
C* YOU CAN USE QUSRTVUS API RETRIEVE USER SPACE ENTRY DATA
C*
C*****************************************************
C*
C Z-ADD 16 LENDTA
C Z-ADD 125 STRPOS
C*
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM LENDTA
C PARM RCVVAR
C*
C* CHECK RCVVAR DATA STRUCTURE FOR NUMBER OF LIST ENTRIES,OFFSET
C* TO LIST ENTRIES, AND SIZE OF EAC LIST ENTRY.
C* INFORMATION NEEDED FOR TE QUSLSPL API IS CONTAINED WITHIN
C* THE 164 BYTES OF FORMAT SPLF0100 LIST DATA SECTION
C*
C Z-ADD OFFSET STRPOS
C ADD 1 STRPOS
C Z-ADD LSTSIZ LENDTA
C Z-ADD 164 RCVLE1
C Z-ADD 209 RCVLE2
C Z-ADD 1 COUNT 15 0
C eval MsgDta = 'Total processing spooled files:' +
C %char(NOENTR)
C eval MsgType = '*INFO'
C ExSr SndMsg
C COUNT DOWLE NOENTR
C*
C* RETRIEVE THE INFORMATION FROM THE USER SPACE ABOUT THE SPOOLED
C* FILE.
C*
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM LENDTA
C PARM RCVAR1
C*
C* NOW RETRIVE SPOOLED ATR USING THE INFORMATION IN THE
C* USER SPACE , WHICH WAS RETRIVED BEFORE THIS COMMENT.
C*
C MOVE IJOBID JOBID
C MOVE ISPLID SPLFID
C MOVE *BLANKS JOBINF
C MOVEL '*INT' SPLFNM 10
C MOVE *BLANKS SPLF#
C MOVEL '*INT' JOBINF 26
C*
C Reset QUSEC
C CALL 'QUSRSPLA'
C PARM RCVAR2
C PARM RCVLE2
C PARM FMTNM1
C PARM JOBINF
C PARM JOBID
C PARM SPLFID
C PARM SPLFNM
C PARM SPLF#
C PARM QUSEC
* Call API No Error
C If QUSBAVL = 0
C* CHECK RCVAR1 DATA STRUCTURE FOR DATA FILE OPENED.
C*
C* DELETE SPOOLED FILE THAT ARE OLDER THAN THE TARGET DATE
C* SPECIFIED ON THE COMMAND. A MESSAGE IS SENT FOR EACH SPOOLED
C* FILE DELETED.
C*
C *CYMD0 TEST(DE) DATFOP
C If NOT %ERROR
C *CYMD0 MOVE DATFOP CrtDate
C Today SubDur CrtDate nDays:*DAYS
C If nDays >= nExpired
C If Status = '*READY'
C Or ( Status = '*SAVED'
C And dltSav ='*YES' )
C Or ( Status = '*HELD'
C And dltHld ='*YES' )
C EXSR SPLDLT
C EndIf
C EndIf
C EndIf
C EndIf
C*
C* GO BACK AND PROCESS THE REST OF ENTRIES IN THE USER SPACE
C*
C ADD LSTSIZ STRPOS
C ADD 1 COUNT
C ENDDO
C******************************************
C* END LOOP
C******************************************
C*
C* AFTER ALL SPOOLED FILES ARE DELETED THAT MEET THE REQUIREMENTS
C* , SEND A FINAL MESSAGE TO THE USER .
C* DELETE THE USER SPACE OBJECT THAT WAS CREATED.
C*
C Move DltCnt DltCntC 10
C Eval MsgDta = %Char(DltCnt) +
C ' spooled files deleted ' +
C 'completely'
C eval MsgType = '*COMP'
C Exsr SndMsg
C******************************************
C SPLDLT BegSr
C Add 1 DLTCNT
C Move FILNUM FIL#
*
C clear WrkStr
C Eval WRKSTR =
C 'DltSplF ' + %Trim( FILNAM ) +
C ' ' +
C 'Job(' + %Trim( JOBNUM ) +
C '/' + %Trim( USRNAM ) +
C '/' + %Trim( JOBNAM ) +
C ') ' +
C 'SplNbr(' + %Trim( FIL# ) +
C ') '
*
C CallP(e) RunCLCmd(WRKSTR : %size(wrkstr))
C EndSr
* -------------------------------------------------------------
* - Subroutine.... SndMsg -
* - Description... Send escape message when error is found -
* -------------------------------------------------------------
C SndMsg BegSr
C Eval MsgDtaLen = %Size( MsgDta )
C CallP SndPgmMsg( MsgID :
C QualMsgF :
C MsgDta :
C MsgDtaLen :
C MsgType :
C CallStkEnt :
C CallStkCnt :
C MsgKey :
C MsgError )
C EndSr
* -------------------------------------------------------------
* - Subroutine.... RcvMsg -
* - Description... Receive Program message -
* -------------------------------------------------------------
C RcvMsg BegSr
C CallP RcvPgmMsg( MsgDta :
C MsgDtaLen :
C MsgFormat :
C CallStkEnt :
C CurrMsgStk :
C RMsgType :
C MsgKey :
C MsgWait :
C MsgAction :
C MsgError )
* Retrieve Message ID
C Eval RcvMsgId= %subst(MsgDta : 13 : 7 )
C EndSr
*---------------------------------------------------------------------
C ExitOnErr BegSr
*---------------------------------------------------------------------
C Eval *InLR = *On
C Eval RcvMsgId = *blanks
C Exsr RcvMsg
C Clear MsgDta
C Eval MsgDta = 'Error Message ID: ' +
C RcvMsgId +
C ', Please see Joblog for detail'
C Exsr SndMsg
C Return
C EndSr
File : QCMDSRC
Member: PRGSPLF
Type : CMD
Usage : CRTCMD CMD(PRGSPLF) PGM(PRGSPLF)
/* =============================================================== */
/* = Command....... PrgSplf = */
/* = Source type... CMD = */
/* = Description... Purge spooled files = */
/* = = */
/* = CPP........... PrgSplf = */
/* = = */
/* =============================================================== */
/* = Date : 2007/09/21 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
PRGSPLF: CMD PROMPT('Purge Spooled Files')
/* Command processing program is: PRGSPLF */
PARM KWD(DAYS) TYPE(*UINT2) DFT(14) EXPR(*YES) +
PROMPT('Number of days to keep')
PARM KWD(USRPRF) TYPE(*NAME) LEN(10) +
DFT(*CURRENT) SPCVAL((*CURRENT) (*ALL)) +
EXPR(*YES) PROMPT('User profile')
PARM KWD(DLTSAV) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*YES *NO) PROMPT('Delete +
saved spool')
PARM KWD(DLTHLD) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*YES *NO) PROMPT('Delete +
held spool')
File : QCLSRC
Member: PRGSPLFC
Type : CLP
Usage : CRTCLPGM PRGSPLFC
此測試程式會將系統中超過 60 天的逾期報表(包含報表狀態為 RDY, SAV, HLD)清除
CALL PRGSPLFC
當然也可以直接使用
SBMJOB CMD(PRGSPLF DAYS(60) USRPRF(*ALL) DLTSAV(*YES) DLTHLD(*YES)) JOB(PRGSPLF)
不過執行時間會因系統報表多寡而有所不同
PGM
DCLF FILE(QADSPOBJ)
DSPOBJD OBJ(*ALL) OBJTYPE(*USRPRF) OUTPUT(*OUTFILE) +
OUTFILE(QTEMP/USRPRFOBJ)
OVRDBF FILE(QADSPOBJ) TOFILE(QTEMP/USRPRFOBJ)
READ:
RCVF
MONMSG CPF0864 EXEC(GOTO END)
/* IF (%SST(&ODOBNM 1 1) *EQ 'Q') GOTO READ */
SBMJOB CMD(PRGSPLF DAYS(60) USRPRF(&ODOBNM) +
DLTSAV(*YES) DLTHLD(*YES)) JOB(&ODOBNM)
GOTO READ
END:
DLTOVR FILE(QADSPOBJ)
RETURN
ENDPGM
星期三, 11月 08, 2023
2007-09-28 如何依照指定保留天數清除逾期的報表 ? (Command: PRGSPLF)
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言