× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  • Subject: Re: CPYSPLF
  • From: "L. S. Russell" <leslier@xxxxxxxxxx>
  • Date: Fri, 10 Dec 1999 14:32:56 -0600

I sort of hesitate to give this away, but this is exactly what you need and 
more.

feel free to butcher my already butchered code
Cut and paste this into notepad, save it, Ftp it to your AS/400.
Good idea to deskcheck this before you compile and run it.

<<--- Cut here --->>

     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

<<--- End here --->>

Chris Bipes wrote:

> There are APIs to list the spool files in an out queue.  The one I used in
> the past listed all the spool files and their attributes.  I can not
> remember the exact api but hear is the book with all the spool file apis:
>
> AS/400e
> System API Reference
> OS/400 Print APIs
> Version 4
> Document Number SC41-5874-03
>
> Have fun,
>
> Christopher K. Bipes     mailto:ChrisB@Cross-Check.com
> Sr. Programmer/Analyst   mailto:Chris_Bipes@Yahoo.com
> CrossCheck, Inc.         http://www.cross-check.com
> 6119 State Farm Drive    Phone: 707 586-0551 x 1102
> Rohnert Park CA  94928 Fax: 707 586-1884
>
> *Note to Recruiters
> Neither I, nor anyone that I know of, is interested in any new and/or
> exciting positions. Please do not contact me.
>
> -----Original Message-----
> From: Mary Spencer [mailto:Mspence@pop3.utoledo.edu]
> Sent: Friday, December 10, 1999 10:13 AM
> To: Midrange-L
> Subject: CPYSPLF
>
> I want to use the descriptions of spool files in an outq in a CL
> program.  Anyone know how I can do this?  I am trying to automate
> copying a good number of spool files to physical files for downloading.
> Or ..... is there and easier way to do this?
> --
> Mary :-)
>
> せカせЙせカせЙせカせЙせカせЙせカせЙせカ
> Mary Spencer
> Director of information Services
> University of Toledo Foundation
>
> "For every problem there is one solution which is simple,
>      neat and wrong." H. L. Mencken
> せカせЙせカせЙせカせЙせカせЙせカせЙせカ
> +---
> | This is the Midrange System Mailing List!
> | To submit a new message, send your mail to MIDRANGE-L@midrange.com.
> | To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
> | To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
> | Questions should be directed to the list owner/operator: david@midrange.com
> +---

--
L. S. Russell Programmer/Analyst
Datrek Professional Bags, Inc.
2413 Industrial Drive
Springfield, TN. 37172
mailto:leslier@datrek.com
http://www.datrek.com
--


+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---

As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.