Re: DLTSELSPLF utility

Hi
I spoke with my colleague and he knows the utility and provided me the
source... (I did not test it...)


<code>
<command DELSELSPL>
CMD PROMPT('DELETE SELECT SPOOL FILES')
PARM KWD(SPLF) TYPE(*CHAR) LEN(10) DFT(*ALL) +
SPCVAL((*ALL)) MIN(0) PROMPT('SPOOL FILE +
NAME:')
PARM KWD(USER) TYPE(*CHAR) LEN(10) DFT(*ALL) +
SPCVAL((*ALL)) PROMPT('USER PROFILE:')
PARM KWD(OUTQ) TYPE(Q1) PROMPT('OUTPUT QUEUE:')
PARM KWD(USRDTA) TYPE(*CHAR) LEN(10) DFT(*ALL) +
SPCVAL((*ALL)) CHOICE('*ALL,GENERIC*,USER +
DATA') PROMPT('USER DATA:')
PARM KWD(PRGDATE) TYPE(*CHAR) DFT(*NONE) +
SPCVAL((*NONE)) +
CHOICE('*NONE,(YYYYMMDD)') PROMPT('PURGE +
BEFORE DATE:')
Q1: QUAL TYPE(*NAME) LEN(10) DFT(*ALL) SPCVAL((*ALL))
QUAL TYPE(*NAME) LEN(10) PROMPT('LIBRARY:')
</command>
<copy>
* Run CL Commands Procedure...
* To use this functionality use the CALLP opcode
DRun PR ExtPgm('QCMDEXC')
D CmdStr 3000A Const Options(*VarSize)
D CmdLen 15P 5 Const
D CmdDBCS 3A Const Options(*NoPass)
* This are work fields used as parms for the procedure
* After you load the Cmd field use Eval CmdStrSize=%LEN(%TRIM(CMD))
* The call will look like this CALLP RUN(CMD:CMDSTRSIZE)
DCmdStr S 3000A Inz Varying
DCmdStrSize S 4P 0 Inz
* End Of Run CL Commands Procedure...

* ReSend Message API Procedure
D SendMsg PR ExtPgm('QMHRSNEM')
D MsgKey 4A const
D ErrorCode 32766A options(*varsize)
D ToStkEntry 32766A options(*varsize: *nopass)
d ToStkEntryLn 10I 0 const options(*nopass)
D Format 8A const options(*nopass)
D FromEntry * const options(*nopass)
D FromCounter 10I 0 const options(*nopass)

* Error Code DS For API Calls
D ErrorDS DS
D dsEC1 10I 0 inz(0)
D dsEC2 10I 0 inz(0)

* Program Stack DS For API Calls
D StackDS ds
d dsRS_StkCnt 10I 0 inz(2)
D dsRS_StkQual 20A inz('*NONE *NONE')
D dsRS_IDLen 10I 0 inz(7)
D dsRS_StkID 7A inz('*')

* List Spooled Files API
DListSplF pr ExtPgm('QUSLSPL')
D UserSpaceName 20a Const
D APIFormat 8a Const
D UserName 10a Const
D OutQName 20a Const
D FormType 10a Const
D UserSpecData 10a Const
D APIErrorCode 32766a Options(*varsize)

* SPLF0100 Format Data Structure
/If Defined (SPLF0100)
d s0100Ptr s *
d SPLF0100 ds Qualified Based(s0100Ptr)
d User 10a
d OutQ 10a
d OutQLib 10a
d FormType 10a
d UserData 10a
d IntJobID 16a
d IntSplID 16a
d Reserved 2a
d ASP 10i 0
/EndIf

* SPLF0200 Format Data Structure
/If Defined (SPLF0200)
d s0200Ptr s *
d SPLF0200 ds Qualified Based(s0200Ptr)
d NbrOfFlds 10i 0
d ReturnLength 10i 0
d KeyFldReturn 10i 0
d DataType 1a
d Reserved 3a
d DataLength 10i 0
* Largest Data Length Returned as of V5R3 is 16...
d Data 60a varying
d Reserved1 32767a varying

* Valid Keys Returned From SPLF0200
* Spooled File Name returns Char (10)
dcSplName c Const(201)
* Job Name returns Char (10)
dcJobName c Const(202)
* User Name returns Char (10)
dcUserName c Const(203)
* Job Number returns Char (6)
dcJobNumber c Const(204)
* Spooled File Number returns Integer (5,0) (or Bin 4,0)
dcSplNbr c Const(205)
* Output Queue Name returns Char (10)
dcOutQ c Const(206)
* Output Queue Lib returns Char (10)
dcOutQLib c Const(207)
* Device returns Char (10)
dcDevice c Const(208)
* User Data returns Char (10)
dcUserData c Const(209)
* Status returns Char (10)
dcStatus c Const(210)
* Total Pages returns Integer (5,0) (or Bin 4,0)
dcTotalPages c Const(211)
* Current Page returns Integer (5,0) (or Bin 4,0)
dcCurPage c Const(212)
* Number Of Copies returns Integer (5,0) (or Bin 4,0)
dcCopies c Const(213)
* Form Type returns Char (10)
dcFormType c Const(214)
* Priority returns Char (2)
dcPriority c Const(215)
* Create Date returns Char (7)
dcCreateDate c Const(216)
* Create Time returns Char (6)
dcCreateTime c Const(217)
* Internal Job ID returns Char (16)
dcIntJobID c Const(218)
* Internal Spool ID returns Char (16)
dcIntSplID c Const(219)
* Device Type returns Char (10)
dcDevType c Const(220)
* Last Used Date returns Char (7)
dcLastUsed c Const(221)
* Spool Size Multiplier returns Integer (5,0) (or Bin 4,0)
dcSplSizMult c Const(222)
* Spool Size returns Integer (5,0) (or Bin 4,0)
dcSplSize c Const(223)
* ASP Number returns Integer (5,0) (or Bin 4,0)
dcASP c Const(224)
* System Job Name returns Char (8)
dcSysJobName c Const(225)
/EndIf
* SPLF0300 Format Data Structure
/If Defined (SPLF0300)
d s0300Ptr s *
d SPLF0300 ds Qualified Based(s0300Ptr)
d JobName 10a
d User 10a
d JobNbr 6a
d SplName 10a
d SplNbr 10i 0
d SplStatus 10i 0
d CreateDate 7a
d CreateTime 6a
d SplSchedule 1a
d SysSplName 10a
d UserData 10a
d FormType 10a
d OutQ 10a
d OutQLib 10a
d ASP 10i 0
d SplSize 10i 0
d SplSizMult 10i 0
d TotalPages 10i 0
d Copies 10i 0
d Priority 1a
d Reserved 7a

* Spool Status
d cPrtReady c Const(1)
d cPrtOpened c Const(2)
d cPrtClosed c Const(3)
d cPrtSaved c Const(4)
d cPrtWriting c Const(5)
d cPrtHeld c Const(6)
d cPrtMSGW c Const(7)
d cPrtPending c Const(8)
d cPrtPrinting c Const(9)
d cPrtFinished c Const(10)
d cPrtSending c Const(11)
d cPrtDeferred c Const(12)

d ds
d Statuses 48a Inz('RDY OPN CLO SAV WRT +
d HLD MSGWPND PRT FIN SND +
d DFR ')
d StsArray 4a Dim(12) Overlay(Statuses)
/EndIf
* Delete User Space API Procedure
DDltUsrSpc pr ExtPgm('QUSDLTUS')
DCUSQualUSName 20a CONST
DErrorCode 32766A options(*varsize)

* Create User Space API Procedure
DCrtUsrSpc pr ExtPgm('QUSCRTUS')
DCUSQualUSName 20a CONST
DCUSExtAttribut 10a CONST
DCUSInitSize 10I 0 CONST
DCUSInitValue 1a CONST
DCUSPublicAuth 10a CONST
DCUSDescription 50a CONST
DCUSReplace 10a CONST
DErrorCode 32766A options(*varsize)
* Get User Space Pointer API Procedure
D UserSpacePntr PR ExtPgm('QUSPTRUS')
D CUSQualUSName 20A CONST
D CUSPointer *

* User Space Header DS
D USHeader ds Based(CUSPointer)
d HdrUserArea 64a
d HdrHdrSize 10i 0
d HdrStrLvl 4a
d HdrFormat 8a
d HdrAPIUsed 10a
d HdrCrtDate 13a
d HdrInfoSts 1a
d HdrSizeOfUS 10i 0
d HdrOffsetToInp 10i 0
d HdrSizeOfInp 10i 0
d HdrOffsetToHdr 10i 0
d HdrSizeOfHdr 10i 0
d HdrOffsetToDtl 10i 0
d HdrSizeOfDtl 10i 0
d HdrNumberOfDtl 10i 0
d HdrEntrySize 10i 0
d HdrCCSID 10i 0
d HdrCountry 2a
d HdrLangID 3a
d HdrSubsetInd 1a
d HdrReserved1 42a
</copy COPYBOOK>

<RPGLE DELSELSPLF>
h option(*nodebugio) dftactgrp(*no) actgrp(*new)
* Author: Tommy Holden
* EMail: TomHolden@xxxxxxxxxxx
* Program Purpose: Provide a more flexible method for
* Deleting Spooled Files
/define SPLF0300
/copy spldel,copybook
d ExecuteCmd PR

* Work Variables
d i s 10u 0
dSplfName s 10a
dSplfUser s 10a
dSplfUserData s 10a
dUserData s 10a
dSplfDate s 8a
dTempDate s d
dSplfOutQ s 20a
dOutQ s 10a
dOutQLib s 10a
dCheckDate s 7a
dGeneric s 10u 0

* Constants
dcLSTSPLF c Const('LSTSPLF QTEMP')
C *Entry PList
C Parm SplfName
C Parm SplfUser
C Parm SplfOutQ
C Parm SplfUserData
C Parm SplfDate
/free
// Delete user Space If It Exists
Monitor;
DltUsrSpc(cLSTSPLF:ErrorDS);
On-Error;
EndMon;

// Create The User Space
Monitor;
CrtUsrSpc(cLSTSPLF:'USRSPC':1024:x'00':
'*ALL':'List Spool':'*NO':ErrorDS);
On-Error;
SendMsg(*blanks:
ErrorDS:
StackDS:
%size(StackDS):
'RSNM0100':
*NULL:
0);
EndMon;
// Parse Command Input Parameters
UserData=SplfUserData;

// Check For Generic or Specific Spooled File Name
If SplfUserData<>'*ALL';
// Check For Generic Spooled File Name
Generic=%Scan('*':SplfUserData);
If Generic>0;
UserData='*ALL';
Else;
UserData=SplfUserData;
EndIf;
EndIf;
// List Spooled Files Into User Space Based On
// Command Parameters
Monitor;
ListSplF(cLSTSPLF:'SPLF0300':SplfUser:SplfOutQ:
'*ALL':UserData:ErrorDS);
On-Error;
SendMsg(*blanks:
ErrorDS:
StackDS:
%size(StackDS):
'RSNM0100':
*NULL:
0);
EndMon;

// Find The Pointer To The User Space Data
UserSpacePntr(cLSTSPLF:CUSPointer);

// Position The SPLF0300 DS Pointer Based On
// Returned Values
s0300Ptr=CUSPointer+HdrOffsetToDtl;

// Process All Matching Spooled File Entries
For i = 1 By 1 To HdrNumberOfDtl+1;

// If i=1 then It's the first time through the loop
// so do not increment the pointer
If i>1;
s0300Ptr=s0300Ptr+%Size(SPLF0300);
EndIf;

// Exclude Spooled Files In a FIN status
If SPLF0300.SplStatus<>cPrtFinished;
// Check For Matching Spooled File Names
If SplfName<>'*ALL';
If SplfName<>SPLF0300.SplName;
Iter;
EndIf;
EndIf;
// Check For Matching User Names
If SplfUser<>'*ALL';
If SplfUser<>SPLF0300.User;
Iter;
EndIf;
EndIf;

// Check For Matchin Output Queues
If SplfOutQ<>'*ALL';
OutQ=%Subst(SplfOutQ:1:10);
OutQLib=%Subst(SplfOutQ:11:10);
If (OutQ<>SPLF0300.OutQ AND OutQLib<>SPLF0300.OutQLib);
Iter;
EndIf;
EndIf;
// Check For Matching User Data
If SplfUserData<>'*ALL';
// Check For Generic or Specified User Data
Generic=%Scan('*':SplfUserData);
If (Generic>0);
If (%Subst(SplfUserData:1:Generic-1)<>
%Subst(SPLF0300.UserData:1:Generic-1));
Iter;
EndIf;
Else;
If (SplfUserData<>SPLF0300.UserData);
Iter;
EndIf;
EndIf;
EndIf;

// Check For Purge Before Date
If SplfDate<>'*NONE';
TempDate=%Date(SplfDate:*ISO0);
CheckDate=%Char(TempDate:*cymd0);
If (CheckDate<=SPLF0300.CreateDate);
Iter;
EndIf;
EndIf;

// Delete The Spooled File Matching the Criteria
CmdStr='DLTSPLF '+SPLF0300.SplName+' JOB(' +
%Trim(SPLF0300.JobNbr)+'/'+
%Trim(SPLF0300.User)+'/'+
%Trim(SPLF0300.JobName)+') SPLNBR('+
%Trim(%Char(SPLF0300.SplNbr))+')';
ExecuteCmd();
EndIf;
EndFor;
ExSR Terminate;

// Terminate Subroutine
BegSR Terminate;
*InLR=*On;
Return;
EndSR;
/end-free
p ExecuteCmd B
d ExecuteCmd PI
/free
Monitor;
Run(CmdStr:%Len(%Trim(CmdStr)));
On-Error;
EndMon;
/end-free
p ExecuteCmd E
</RPGLE>
</code>




From: Szepesi Frigyes <frigyes.szepesi@xxxxxxxxxxxx>
To: "midrange-l@xxxxxxxxxxxx" <midrange-l@xxxxxxxxxxxx>
Date: 07/01/2016 12:10
Subject: Re: DLTSELSPLF utility
Sent by: "MIDRANGE-L" <midrange-l-bounces@xxxxxxxxxxxx>



Hi Paul,

Thank you for the link and hint, but DLTOLDSPLF does not have the generic
selection criteria which I need (I do not remember exactly what, but once
I have it, I will know it by checking its options).
About System i Navigator: It does not work over 3-5000 spool files ont he
list. (The whole purpose to use DLTSELSPLF would be to delete a few
thousands spool files at a time, based on multiple (generic) selection
crtiterias.)

Rgards
Frigyes Szepesi
iSeries System Administrator