Return to the RPG Tips
API to read an outq of spoolfiles:
FDLTSPLBFM CF E WorkStn Sfile(Sfl1:Sfl1RRN)
DPgmSts SDS
D CPFID 40 46
D CPFMsg 91 170
D*Dta S 70 Dim(11) CtData PerRcd(1)
DErrRpt S 70
D MSGDTA S 70 Inz(*blanks)
D MSGID S 7 Inz('CPF9898')
D MSGTYP S 10 Inz('*STATUS')
D CSTACK S 9B 0 Inz(0)
D MSGDTL S 9B 0 Inz(70)
D MSGFIL S 20 Inz('QCPFMSG QSYS')
D MSGKEY S 9B 0
D CMSGQ S 10 Inz('*EXT')
*File layout for SPLF0100 format.
DListDS DS
D Rec 82A
D RecName 10A Overlay(Rec:1)
D RecOutQ 10A Overlay(Rec:11)
D RecQLib 10A Overlay(Rec:21)
D RecFmTyp 10A Overlay(Rec:31)
D RecUsrDta 10A Overlay(Rec:41)
D RecIntId 16A Overlay(Rec:51)
D RecIntSplId 16A Overlay(Rec:66)
*DS to get offset in.
DGeneralDS DS 140 Inz
D InputSize 113 116B 0
D ListOffset 125 128B 0
D NumberOfList 133 136B 0
D EntrySize 137 140B 0
D StartPosit S 9B 0
D StartLen S 9B 0
*API error data structure.
DErrorDS DS 116
D BytesProvd 1 4B 0
D BytesAvail 5 8B 0
D MessageId 9 15A
D Err# 16 16A
D MessageDta 17 116A
DInputDS DS Inz
D UserSpace 20
D SpaceName 10 OverLay(UserSpace:1)
D Inz('OIDLT002')
D SpaceLib 10 OverLay(UserSpace:11)
D Inz('QTEMP')
DFormatName S 8
DFormType S 10
DUserData S 10
DUserName S 10 Inz('*ALL')
DSpaceSize S 9B 0
DSpaceAttr S 10
DSpaceValue S 1
DSpaceAuth S 10 Inz('*CHANGE')
DSpaceText S 50
DSpaceReplc S 10 Inz('*YES')
D DS
D OutSpool 20
D OutQ 10 Overlay(OutSpool:1)
D QLib 10 Overlay(OutSpool:11)
DCurDir C const('/QIBM/UserData/RDARS-
D /SpoolFile/')
DLnkPth S 50A
DRmvLnk C const('RMVLNK OBJLNK('' -
D -
D ')
DCommand DS
D Cmd 70A
D Lnk 50A Overlay(Cmd:16)
DLen S 15 5 Inz(80.0)
DIndex S Like(NumberOfList) Inz(1)
*Initialization: Setup screen
* Setup user space
* Get archive to delete
C eval Keys1 = ('F3=Exit F12=Cancel')
C eval *In50 = *off
C dow not *InKC
C exsr CrtList
C if *InKC
C leave
C endif
C eval Cmd = RmvLnk
*Initialization:
C enddo
C eval *Inlr = *on
C return
*--------------------------------------------------------------*
* lodsfl() Load List into subfile *
*--------------------------------------------------------------*
CSR lodsfl begsr
C dow not *In50
*Get list
C if Index > NumberOfList
C eval *In50 = *on
C leave
C endif
C call 'QUSRTVUS'
C parm UserSpace
C parm StartPosit
C parm StartLen
C parm ListDS
C parm ErrorDS
C if MessageID <> *blanks
C eval *In50 = *on
C leave
C endif
C eval Index = (Index + 1)
C eval Sfl1RRN = (Sfl1RRN + 1)
C eval StartPosit = (StartPosit + EntrySize)
C enddo
CSR endsr
*--------------------------------------------------------------*
* crtlist() Create list of spoolfiles in Userspace. *
*--------------------------------------------------------------*
CSR CrtList begsr
C eval SpaceSize = 1024
C eval OutQ = 'ERROR'
C eval QLib = 'QUSRRDARS'
C call 'QUSCRTUS'
C parm UserSpace
C parm *blanks SpaceAttr
C parm SpaceSize
C parm *blanks SpaceValue
C parm '*ALL' SpaceAuth
C parm *blanks SpaceText
C parm '*YES' SpaceReplc
C parm ErrorDS
C call 'QUSLSPL'
C parm UserSpace
C parm 'SPLF0100' FormatName
C parm UserName
C parm OutSpool
C parm '*ALL' FormType
C parm '*ALL' UserData
C parm ErrorDS
C eval StartPosit = 1
C eval StartLen = 140
*Get offset to first record in user space.
C call 'QUSRTVUS'
C parm UserSpace
C parm StartPosit
C parm StartLen
C parm GeneralDS
C parm ErrorDS
C eval StartPosit = (ListOffset + 1)
C eval StartLen = EntrySize
CSR endsr
*--------------------------------------------------------------*
* sndmsg() - Send Program Message. *
*--------------------------------------------------------------*
CSR SndMsg begsr
START SNDMSG()
C call 'QMHSNDPM'
SNDPGMMSG API
C parm MsgID
C parm MsgFil
C parm MsgDta
C parm 70 MsgDtl
C parm MsgTyp
C parm CMsgQ
C parm CStack
C parm MsgKey
C parm ErrorDS
CSR endsr
END SNDMSG()
*--------------------------------------------------------------*
* *PSSR() - PROGRAM EXECPTION ERROR HANDLER ROUTINE *
*--------------------------------------------------------------*
CSR *PSSR begsr
START *PSSR()
C eval MsgID = CPFID
C eval MsgTyp = '*INFO'
C eval MsgDta = CPFMsg
C eval CMsgQ = '*EXT'
C eval CStack = 0
C exsr Sndmsg
C eval *InLR = *on
C return
CSR endsr
END *PSSR
[report a broken link by clicking here]