RPGIV @ Work

A unique site for RPG and System i Lovers

Welcome!

Hi, this site will provide all what you need in System i and RPG developments.

My Name is Chamara Withanachchi, System i Expert and RPG Developer. And in the field for last 11 years.

I hope you will find lot of valuable information from this site

API to read an outq of spoolfiles Print E-mail
User Rating: / 0
PoorBest 
Written by Chamara Withanachchi   

I found this Code in http://www.as400pro.com site and credit goes to the original author, I'm using this code with minor modifications.


     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
     C                   call      'QMHSNDPM'
     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

      *--------------------------------------------------------------*
      * *PSSR() - PROGRAM EXECPTION ERROR HANDLER ROUTINE            *
      *--------------------------------------------------------------*
     CSR   *PSSR         begsr
     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

User Comments

Please login or register to add comments

<Previous   Next>