Problem solve
Get help with specific problems with your technologies, process and projects.
Delete members based on numbers of days old
Don't waste your time searching, call this utility program to remove file members based on numbers of days old.
h DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DATFMT(*ISO)
h DFTACTGRP(*NO) ACTGRP('ILE')
‚‚*--------------------------------------------------------------------
‚‚* Utility to Remove Members based on Numbers Days Old
‚‚*--------------------------------------------------------------------
*--------------------------------------------------------------------
* EX: CALL PGM(MBRDLT) PARM('EDILOGF' '*LIBL' '0014' ' ')
*--------------------------------------------------------------------
* THIS WILL DELETE ALL MEMBERS FROM THE FILE EDILOGF THAT ARE
* 14 DAYS AND OLDER. (THIS UTILITY DOES NOT DELETE THE MEMBER NAME
* NOTE: THIS UTILITY DOES NOT DELETE THE MEMBER NAME SAME AS FILE
*--------------------------------------------------------------------
d/COPY QSYSINC/QRPGLESRC,QUSRUSAT
d/COPY QSYSINC/QRPGLESRC,QUSGEN
d/COPY QSYSINC/QRPGLESRC,QUSLMBR
d/COPY QSYSINC/QRPGLESRC,QUSRMBRD
d CrtUsrSpc PR *
d CrtSpcName 20 const
d SpacePtr s *
d UserSpace s 20 inz('MBRLST QTEMP')
d FormatList s 8A Inz('MBRL0200')
d FormatMbr s 8A Inz('MBRD0200')
d AllMbrs s 10A Inz('*ALL ')
d OvrDbf s 1A Inz('1')
d Member s 10
d GenLen s 9B 0
d StrPos s 9B 0
d RtvLen s 9B 0
d RcvLen s 9B 0
d Count s 15 0
d Command s 80a INZ
d CommandLen s 15p 5 INZ(80)
d SQuote c ''''
d ObjNamLib ds
d ObjNam 10 OVERLAY(ObjNamLib)
d ObjLib 10 OVERLAY(ObjNamLib:11)
d Days ds
d NDays 4 0 OVERLAY(Days)
d ADays 4 OVERLAY(Days)
*--------------------------------------------------------------------
* Standard Error Code data structure
*--------------------------------------------------------------------
dError ds 116
d QUSBPRV 1 4B 0 inz(116)
d QUSBAVL 5 8B 0
d MessageId 9 15
d MessageDta 17 116
*--------------------------------------------------------------------
* Member Date data structure - Alpha 13
*--------------------------------------------------------------------
dQusDte ds
d QusCC 1 1
d QusYMD 2 7
d QusTim 8 13
*--------------------------------------------------------------------
* Member Date data structure - Alpha 8
*--------------------------------------------------------------------
d MbrDtCrt ds
d MbrCY 4 OVERLAY(MbrDtCrt)
d MbrMM 2 OVERLAY(MbrDtCrt:5)
d MbrDD 2 OVERLAY(MbrDtCrt:7)
*----------------------------------------------------------------
* DATE DATA STRUCTURE (*ISO 'ccyy-mm-dd')
*----------------------------------------------------------------
d ds INZ
d NewDat D DATFMT(*ISO) INZ
d NewCY 4 OVERLAY(NewDat)
d NewMM 2 OVERLAY(NewDat:6)
d NewDD 2 OVERLAY(NewDat:9)
*----------------------------------------------------------------
* ISO DATES (*ISO 'ccyy-mm-dd')
*----------------------------------------------------------------
d Today s D Inz(*SYS)
d CompDat s D Inz(*SYS)
*--------------------------------------------------------------------
* Receive Parms for Object Name, Library, Days, MsgId
*--------------------------------------------------------------------
c *Like Define ObjNam pmObjNam
c *Like Define ObjLib pmObjLib
c *Like Define ADays pmDays
c *Like Define MessageId pmMsgId
c *entry plist
c parm pmObjNam
c parm pmObjLib
c parm pmDays
c parm pmMsgId
c Eval ObjNam = pmObjNam
c Eval ObjLib = pmObjLib
c Eval ADays = pmDays
*--------------------------------------------------------------------
* Calculate new Comparison Date based on Number Days Old
*--------------------------------------------------------------------
c Today subdur NDays:*DAYS CompDat
*--------------------------------------------------------------------
* Create User Space for Member List Information
*--------------------------------------------------------------------
c Eval SpacePtr = CrtUsrSpc(UserSpace)
*--------------------------------------------------------------------
* Create Member List in User Space
*--------------------------------------------------------------------
c Call 'QUSLMBR'
c Parm UserSpace
c Parm FormatList
c Parm ObjNamLib
c Parm AllMbrs
c Parm OvrDbf
c Parm Error
*--------------------------------------------------------------------
* Continue if no Errors
*--------------------------------------------------------------------
c Eval pmMsgId = MessageId
c if MessageId = *blanks
*--------------------------------------------------------------------
* Set Values for Generic Header
*--------------------------------------------------------------------
c Eval GenLen = 140
c Eval StrPos = 1
*--------------------------------------------------------------------
* Retreive Number of Entries, Offset, and the size of each entry
*--------------------------------------------------------------------
c Call 'QUSRTVUS'
c Parm UserSpace
c Parm StrPos
c Parm GenLen
c Parm QUSH0100
c Parm Error
*--------------------------------------------------------------------
* Check the Generic Header data structure for number of list entry
* offset to list entries, and size of each list entry
*--------------------------------------------------------------------
c Eval StrPos = ( QUSOLD + 1 )
c Eval RtvLen = QUSSEE
c Eval RcvLen = 209
c Eval Count = 1
*--------------------------------------------------------------------
* Process Members
*--------------------------------------------------------------------
c DoW Count <= QUSNBRLE
c Call 'QUSRTVUS'
c Parm UserSpace
c Parm StrPos
c Parm RtvLen
c Parm QUSL0200
c Parm Error
c Eval StrPos = QUSSEE + StrPos
c Eval Count = Count + 1
c movel(p) QUSMN01 Member
*--------------------------------------------------------------------
* Get Member Information
*--------------------------------------------------------------------
c Call 'QUSRMBRD'
c Parm QusM0200
c Parm GenLen
c Parm FormatMbr
c Parm ObjNamLib
c Parm Member
c Parm OvrDbf
c Parm Error
*--------------------------------------------------------------------
* Remove Member if not same as File Name and Member Create Date
* is Less/Equal to new comparison Date
*--------------------------------------------------------------------
c if Member <> ObjNam
c eval QusDte = QusCD03
c if QusCC = '1'
c eval MbrDtCrt = '20' + QusYMD
c else
c eval MbrDtCrt = '19' + QusYMD
c endif
c eval NewCY = MbrCY
c eval NewMM = MbrMM
c eval NewDD = MbrDD
c if NewDat <= CompDat
c eval Command = 'RMVM FILE(' +
c %trimr(ObjLib) +
c '/' + %trimr(ObjNam) +
c ') MBR(' +
c %trimr(Member) + ')'
c call 'QCMDEXC'
c parm Command
c parm CommandLen
c endif
c endif
e01 c EndDo
*--------------------------------------------------------------------
* End Program
*--------------------------------------------------------------------
c endif
c eval *inlr = *on
*====================================================================
* Procedure to create extendable user space, return pointer to it.
*====================================================================
p CrtUsrSpc B export
d CrtUsrSpc PI *
d CrtSpcName 20 const
* Local Variables
d PasSpcName DS 20
d SLib 11 20
d ChgAttrDs DS 13
d NumberAttr 9B 0 inz(1)
d KeyAttr 9B 0 inz(3)
d DataSize 9B 0 inz(1)
d AttrData 1 inz('1')
d ListPtr S *
d SpaceAttr S 10 inz
d SpaceAuth S 10 INZ('*CHANGE')
d SpaceLen S 9B 0 INZ(2048)
d SpaceReplc S 10 INZ('*YES')
d SpaceText S 50
d SpaceValue S 1
* Create the user space
c move CrtSpcName PasSpcName
c CALL 'QUSCRTUS'
c PARM PasSpcName
c PARM SpaceAttr
c PARM SpaceLen
c PARM SpaceValue
c PARM SpaceAuth
c PARM SpaceText
c PARM '*YES' SpaceReplc
c PARM Error
* Get pointer to user space
c CALL 'QUSPTRUS'
c PARM PasSpcName
c PARM ListPtr
* Change user space to be extendable
c CALL 'QUSCUSAT'
c PARM Slib
c PARM PasSpcName
c PARM ChgAttrDs
c PARM Error
c return ListPtr
p CrtUsrSpc E
This was last published in April 2005
Start the conversation
0 comments