|
midrange.com
I wrote a program to allow coolspools to email spooled files. Here's the
code for the spooled file list part.
?
*---------------------------------------------------------------------
* Create user space
?
*---------------------------------------------------------------------
d PasSpcName DS 20
d SName 1 10 inz('SPACENAME')
d Slib 11 20 inz('QTEMP')
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 inz(x'00')
?
*---------------------------------------------------------------------
* Get pointer in user space
?
*---------------------------------------------------------------------
d ListPtr S *
?
*---------------------------------------------------------------------
* Returned data from QUSLSPL SPLF0200 format
?
*---------------------------------------------------------------------
dQUSF0200 DS 300 based(FileLstPtr)
d QUSNBRFR00 9B 0
?
*---------------------------------------------------------------------
* The information represented by each key is returned in this format
?
*---------------------------------------------------------------------
d KeyStructure DS
d LenRtn 9B 0
d Key 9B 0
d type 1
d Rsvd 3
d Len 9B 0
d Data 10
?
*---------------------------------------------------------------------
d DataBin DS
d DataAlpha 10
d bin4 9B 0 overlay(DataAlpha:1)
?
*---------------------------------------------------------------------
* Name and location of the Output Queue
?
*---------------------------------------------------------------------
d OutQName DS
d QName 10
d QLibrary 10
?
*---------------------------------------------------------------------
* Qualified job name
?
*---------------------------------------------------------------------
d QualJob DS 26
d sfljob 10
d sflusr 10
d sfljob# 6
?
*---------------------------------------------------------------------
* Common header information
?
*---------------------------------------------------------------------
d GenHeadDs DS based(FilePtr)
d ListOffset 125 128B 0
d NumberList 133 136B 0
d EntrySize 137 140B 0
?
*---------------------------------------------------------------------
* Standard API error data structure
?
*---------------------------------------------------------------------
d ErrorDs DS INZ
d BytesProvd 1 4B 0 inz(116)
d BytesAvail 5 8B 0
d MessageId 9 15
d Err### 16 16
d Message 17 116
?
*---------------------------------------------------------------------
* Key data structure to indicate what information to return
?
*---------------------------------------------------------------------
d Keys DS
d Key201 9B 0 inz(201)
d Key202 9B 0 inz(202)
d Key203 9B 0 inz(203)
d Key204 9B 0 inz(204)
d Key205 9B 0 inz(205)
d Key211 9B 0 inz(211)
d Key216 9B 0 inz(216)
d Key217 9B 0 inz(217)
?
*---------------------------------------------------------------------
* Record layout
?
*---------------------------------------------------------------------
d reclay ds 132
d ctlrec 1 3
d splout 6 15
d spllib 19 28
d splfil 34 37
d ctlend 14 64
.....
*-----------------------------------------------------------------------
* Process selections
*-----------------------------------------------------------------------
c proc begsr
c eval sav#2 = 1
c *inkb doweq '0'
c exsr clrsub2
c exsr loadsub2
c seton 7072
c write mail2
?* In case there were spooled files deleted
c If Sav#2 > Sflrrn2 Feb 5/04 RP
c Eval Sav#2 = Sflrrn2 Feb 5/04 RP
c Endif
Feb 5/04 RP
c eval rcd#2 = sav#2
c exfmt mail2hd
c setoff 70
* process function keys
c ka leave
F1 - Exit
c kb leave
F2 - Previous
c ke iter
F5 - Refresh
* no function keys pressed, process options
c readc mail2sfl
98
c *in98 doweq '0'
c eval sav#2 = sflrrn2
c select
c sflopt wheneq '1'
c exsr prcemail
c kb setoff kb
c sflopt wheneq '4'
c exsr dltspl
c eval sav#2 = 1
c sflopt wheneq '5'
c exsr display
c endsl
c readc mail2sfl
98
c enddo
c ka leave
F1 - Exit
c enddo
c endsr
.....
*-----------------------------------------------------------------------
* Load 2nd subfile subroutine
*-----------------------------------------------------------------------
c loadsub2 begsr
* Delete the user space
c call 'QUSDLTUS' 66
c parm PasSpcName
c parm Errcde 1
c 66 exsr errrtn
* Create user space for list of files
c call 'QUSCRTUS' 66
c parm PasSpcName
c parm SpaceAttr
c parm SpaceLen
c parm SpaceValue
c parm SpaceAuth
c parm SpaceText
c 66 exsr errrtn
*
c eval Qname = Seloutq
c eval Qlibrary = Outqlib
* List spooled files to user space
c Call 'QUSLSPL' 66
c Parm PasSpcName
c Parm 'SPLF0200' FmtName
c Parm Usrnam UserName
c Parm OutqName
c Parm '*ALL' FormType
c Parm '*ALL' UserData
c Parm ErrorDs
c Parm *blanks JobNameF
c parm Keys
c parm NbrOfKeys
c 66 exsr errrtn
* Get pointer to user space
c Call 'QUSPTRUS' 66
c Parm PasSpcName
c Parm Fileptr
c 66 exsr errrtn
* Load the QUSF0200 data structure
c eval FileLstPtr = (FilePtr + ListOffset)
* Retrieve each spooled file
c DO NumberList
c Eval Index = 5
* For each spooled file, get the detail information
c DO QusNbrFr00
c Eval KeyStructure = %subst(QusF0200 :
c Index : %len(Keystructure))
* Load the individual fields represented by each key
c Select
c When Key = 201
c Eval sflspl = Data
c When Key = 202
c Eval sfljob = Data
c When Key = 203
c Eval sflusr = Data
c When Key = 204
c movel Data sfljob#
c When Key = 205
c movel Data DataAlpha
c z-add Bin4 sflnum
c When Key = 211
c movel Data DataAlpha
c z-add Bin4 sflpge
c When Key = 216
c* movel Data sfldat
c Eval sfldat = %Int(%Subst(Data:4:4) +
c %Subst(Data:2:2))
c When Key = 217
c movel Data sfltim
c Endsl
* Get the next key
c eval Index = Index + LenRtn
c ENDDO
* Write record to the subfile
c add 1 sflrrn2
c write mail2sfl
* Get next spooled file
c eval FileLstPtr = (FileLstPtr + EntrySize)
c ENDDO
* No Spooled Files Found On Outq
c if sflrrn2 = 0
c clear sflusr
c clear sflspl
c clear sflnum
c clear sfljob
c clear sfldat
c clear sfltim
c clear sflpge
c clear sfljob#
c eval sflspl = 'No Spooled'
c eval sflusr = 'File Found'
c add 1 sflrrn2
c write mail2sfl
c endif
* Delete the user space
c call 'QUSDLTUS' 66
c parm PasSpcName
c parm Errcde 1
c 66 exsr errrtn
c endsr
*-----------------------------------------------------------------------
* Delete spool file
*-----------------------------------------------------------------------
c dltspl begsr
* Use qcmdexc to delete the spool file
c move sflnum chnum
c eval cmd = 'DLTSPLF FILE(' + %trim(sflspl) +
c ') JOB(' + %trim(sfljob#) + '/' +
c %trim(sflusr) + '/' + %trim(sfljob) +
c ') SPLNBR(' + %trim(chnum) + ')'
c eval cmdlen = 74
c call 'QCMDEXC' 66
c parm cmd
c parm cmdlen
* Check for error on command
c 66 exsr errrtn
*
c endsr
*-----------------------------------------------------------------------
* Process the spool files to display
*-----------------------------------------------------------------------
c display begsr
* Use qcmdexc to display the spool file
c move sflnum chnum 4
c eval cmd = 'DSPSPLF FILE(' + %trim(sflspl) +
c ') JOB(' + %trim(sfljob#) + '/' +
c %trim(sflusr) + '/' + %trim(sfljob) +
c ') SPLNBR(' + %trim(chnum) + ')'
c eval cmdlen = 74
c call 'QCMDEXC' 66
c parm cmd
c parm cmdlen
* Check for error on command
c 66 exsr errrtn
*
c endsr
These are snippets of code from my program that I felt might be pertinent.
Basically, this mimics the wrksplf command so that a user can select the
spooled files to be converted to PDF format and emailed around. I didn't
quite understand user spaces at the time (I'm still not 100% on them
without a book of some sort) but they work great for this stuff.
Ron Power
Programmer
Information Services
City Of St. John's, NL
P.O. Box 908
St. John's, NL
A1C 5M2
709-576-8132
rpower@xxxxxxxxxx
http://www.stjohns.ca/
___________________________________________________________________________
Success is going from failure to failure without a loss of enthusiasm. -
Sir Winston Churchill
Pete Helgren <Pete@xxxxxxxxxx>
Sent by: rpg400-l-bounces@xxxxxxxxxxxx
2006/01/26 08:22 PM
Please respond to
RPG programming on the AS400 / iSeries <rpg400-l@xxxxxxxxxxxx>
To
RPG programming on the AS400 / iSeries <rpg400-l@xxxxxxxxxxxx>
cc
Subject
Re: Prompting for Spool Files
That looks like JUST what I was looking for.
I'll take a look at it tonight. Thanks.
Pete
Shannon ODonnell wrote:
>Here you go Pete. This should do it for you:
>
>List Spooled Files From an Application
>http://www.itjungle.com/fhg/fhg080305-story01.html
>
>
>-----Original Message-----
>From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx]
>On Behalf Of Pete Helgren
>Sent: Thursday, January 26, 2006 5:03 PM
>To: RPG Midrange Discussion
>Subject: Prompting for Spool Files
>
>I have collected several utilities that, in one way or another, work
>with spool files. None of them, however, have a "prompt" capability
>where you can hit the F4 key and select from a list of spool files by
>user or outq.
>
>Before I write my own, does anybody have an RPG program that does this
>already? Some of these utilities are great but having to know the Job
>Name, User, Number and Spool file number is a pain. I am looking for a
>program that I can call that will list/page through spool files and then
>will retrieve the Job Name, User ID, Job Number and Spool File number.
>
>Even something close would be a help.
>
>Pete Helgren
>
>
>
As an Amazon Associate we earn from qualifying purchases.
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.
