|
midrange.com
yves jeanty wrote:
>
> NEED TO WRITE A CL PROGRAM THAT WILL COPY THE CONTENTS OF AN OUPUTQ
> THAN COMPARE ITS CONTENS TO A CERTAIN DATE IN ORDER TO DECIDE WETHER OR
> NOT TO DELETE. IS THERE A WAY TO GET THIS TASK ACOMPLISHED.
The following is from the OS/400 API appendix manual SC41-3881. There
is also a COBOL and ILE/C program which does the same thing in the
manual. Please, no need to panic and scream.
A.2.1.1 RPG DLTOLDSPLF Program
To delete old spooled files, use the following RPG program:
H*
***************************************************************
H*
***************************************************************
H*
*
H* MODULE: DLTOLDSPLF
*
H*
*
H* LANGUAGE: RPG
*
H*
*
H* FUNCTION: THIS APPLICATION WILL DELETE OLD SPOOLED FILES
*
H* FROM THE SYSTEM, BASED ON THE INPUT PARAMETERS.
*
H*
*
H* APIs USED:
*
H* QUSCRTUS -- Create User Space
*
H* QUSLSPLF -- List Spooled Files
*
H* QUSRTVUS -- Retrieve User Space
*
H* QUSRSPLA -- Retrieve Spooled File Attributes
*
H* QMHSNDPM -- Send Program Message
*
H* QUSDLTUS -- Delete User Space
*
H*
*
H*
***************************************************************
H*
***************************************************************
E/COPY QRPGSRC,EUSRSPLA
I 'NUMBER OF SPOOLED - C MSGTXT
I 'FILES DELETED: '
IMSGDTA DS
I 1 35 MSGDT1
I 36 400DLTCNT
ISTRUCT DS
I B 1 40USSIZE
I B 5 80GENLEN
I B 9 120RTVLEN
I B 13 160STRPOS
I B 17 200RCVLEN
I B 21 240SPLF#
I B 25 280MSGDLN
I B 29 320MSGQ#
I 33 38 FIL#
I 39 42 MSGKEY
I I 'DLTOLDSPLFQTEMP ' 43 62 USRSPC
I I '*REQUESTER ' 63 82 MSGQ
ITGTDAT DS
I 1 1 TGTCEN
I 2 3 TGTYR
I 4 5 TGTMTH
I 6 7 TGTDAY
I/COPY QRPGSRC,QUSGEN
I/COPY QRPGSRC,QUSLSPL
I/COPY QRPGSRC,QUSRSPLA
I*****************************************************************
I* The following is copied from QSYSINC/QRPGSRC member QUSEC
I* so that the variable length field QUSBNG can be defined
I* as 100 bytes for exception data. The defined field is
I* named EXCDTA.
I*****************************************************************
IQUSBN DS
I* Qus EC
I B 1 40QUSBNB
I* Bytes Provided
I B 5 80QUSBNC
I* Bytes Available
I 9 15 QUSBND
I* Exception Id
I 16 16 QUSBNF
I* Reserved
I* 17 17 QUSBNG
I* Varying length
I 17 116 EXCDTA
IDATSTR DS
I 1 1 DATCEN
I 202 203 DATYR
I 204 205 DATMTH
I 206 207 DATDAY
C*
***************************************************************
C*
***************************************************************
C*
*
C* EXECUTABLE CODE STARTS HERE
*
C*
*
C*
***************************************************************
C*
***************************************************************
C*
*
C *ENTRY PLIST
C PARM USRNAM 10
C PARM OUTQ 20
C PARM DLTDAT 7
C MOVE DLTDAT TGTDAT
C Z-ADD0 DLTCNT
C MOVE *BLANKS QUSBN
C Z-ADD0 QUSBNB
C*
*
C* CREATE A USER SPACE TO STORE THE LIST OF SPOOLED FILES.
*
C*
*
C CALL 'QUSCRTUS'
C PARM USRSPC
C PARM *BLANKS USEXAT 10
C PARM 1024 USSIZE
C PARM ' ' USINIT 1
C PARM '*CHANGE 'USAUTH 10
C PARM *BLANKS USTEXT 50
C PARM '*YES 'USREPL 10
C PARM QUSBN
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 'SPLF0100'FMTNM1 8
C PARM USRNAM
C PARM OUTQ
C PARM '*ALL 'FRMTYP 10
C PARM '*ALL 'USRDTA 10
C PARM QUSBN
C*
*
C* THE USER SPACE IS NOW FILLED WITH THE LIST OF SPOOLED FILES.
*
C* NOW USE THE QUSRTVUS API TO FIND THE NUMBER OF ENTRIES AND
*
C* THE OFFSET AND SIZE OF EACH ENTRY IN THE USER SPACE.
*
C*
*
C Z-ADD140 GENLEN
C Z-ADD1 STRPOS
C*
*
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM GENLEN
C PARM QUSBP
C PARM QUSBN
C*
*
C* CHECK THE GENERIC HEADER DATA STRUCTURE FOR NUMBER OF LIST
*
C* ENTRIES, OFFSET TO LIST ENTRIES, AND SIZE OF EACH LIST ENTRY.
*
C*
*
C Z-ADDQUSBPQ STRPOS
C ADD 1 STRPOS
C Z-ADDQUSBPT RTVLEN
C Z-ADD209 RCVLEN
C Z-ADD1 COUNT 150
C*
*
C*
***************************************************************
C*
***************************************************************
C*
*
C* BEGINNING OF LOOP (DO WHILE COUNT <= QUSBPS)
*
C*
*
C*
***************************************************************
C*
*
C COUNT DOWLEQUSBPS
C*
*
C* RETRIEVE THE INTERNAL JOB IDENTIFIER AND INTERNAL SPOOLED
FILE*
C* IDENTIFIER FROM THE ENTRY IN THE USER SPACE. THIS
INFORMATION*
C* WILL BE USED TO RETRIEVE THE ATTRIBUTES OF THE SPOOLED FILE.
*
C* THIS WILL BE DONE FOR EACH ENTRY IN THE USER SPACE.
*
C*
*
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM RTVLEN
C PARM QUSFT
C PARM QUSBN
C*
*
C* NOW RETRIEVE THE SPOOLED FILE ATTRIBUTES USING THE QUSRSPLA
*
C* API.
*
C*
*
C MOVE *BLANKS JOBINF
C MOVEL'*INT' JOBINF 26
C MOVE QUSFTH QUSFXD
C MOVE QUSFTJ QUSFXF
C MOVEL'*INT' SPLFNM 10
C MOVE *BLANKS SPLF#
C*
*
C CALL 'QUSRSPLA'
C PARM QUSFX
C PARM RCVLEN
C PARM 'SPLA0100'FMTNM2 8
C PARM JOBINF
C PARM QUSFXD
C PARM QUSFXF
C PARM SPLFNM
C PARM SPLF#
C PARM QUSBN
C*
*
C* CHECK QUSFX DATA STRUCTURE FOR DATE FILE OPENED.
*
C* DELETE SPOOLED FILES THAT ARE OLDER THAN THE TARGET DATE
*
C* SPECIFIED ON THE COMMAND. A MESSAGE IS SENT FOR EACH SPOOLED
*
C* FILE DELETED.
*
C*
*
C*
*
C MOVE QUSFX7 DATSTR
C DATYR IFLT TGTYR
C EXSR CLDLT
C ELSE
C DATYR IFEQ TGTYR
C DATMTH IFLT TGTMTH
C EXSR CLDLT
C ELSE NOT LT MTH
C DATMTH IFEQ TGTMTH
C DATDAY IFLE TGTDAY
C EXSR CLDLT
C END FOR LE DAY
C END FOR EQ MTH
C END FOR ELSE
MTH
C END FOR EQ YR
C END FOR ELSE YR
C*
*
C* GO BACK AND PROCESS THE REST OF THE ENTRIES IN THE USER
*
C* SPACE.
*
C QUSBPT ADD STRPOS STRPOS
C 1 ADD COUNT COUNT
C END
C* *************************************************************
*
C* *************************************************************
*
C*
*
C* END OF LOOP
*
C*
*
C* *************************************************************
*
C* *************************************************************
*
C*
*
C* AFTER ALL SPOOLED FILES HAVE BEEN DELETED THAT MET THE
*
C* REQUIREMENTS, SEND A FINAL MESSAGE TO THE USER.
*
C* DELETE THE USER SPACE OBJECT THAT WAS CREATED.
*
C*
*
C MOVELMSGTXT MSGDT1
C CALL 'QMHSNDM'
C PARM *BLANKS MSGID 7
C PARM *BLANKS MSGFIL 20
C PARM MSGDTA
C PARM 40 MSGDLN
C PARM '*INFO 'MSGTYP 10
C PARM MSGQ
C PARM 1 MSGQ#
C PARM *BLANKS RPYMQ 10
C PARM MSGKEY
C PARM QUSBN
C*
*
C* DELETE THE USER SPACE OBJECT THAT WAS CREATED.
*
C*
*
C CALL 'QUSDLTUS'
C PARM USRSPC
C PARM QUSBN
C*
*
C*
*
C* *************************************************************
*
C* *************************************************************
*
C*
*
C* END OF PROGRAM
*
C*
*
C* *************************************************************
*
C RETRN
C*
C* *************************************************************
*
C*
*
C* CLDLT SUBROUTINE
*
C*
*
C* THIS SUBROUTINE CALLS A CL PROGRAM THAT WILL DELETE A SPOOLED
*
C* FILE AND SEND A MESSAGE THAT THE SPOOLED FILE WAS DELETED.
*
C*
*
C* *************************************************************
*
C*
*
C CLDLT BEGSR
C*
*
C* KEEP A COUNTER OF HOW MANY SPOOLED FILES ARE DELETED.
*
C*
*
C ADD 1 DLTCNT
C MOVE QUSFXL FIL#
C CALL 'CLDLT'
C PARM QUSFXK
C PARM QUSFXJ
C PARM QUSFXH
C PARM QUSFXG
C PARM FIL#
C PARM QUSFXM
C PARM QUSFXN
C ENDSR
To create the RPG program, specify the following:
CRTRPGPGM PGM(QGPL/DLTOLDSPLF) SRCFILE(QGPL/QRPGSRC)
A.2.2 CL Delete (CLDLT) Program
The DLTOLDSPLF program, written in OPM RPG/400, OPM COBOL/400, or ILE C
for OS/400, calls a CL program named CLDLT. The CLDLT program deletes
the
spooled files and the user space. The following is the CL source for
the
CLDLT program.
/*********************************************************************/
/*
*/
/* PROGRAM: CLDLT
*/
/*
*/
/* LANGUAGE: CL
*/
/*
*/
/* DESCRIPTION: THIS PROGRAM WILL DELETE A SPECIFIC SPOOLED FILE
*/
/* USING THE DLTSPLF COMMAND AND SEND A MESSAGE WHEN
*/
/* THE FILE IS DELETED.
*/
/*
*/
/*
*/
/*********************************************************************/
/*
*/
PGM (&FILNAM &JOBNUM &USRNAM &JOBNAM &FILNUM &FRMTYP &USRDTA)
/*
*/
/* *****************************************************************
*/
/*
*/
/* DECLARE SECTION
*/
/*
*/
/*********************************************************************/
/*
*/
DCL &FILNAM *CHAR 10
DCL &JOBNUM *CHAR 6
DCL &USRNAM *CHAR 10
DCL &JOBNAM *CHAR 10
DCL &FILNUM *CHAR 6
DCL &FRMTYP *CHAR 10
DCL &USRDTA *CHAR 10
MONMSG CPF0000
/*
*/
/*********************************************************************/
/*
*/
/* EXECUTABLE CODE
*/
/*
*/
/*********************************************************************/
/*
*/
DLTSPLF FILE(&FILNAM) +
JOB(&JOBNUM/&USRNAM/&JOBNAM) +
SPLNBR(&FILNUM) +
SELECT(&USRNAM *ALL &FRMTYP &USRDTA)
SNDPGMMSG MSG('Spooled file ' *CAT &FILNAM *CAT +
' number ' *CAT &FILNUM *CAT ' job ' +
*CAT &JOBNUM *CAT '/' +
*CAT &USRNAM *CAT '/' *CAT &JOBNAM *CAT +
' deleted.') +
TOUSR(*REQUESTER)
ENDPGM
To create the CL program, specify the following:
CRTCLPGM PGM(QGPL/CLDLT) SRCFILE(QGPL/QCLSRC)
--
Thank You.
Regards
Dave Mahadevan.. mailto:mahadevan@fuse.net
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This is the Midrange System Mailing List! To submit a new message, *
* send your mail to "MIDRANGE-L@midrange.com". To unsubscribe from *
* this list send email to MAJORDOMO@midrange.com and specify *
* 'unsubscribe MIDRANGE-L' in the body of your message. Questions *
* should be directed to the list owner / operator: david@midrange.com *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
