Wednesday, May 28, 2008

Free RPG i5 (AS400) Utility - Where is an Object / File Used - Cross Reference

This tool will display a list of objects (programs) that refer to a selected object (file or other program). It utilizes the DSPPGMREF command to build a semi-permanant file and then queries that file VIA SQL commands. This is handy for making changes to database files and performing a cross reference of the programs that refer to it for re-compiling

http://www.freerpgtools.com/downloads/whereisit.html

Free RPG i5 (AS400) Utility - Print Unmatched Source & Objects

Print a list of objects with no matching iSeries(AS400) source. All objects that the associated iSeres(AS400) source cannot be located will be included

http://www.freerpgtools.com/downloads/unmatch.html

Free RPG i5 (AS400) Utility - Message Processing Program

Send messages from a monitored message queue to ALL workstations that a user is signed on to

http://www.freerpgtools.com/downloads/stsmsg.html

Free RPG/i5 (AS400) Utility - CL program to run sql statment

This tool will run any valid SQL statement. It does not require that SQL/400 be installed on your iSeries(AS400) machine. It can optionally allow the output to be displayed, printed, or sent to a physical file

http://www.freerpgtools.com/downloads/sql.html

Free RPG i5 (AS400) Utility - Set Current ILE Debugger Mode

Set current ILE debugger mode. This includes the ability to set the number of colums displayed to 132

http://www.freerpgtools.com/downloads/setdbg.html

Free RPG/i5 (AS400) Utility - Scan a Variable for Text

SCAN will look through a variable for a text value. This is similar to the RPGLE BIF %Scan function, but can be used in CL

http://www.freerpgtools.com/downloads/scan.html

Free RPG i5 (AS400) Utility - Retrieve User Space Initialization

The RTVUSPI command is not really meant to be much of a standalone program. It is meant to be used along with many other tools. It uses the QUSRTVUS api to retrieve the initial values of user spaces

http://www.freerpgtools.com/downloads/rtvuspi.html

Free RPG/i5 (AS400) Utility - Retrieve Previous Command

The RTVPRVCMD utility will pull the last command that was entered from the jobs joblog. It uses the QMHRTVRQ api get the last entry

http://www.freerpgtools.com/downloads/rtvprvcmd.html

Free RPG i5 (AS400) Utility - Retrieve Current Program Name

The Retrieve Current Program Name uses the QWVRCSTK api to retrieve the name of the currently running program. This is essentially meant to be used in CL, since the current program name is easily retrieved in RPG

http://www.freerpgtools.com/downloads/rtvcurpgm.html

Free RPG i5 (AS400) Utility - Remove Object Regardless of type

This tool will delete any as400 object regardless of what type of object it is. It will automatically determine which program to use to delete the object for you. This could be very dangerous so be very carefull when using this command

http://www.freerpgtools.com/downloads/rmvobj.html

Free RPG/i5 (AS400) Utility - Display Number of Records in a File

This is a simple CL program that uses a display file to display the number of records in a file. It also displays the file size information and gives you the ability to perform other operations on the file

http://www.freerpgtools.com/downloads/records.html

Free RPG/i5 (AS400) Utility - Rebuild Physical & Attached Logicals

This tools will re-build the specified physical file and all the attached access paths. It will use the source file/member associated with the object or the object/member that is specified on the command when it is called. The command is desined to preserve the existing data in the database file as well

http://www.freerpgtools.com/downloads/rbldfil.html

Free RPG/i5 (AS400) Utility - Print AS/Set Action Diagram

Print/Display AS/Set Action Diagram indented. AS/Set is a CASE tool that comes with BPCS and is sold by SSA

http://www.freerpgtools.com/downloads/prtad.html

Free RPG/i5 (AS400) Utility - Display Popup Message

This will display a two line message window on the screen. This can be called as a command or as a procedure from an ILE program

http://www.freerpgtools.com/downloads/popmsg.html

Free RPG/i5 (AS400) Utility - Create New Library with Source Files

This command will create/replace a library with the standard iSeries(AS400) source files

http://www.freerpgtools.com/downloads/newlib.html

Free RPG/i5 (AS400) Utility - Monitor Message Queue - Users

This Command will monitor a specific message queue and forward all messages sent to that queue to a list of users

http://www.freerpgtools.com/downloads/monmsgq.html

Free RPG/i5 (AS400) Utility - List Librarys on System

This command will generate a list of libraries to an output file based on a generic parameter

http://www.freerpgtools.com/downloads/lstlibs.html

Free RPG/i5 (AS400) Utility - Stop/Start Journaling for a File

This cmd will automatically create the journal/receiver for a file. Because the must not be in use, it will retry itself every 10 minutes

http://www.freerpgtools.com/downloads/jrnlpf.html

Free RPG/i5 (AS400) Utility - Indent CL Program

This will display/print any RPG or CL program in an indented format. It uses utilizes SEU to handle the display of the code. This will work with ILE or Non-ILE Programs, but not with Free-Format RPG

http://www.freerpgtools.com/downloads/indent.html

Free RPG/i5 (AS400) Utility - Get System Value

This command utilizes the QWCRSVAL API. This is a procedure to get an iSeries(AS400) system value. It will retrieve any system value into your RPG ILE program

http://www.freerpgtools.com/downloads/getsysval.html

Free RPG/i5 (AS400) Utility - Get Program Information

Retrieve program object information. This command utilizes the QCLRPGMI API. There are many parameters that this command retruns that are not otherwise available from standard iSeries(AS400) commands

http://www.freerpgtools.com/downloads/getpgmi.html

Free RPG/i5 (AS400) Utility - Get Current Users Password

This command will prompt the user to enter their password and pass it back to your program in a variable

http://www.freerpgtools.com/downloads/getpass.html

Free RPG/i5 (AS400) Utility - Get Output Queue Description

This tool uses the QUSRSPLA api to retrieve varrious pieces of information about the spool files in an output queue. This list is placed in a database file that can be used by other iSeries(AS400) programs

http://www.freerpgtools.com/downloads/getoutqd.html

Free RPG i5 (AS400) Utility - Get Object Description RPG Program

This tool utilizies the QUSROBJD api to retrieve the common object attributes. It is similar in function to the RTVOBJD command. The primary purpose of this tool is to allow a simpler interface into an rpg program

http://www.freerpgtools.com/downloads/getobjd.html

Tuesday, May 27, 2008

Free RPG/i5 (AS400) Utility - Get Member Text

This utility uses the QUSRMBRD API to retrieve the member text. It is an example of how to use it a procedure to call an API

http://www.freerpgtools.com/downloads/getmbrtxt.html

Free RPG i5 (AS400) Utility - Get a Job Description

The Get Job Description command will retrieve varrious values from a given job description. It is designed to return these values to a program. It also makes use of the GETSYSVALR IST tool. This tool uses the QWDRJOBD api.

http://www.freerpgtools.com/downloads/getjobd.html

Free RPG/i5 (AS400) Utility - Get File Information

Prompt User for a File & member. The primary purpose of this tool is to act as an example/shortcut for prompting a user for a file name & member and then passing them back to a program

http://www.freerpgtools.com/downloads/getfile.html

Free RPG/i5 (AS400) Utility - Display Database Relations

Display Database Relations. This tool uses system APIs to display a list of access paths related to a physical file. The primary api used by this tool is QDBLDBR

http://www.freerpgtools.com/downloads/getdbr.html

Free RPG/i5 (AS400) Utility Download - File Transfer Support

Transfer file members between systems without using SNADS. This command uses the built in API (QY2FTML) to transfer source members between iSeries/i5 (AS400) machines

http://www.freerpgtools.com/downloads/fts.html

Free RPG i5 (AS400) Utility - Send/Receive Files VIA FTP

Send/Receive a file VIA FTP. This tool will prompt you for the necessary file & server information. It will then automatically generate the FTP script needed and send the file to the specified server

http://www.freerpgtools.com/downloads/ftpfile.html

Free RPG i5 (AS400) Utility - Edit Source Member

Edit Source Records. This tool works similar to the WRTSRC taatool command. It allows you to write/edit a source member via a program. This is very handy when you need to make a program more dynamic by actually writing the source on the fly with variable parameters

http://www.freerpgtools.com/downloads/edtsrc.html

Free RPG i5 (AS400) Utility - Display User Space

This tool will display a user space in a format that will allow to detrmine where the data is contained within it. It uses the QUSRTVUS api and displays the data into a generic subfile. This tool goes hand in hand with the CRTUSP (Create User Space) command

http://www.freerpgtools.com/downloads/dspusrspc.html

Free RPG i5 (AS400) Utility - Delete Records x Relative Record Number

Delete records from a file using relitive record numbers. This tool uses RPG to remove records from a database file VIA relative record number. You can specify the starting and ending record number

http://www.freerpgtools.com/downloads/dltrrn.html

Free RPG i5 (AS400) Utility - Delete Object and Source Member

Delete Object and Source Member. This tool will remove both the source and the object from the library specified

http://www.freerpgtools.com/downloads/dltobjsrc.html

Free RPG i5 (AS400) Utility - Convert Spool File to HTML or PDF

Free RPG i5 (AS400) Utility - Convert Spool File to HTML or PDF


Convert an iSeries/i5 (AS400) spool file to an HTML or PDF document. This will place the PDF or HTML document on a directory in the IFS on your iSeries/i5 (AS400) machine. This is taken from existing specs on existing PDF and HTML conversions

http://www.freerpgtools.com/downloads/cvtsplf.html

Update: Since V6R1 you can now generate PDFs from spool files natively, see the IProDeveloper article below

http://www.iprodeveloper.com/article/systems-management/generate-pdf-files-using-only-i-61-63062

Free RPG i5 (AS400) Utility - Convert Spool File to HTML or PDF

Monday, May 26, 2008

Free RPG i5 (AS400) Utility - Convert a Fields Contents to Hex

Convert a Field's Contents to Hex The Convert to Hex command converts a value to it's hex equivalent. The CPP many also be directly used

http://www.freerpgtools.com/downloads/cvthex.html

Free RPG i5 (AS400) Utility - Convert BPCS Menus to Custom Menus

Convert BPCS File menu system to the iSeries Custom Menu System - http://www.iseriescms.com. This will work with BPCS V6.0 and higher

http://www.freerpgtools.com/downloads/cvtbpcs.html

Free RPG/i5 (AS400) Utility - Create User Space

Create User Space. This tool uses the QUSCRTUS and QUSCUSAT APIs. It is used in many of the Free iSeries/i5 (AS400) tools and should be considerd an essential tool for anyone's toolkit. This it truly a tool that IBM forgot

http://www.freerpgtools.com/downloads/crtusp.html

Free RPG i5 (AS400) Utility - Compare message Files

Compare Two as400 Message Files. This tool will compare the messages in two message files using the SQL Free iSeries/i5 (AS400) Tool command

http://www.freerpgtools.com/downloads/cmpmsgf.html

Free RPG i5 (AS400) Utility - Clear All Members in a File

The as400 file specified will have all it's existing members cleared

http://www.freerpgtools.com/downloads/clrmbrs.html

Free RPG/i5 (AS400) Utility - Clean up QPADEV* Devices

Cleanup unused as000 QPADEV* devices. This command will automatically remove all devices (Display) on your iSeries(AS400) machine that start with QPAD and are able to be removed (not active)

http://www.freerpgtools.com/downloads/cleanqpa.html

AS400 utilities

Free RPG i5 (AS400) Utility - Calculate Dates

Calculate dates on the AS400 using RPG IV date fields. This is useful in determining the effect of different calculations on date fields. It will prompt you to enter a date and allow you to try different scenarios and see the results

http://www.freerpgtools.com/downloads/calcdate.html

AS400 Utilities

Free i5 (AS400) RPG Utility - Change Current User

Change Current AS400 User

This will allow you to change the current user that you are logged on with without logging off the system first. This command uses the QSYGETPH API to verify the password entered and then uses the QWTSETP API to actually change the user that is currently signed on. This is very useful in making sure that a peticular program is always run as a certain user

http://www.freerpgtools.com/downloads/chgcurusr.html


as400 tips

Monday, May 19, 2008

API Example - Deleting Old Spooled Files

Deleting Old Spooled Files

The following application program runs using the Delete Old Spooled Files (DLTOLDSPLF) command. This example has three major parts:

The DLTOLDSPLF command calls the delete old spooled files (DLTOLDSPLF) program in one of the following languages:
OPM RPG
OPM COBOL
ILE C

The DLTOLDSPLF program is supplied in OPM RPG, OPM COBOL, and ILE C. It does the following:
Creates a user space (QUSCRTUS API).
Generates a list of spooled files (QUSLSPL API).
Retrieves information from a user space using one of the following:
QUSRTVUS API
QUSPTRUS API
Retrieves more spooled file attribute information received from the user space (QUSRSPLA API).
Calls the CLDLT program to delete the spooled files.
Sends a message to the user (QMHSNDM API).
Deletes the user space (QUSDLTUS API).

The CL delete (CLDLT) program does the following:
Deletes the specified spooled files (DLTSPLF command).
Sends a message if the spooled file was deleted (SNDPGMMSG command).
DLTOLDSPLF Command Source

The command source for the DLTOLDSPLF command follows:

/****************************************************************/
/* */
/* CMD: DLTOLDSPLF */
/* */
/* LANGUAGE: CL COMMAND SOURCE */
/* */
/* DESCRIPTION: COMMAND SOURCE FOR THE DLTOLDSPLF COMMAND WHICH*/
/* INVOKES THE DLTOLDSPLF PROGRAM. */
/* */
/****************************************************************/
CMD PROMPT('DELETE OLD SPOOLED FILES')
/* PARAMETERS FOR LIST OF SPOOLED FILES (QUSLSPL) */
PARM KWD(USRPRFNME) +
TYPE(*SNAME) +
LEN(10) +
MIN(1) +
SPCVAL(*ALL) +
PROMPT('User Profile Name:')
PARM KWD(OUTQUEUE) +
TYPE(QUAL1) +
MIN(1) +
PROMPT('Output Queue:')
/* INFORMATION NEEDED FOR PROGRAM */
PARM KWD(DELETEDATE) +
TYPE(*DATE) +
PROMPT('Last Deletion Date:')
QUAL1: QUAL TYPE(*NAME) LEN(10) SPCVAL(*ALL)
QUAL TYPE(*NAME) LEN(10) SPCVAL(*LIBL *CURLIB ' ') +
PROMPT('Library Name:')


To create the CL command, specify the following:
CRTCMD CMD(QGPL/DLTOLDSPLF) PGM(QGPL/DLTOLDSPLF) +
SRCFILE(QGPL/QCMDSRC) ALLOW(*IPGM *BPGM)
To delete old spooled files, you can use one of the application programs provided in the following languages:

RPG
COBOL
ILE C
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 DATCEN IFLT TGTCEN
C EXSR CLDLT
C ELSE
C DATCEN IFEQ TGTCEN

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 END FOR EQ CEN
C END FOR ELSE CEN

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)
COBOL DLTOLDSPLF Program

To delete spooled files, you can use this COBOL DLTOLDSPLF program:


***************************************************************
* *
* PROGRAM: DLTOLDSPLF *
* *
* LANGUAGE: COBOL *
* *
* DESCRIPTION: DELETE OLD SPOOLED FILES *
* *
* APIs USED: QUSCRTUS, QUSLSPL, QUSRTVUS, QUSRSPLA, QUSDLTUS,*
* AND QMHSNDM. *
***************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. DLTOLDSPLF.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
COPY QUSGEN OF QSYSINC-QLBLSRC.
COPY QUSLSPL OF QSYSINC-QLBLSRC.
COPY QUSRSPLA OF QSYSINC-QLBLSRC.
*****************************************************************
* VALUES USED FOR ERROR CODE *
*****************************************************************
* The following is copied from QSYSINC/QLBLSRC member QUSEC
* so that the variable length field EXCEPTION-DATA can be defined
* as 100 bytes for exception data.
*****************************************************************
01 QUS-EC.
05 BYTES-PROVIDED PIC S9(00009) BINARY.
05 BYTES-AVAILABLE PIC S9(00009) BINARY.
05 EXCEPTION-ID PIC X(00007).
05 RESERVED PIC X(00001).
* 05 EXCEPTION-DATA PIC X(00001).
*
* Varying length
05 EXCEPTION-DATA PIC X(100).

***************************************************************
* VALUES USED FOR THE QUSCRTUS PROGRAM *
***************************************************************
01 CRTUS-INFO.
05 CRT-SPCNAME PIC X(20)
VALUE "DLTOLDSPLFQTEMP ".
05 CRT-EXTATTR PIC X(10) VALUE SPACE.
05 CRT-SPCSIZE PIC S9(9) BINARY VALUE 1024.
05 CRT-INITSPACE PIC X VALUE " ".
05 CRT-AUTHORITY PIC X(10) VALUE "*CHANGE ".
05 CRT-DESCRIPTION PIC X(50) VALUE SPACE.
05 CRT-USRRPL PIC X(10) VALUE "*YES ".

***************************************************************
* VALUES USED FOR THE QUSRTVUS PROGRAM *
***************************************************************
01 RTV-START-POS PIC S9(9) BINARY VALUE 1.
01 RTV-LENGTH PIC S9(9) BINARY VALUE 140.

01 RTVSPLA-JOB-ID PIC X(26) VALUE "*INT".

***************************************************************
* VALUES USED FOR THE QUSLSPL AND QUSRSPLA PROGRAM *
***************************************************************
01 RSPLA-DATE.
05 R-CENTURY PIC X.
05 R-YEAR PIC X(2).
05 R-MONTH PIC X(2).
05 R-DAY PIC X(2).
01 LSPLA-FORMAT PIC X(8) VALUE "SPLF0100".
01 LSPLA-USERDATA PIC X(10) VALUE "*ALL ".
01 LSPLA-FORMTYPE PIC X(10) VALUE "*ALL ".
01 RSPLA-JOB-NAME PIC X(26) VALUE "*INT".
01 RSPLA-NAME PIC X(10) VALUE "*INT".
01 RSPLA-NUMBER PIC S9(9) BINARY VALUE -1.
01 RSPLA-FORMAT PIC X(10) VALUE "SPLA0100 ".
01 SPLA-VAR-LENGTH PIC S9(9) BINARY VALUE 800.
01 DLT-COUNT PIC 9(15) VALUE 0.
01 DLT-SPL-NUMBER PIC 9(6).

***************************************************************
* VALUES USED FOR THE QMHSNDM PROGRAM *
***************************************************************
01 MSG-ID PIC X(7) VALUE SPACE.
01 MSG-FL-NAME PIC X(20) VALUE SPACE.
01 MSG-DATA.
05 DATA-MD PIC X(34)
VALUE "NUMBER OF SPOOLED FILES DELETED : ".
05 DLT-NUM-MD PIC X(20) VALUE SPACE.
01 MSG-DATA-LEN PIC S9(9) BINARY VALUE 54.
01 MSG-TYPE PIC X(10) VALUE "*INFO ".
01 MSG-QUEUE PIC X(20)
VALUE "*REQUESTER ".
01 MSG-Q-NUM PIC S9(9) BINARY VALUE 1.
01 RPY-MSG PIC X(10) VALUE SPACE.
01 MSG-KEY PIC X(4) VALUE SPACE.

***************************************************************
* PARAMETERS THAT ARE PASSED TO THIS PROGRAM FROM THE COMMAND *
***************************************************************
LINKAGE SECTION.
01 PARM-USERNAME PIC X(10).
01 PARM-OUTQ PIC X(20).
01 PARM-DATE.
05 P-CENTURY PIC X.
05 P-YEAR PIC X(2).
05 P-MONTH PIC X(2).
05 P-DAY PIC X(2).

***************************************************************
* BEGINNING OF EXECUTABLE CODE. *
***************************************************************
PROCEDURE DIVISION USING PARM-USERNAME,
PARM-OUTQ,
PARM-DATE.

MAIN-PROGRAM.

* **********************************************************
* * INITIALIZE ERROR CODE STRUCTURE. *
* **********************************************************

MOVE 116 TO BYTES-PROVIDED.
MOVE 0 TO BYTES-AVAILABLE.
MOVE SPACES TO EXCEPTION-ID.
MOVE SPACES TO RESERVED OF QUS-EC.
MOVE SPACES TO EXCEPTION-DATA.

* **********************************************************
* * CREATE THE USER SPACE USING INPUT PARMS FOR THE CALL *
* **********************************************************

CALL "QUSCRTUS" USING CRT-SPCNAME,
CRT-EXTATTR,
CRT-SPCSIZE,
CRT-INITSPACE,
CRT-AUTHORITY,
CRT-DESCRIPTION,
CRT-USRRPL,
QUS-EC.

* **********************************************************
* * LIST THE SPOOLED FILES TO THE USER SPACE OBJECT. *
* **********************************************************

CALL "QUSLSPL" USING CRT-SPCNAME,
LSPLA-FORMAT,
PARM-USERNAME,
PARM-OUTQ,
LSPLA-FORMTYPE,
LSPLA-USERDATA,
QUS-EC.

* **********************************************************
* * RETRIEVE ENTRY INFORMATION FROM THE USER SPACE. *
* **********************************************************

CALL "QUSRTVUS" USING CRT-SPCNAME,
RTV-START-POS,
RTV-LENGTH,
QUS-GENERIC-HEADER-0100,
QUS-EC.

* **********************************************************
* * IF ANY SPOOLED FILES WERE FOUND MATCHING THE SEARCH *
* * CRITERIA, RETRIEVE DETAILED INFORMATION AND DECIDE *
* * WHETHER TO DELETE THE FILE OR NOT. *
* **********************************************************

IF NUMBER-LIST-ENTRIES OF QUS-GENERIC-HEADER-0100
GREATER THAN ZERO THEN
ADD 1 TO OFFSET-LIST-DATA OF QUS-GENERIC-HEADER-0100
GIVING RTV-START-POS.
PERFORM CHECK-AND-DELETE THROUGH
CHECK-AND-DELETE-END NUMBER-LIST-ENTRIES
OF QUS-GENERIC-HEADER-0100 TIMES.

* **********************************************************
* * CALL THE QUSDLTUS API TO DELETE THE USER SPACE *
* * WE CREATED, AND TO SEND A MESSAGE TELLING HOW MANY *
* * SPOOLED FILES WERE DELETED. *
* **********************************************************

CALL "QUSDLTUS" USING CRT-SPCNAME,
QUS-EC.

MOVE DLT-COUNT TO DLT-NUM-MD.
CALL "QMHSNDM" USING MSG-ID,
MSG-FL-NAME,
MSG-DATA,
MSG-DATA-LEN,
MSG-TYPE,
MSG-QUEUE,
MSG-Q-NUM,
RPY-MSG,
MSG-KEY,
QUS-EC.

STOP RUN.

* **********************************************************
* * CHECK THE DATE OF THE SPOOLED FILE. IF IT IS OLDER *
* * OR EQUAL TO THE DATE PASSED IN, CALL THE PROCEDURE *
* * TO DELETE THE SPOOLED FILE. *
* **********************************************************

CHECK-AND-DELETE.
CALL "QUSRTVUS" USING CRT-SPCNAME,
RTV-START-POS,
SIZE-EACH-ENTRY OF
QUS-GENERIC-HEADER-0100,
QUS-SPLF0100,
QUS-EC.

* **********************************************************
* * ADVANCE TO NEXT SPOOLED FILE FOR PROCESSING THE CHECK *
* * AND DELETE. *
* **********************************************************

ADD SIZE-EACH-ENTRY OF QUS-GENERIC-HEADER-0100 TO
RTV-START-POS GIVING RTV-START-POS.

* **********************************************************
* * RETRIEVE THE ATTRIBUTES FOR THE SPOOLED FILE TO GET *
* * THE CREATE DATE FOR THE SPOOLED FILE. *
* **********************************************************

CALL "QUSRSPLA" USING QUS-SPLA0100,
SPLA-VAR-LENGTH,
RSPLA-FORMAT,
RSPLA-JOB-NAME,
INT-JOB-ID OF QUS-SPLF0100,
INT-SPLF-ID OF QUS-SPLF0100,
RSPLA-NAME,
RSPLA-NUMBER,
QUS-EC.

MOVE DATE-FILE-OPEN OF QUS-SPLA0100 TO RSPLA-DATE.

* **********************************************************
* * COMPARE THE CREATE DATE WITH THE DATE THAT WAS PASSED *
* * IN AS PARAMETER. *
* **********************************************************

IF R-CENTURY IS LESS THAN P-CENTURY THEN
PERFORM DLT-SPLF THROUGH DLT-SPLF-END
ELSE
IF R-CENTURY IS EQUAL TO P-CENTURY THEN

IF R-YEAR IS LESS THAN P-YEAR THEN
PERFORM DLT-SPLF THROUGH DLT-SPLF-END
ELSE
IF R-YEAR IS EQUAL TO P-YEAR THEN
IF R-MONTH IS LESS THAN P-MONTH THEN
PERFORM DLT-SPLF THROUGH DLT-SPLF-END
ELSE
IF R-MONTH IS EQUAL TO P-MONTH THEN
IF R-DAY IS LESS THAN OR EQUAL TO P-DAY THEN
PERFORM DLT-SPLF THROUGH DLT-SPLF-END.

CHECK-AND-DELETE-END.

* **********************************************************
* * THIS IS THE PROCEDURE TO DELETE THE SPOOLED FILE. *
* * ALL OF THE SPOOLED FILES WITH CREATE DATE OLDER OR *
* * EQUAL TO THE DATE PASSED IN AS PARAMETER WILL BE *
* * DELETED. *
* **********************************************************

DLT-SPLF.
ADD 1 TO DLT-COUNT.
MOVE SPLF-NUMBER OF QUS-SPLA0100 TO DLT-SPL-NUMBER.

CALL "CLDLT" USING SPLF-NAME OF QUS-SPLA0100,
JOB-NUMBER OF QUS-SPLA0100,
USR-NAME OF QUS-SPLA0100,
JOB-NAME OF QUS-SPLA0100,
DLT-SPL-NUMBER,
FORM-TYPE OF QUS-SPLA0100,
USR-DATA OF QUS-SPLA0100.

DLT-SPLF-END.

To create the COBOL program, specify the following:

CRTCBLPGM PGM(QGPL/DLTOLDSPLF) SRCFILE(QGPL/QCBLSRC)
ILE C DLTOLDSPLF Program

To delete spooled files, you can use this ILE C DLTOLDSPLF program:


/*******************************************************************/
/* PROGRAM: DLTOLDSPLF */
/* */
/* LANGUAGE: ILE C for OS/400 */
/* */
/* DESCRIPTION: THIS IS AN EXAMPLE PROGRAM FOR THE USE OF */
/* USER SPACES WRITTEN IN ILE C for OS/400. */
/* THE FLOW OF THIS PROGRAM IS AS FOLLOWS: */
/* (1) CREATE A USER SPACE USING QUSCRTUS */
/* (2) GET LIST OF SPOOLED FILES IN THE USER SPACE */
/* USING QUSLSPL */
/* (3) KEEP POINTER TO ENTRY LIST IN THE USER SPACE */
/* (4) ENTER LOOP */
/* RETRIEVE LIST ENTRY */
/* RETRIEVE MORE INFORMATION USING QUSRSPLA */
/* IF SPOOLED FILE IS TOO OLD */
/* DELETE SPOOLED FILE */
/* INCREMENT DELETE COUNTER */
/* END LOOP */
/* (5) DELETE USER SPACE */
/* */
/* APIs USED: QUSCRTUS, QUSLSPL, QUSRSPLA, QUSPTRUS, QUSDLTUS, */
/* QMHSNDPM, AND QMHSNDM. */
/* */
/*******************************************************************/
#include /*strcpy, strncpy, strcmp */
#include
#include /*Error code structures */
#include /*General user space structures */
#include /*Linkage info, structures for QUSCRTUS */
#include /*Linkage info, structures for QUSLSPL */
#include /*Linkage info, structures for QUSPTRUS */
#include /*Linkage info, structures for QUSRSPLA */
#include /*Linkage info, structures for QUSDLTUS */
#include /*Linkage info, structures for QMHSNDM */
#include /*Linkage info, structures for QMHSNDPM */


#pragma linkage(CLDLT,OS)
void CLDLT (char file_name[10],
char job_number[6],
char usr_name[10],
char job_name[10],
char file_number[6],
char form_type[10],
char usr_data[10]);

void error_check (void);

Qus_Generic_Header_0100_t *space;
char *list_section;
Qus_SPLF0100_t *entry_list;
Qus_SPLA0100_t *Rcv_Spl_Var;
/*****************************************************************/
/* PARMS FOR CLDLT */
/*****************************************************************/
char job_nmbr[6];
char usr_nm[10];
char job_nm[10];
char sp_job_name[10];
char sp_spl_number[6];
char File_Number[] = "*LAST ";
/*****************************************************************/
/* PARMS FOR QUSLSPL */
/*****************************************************************/
char frmt[8];
char usr[10];
char OutQ_Nm[20];
char ls_frm_typ[10];
char Usr_dat[10];
/*****************************************************************/
/* PARMS FOR QUSRSPLA */
/*****************************************************************/
char Rcv_Var[724];
int Rcv_lgth = 724;
char Rtv_Fmt[8];
char Qal_Jb_Nam[] = "*INT ";
char Splf_Name[] = "*INT ";
int Splf_Number = -1;
/*****************************************************************/
/* PARMS FOR QUSCRTUS */
/*****************************************************************/
char spc_name[20];
char ext_atr[10];
int initial_size;
char initial_value[1];
char auth[10];
char desc[50];
char replace[10];
/*****************************************************************/
/* PARMS FOR QMHSNDPM AND QMHSNDM */
/*****************************************************************/
char msg_id[7];
char msg_fl_name[20];
char msg_data[50];
int msg_data_len;
char msg_type[10];
char pgm_queue[10];
int pgm_stk_cnt;
char msg_key[4];
/*****************************************************************/
/* PARMS FOR QMHSNDM */
/*****************************************************************/
int msg_q_num;
char msg_queue[20];
char rpy_mq[10];
/*****************************************************************/
/* MISCELLANEOUS VARIABLES */
/*****************************************************************/
char pack_dlt_count[15];
int dlt_cnt;
int count;
char tmp_spl_number[7];
char dlt_date[7];
char spc_date[7];
int api_code;
Qus_EC_t err_code;

/*****************************************************************/
/* PROCEDURE TO CHECK THE ERRCODE RETURNED FROM CALLS TO APIs */
/*****************************************************************/
void error_check(void)
{
if (err_code.Bytes_Available != 0){
strncpy(msg_id,"CPF9898",7);
strncpy(msg_fl_name,"QCPFMSG *LIBL ",20);
strncpy(msg_data,"An error has occurred calling ",29);
switch (api_code){
case 1 : strncat(msg_data,"QUSCRTUS.",9);
case 2 : strncat(msg_data,"QUSLSPL. ",9);
case 3 : strncat(msg_data,"QUSPTRUS.",9);
case 4 : strncat(msg_data,"QUSRSPLA.",9);
case 5 : strncat(msg_data,"QUSDLTUS.",9);
case 6 : strncat(msg_data,"QMHSNDM. ",9);
default : strncat(msg_data,"UNKNOWN. ",9);
}
msg_data_len = 38;
strncpy(msg_type,"*ESCAPE ",10);
strncpy(pgm_queue,"* ",10);
pgm_stk_cnt = 1;

QMHSNDPM(msg_id,msg_fl_name,msg_data,msg_data_len,msg_type,
pgm_queue,pgm_stk_cnt,msg_key,&err_code);
}
}

/********************************************************************/
/* START OF MAINLINE */
/********************************************************************/

main(argc,argv)
int argc;
char *argv[];
{

/********************************************************************/
/* Read in and assign the command-line arguments to respective */
/* variables */
/********************************************************************/
strncpy(usr,argv[1],10);
strncpy(OutQ_Nm,argv[2],20);
strncpy(dlt_date,argv[3],7);

/********************************************************************/
/* Assign value to specific variables in the program */
/********************************************************************/
strcpy(spc_name,"DLTOLDSPLFQTEMP ");
memset(ext_atr,' ',10);
initial_size = 1024;
strcpy(initial_value," ");
strcpy(auth,"*CHANGE ");
memset(desc,' ',50);
strcpy(frmt,"SPLF0100");
strcpy(replace,"*YES ");
strcpy(ls_frm_typ,"*ALL ");
strcpy(Usr_dat,"*ALL ");
strcpy(Rtv_Fmt,"SPLA0100");

/********************************************************************/
/* Call external program to create a user space */
/********************************************************************/
err_code.Bytes_Provided = 0;
api_code = 1;
QUSCRTUS(spc_name,ext_atr,initial_size,initial_value,auth,desc,replace,
&err_code);
/********************************************************************/
/* Call external program to list spooled files into user space */
/********************************************************************/
api_code = 2;
QUSLSPL(spc_name,frmt,usr,OutQ_Nm,ls_frm_typ,Usr_dat,&err_code);
/********************************************************************/
/* Call external program to get a pointer to the user space */
/* and get addressability to the list data section. */
/********************************************************************/
api_code = 3;
QUSPTRUS(spc_name,&space,&err_code);
list_section = (char *)space;
list_section = list_section + space->Offset_List_Data;
entry_list = (Qus_SPLF0100_t *) list_section;
dlt_cnt = 0;
count = 1;

/********************************************************************/
/* Loop through the entry list and delete old spooled files */
/********************************************************************/
while (count <= space->Number_List_Entries) {
/********************************************************************/
/* Call external program to retrieve more spool information */
/********************************************************************/
api_code = 4;
QUSRSPLA(Rcv_Var,Rcv_lgth,Rtv_Fmt,Qal_Jb_Nam,
entry_list->Int_Job_ID,entry_list->Int_Splf_ID,
Splf_Name,Splf_Number,&err_code);
Rcv_Spl_Var = (Qus_SPLA0100_t *)Rcv_Var;
strncpy(spc_date,Rcv_Spl_Var->Date_File_Open,7);
/********************************************************************/
/* If spooled file is too old delete it */
/********************************************************************/
if (strncmp(spc_date,dlt_date,7) <= 0 ) {
strncpy(job_nm,Rcv_Spl_Var->Job_Name,10);
strncpy(job_nmbr,Rcv_Spl_Var->Job_Number,6);
strncpy(usr_nm,Rcv_Spl_Var->Usr_Name,10);
strncpy(sp_job_name,Rcv_Spl_Var->Splf_Name,10);
/********************************************************************/
/* Convert the spooled file number to character. */
/********************************************************************/
memcpy (sp_spl_number," ",6);
sprintf(tmp_spl_number,"%d",Rcv_Spl_Var->Splf_Number);
memcpy(sp_spl_number,tmp_spl_number,strlen(tmp_spl_number));
/********************************************************************/
/* Delete the spooled file. */
/********************************************************************/
CLDLT(sp_job_name,job_nmbr,usr_nm,
job_nm,sp_spl_number,ls_frm_typ,Usr_dat);
dlt_cnt++;
} /*IF*/
strcpy(spc_date," ");
count++;
entry_list++;
} /*WHILE*/
/********************************************************************/
/* Remove the user space */
/********************************************************************/
api_code = 5;
QUSDLTUS(spc_name, &err_code);

/********************************************************************/
/* Send final message to user indicating number of spooled files */
/* deleted. */
/********************************************************************/
api_code = 6;
strncpy(msg_id," ",7);
strncpy(msg_fl_name," ",20);
sprintf(msg_data,"Number of spooled files deleted: %d", dlt_cnt);
msg_data_len = strlen(msg_data);
strncpy(msg_type,"*INFO ",10);
strncpy(msg_queue,"*REQUESTER ",20);
msg_q_num = 1;
strncpy(rpy_mq," ",10);
QMHSNDM(msg_id,msg_fl_name,msg_data,msg_data_len,msg_type,
msg_queue,msg_q_num,rpy_mq,msg_key, &err_code);

}

To create an ILE C program, specify the following:

CRTBNDC PGM(QGPL/DLTOLDSPLF) SRCFILE(QGPL/QCSRC)
CL Delete (CLDLT) Program

The DLTOLDSPLF program, written in OPM RPG, OPM COBOL, or ILE C, 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)