|
midrange.com
Time to make Trial 2 into a client/server. Well, I may be abusing the
context of the phrase, but that's what we're doing. We're going to turn
AG02 (the List member API) into a service program. This will provide (for
now) the single service of filling an array with list member information.
The client will be AG03, our "mainline" or controlling code.
Rather than re-use AG02 and 03, I'll copy AG02 into AG04, and copy AG03 into
AG05. This'll give me some new source members so I can leave the existing
code as-is for comparison purposes.
First, the service program, AG04. Converting this isn't much work really.
We need to make a prototype, a procedure interface and some binder source.
The PR:
* Return a single page of member name/text
* from specified source file
d getMbrList pr
d inpFile 10 value
d inpLib 10 value
d outMbrArray 60 dim(10)
I put this in a source member in QPROTOSRC so all my prototypes are in one
place. That makes it easier to search for them - sort of a
poor-programmer's library. I call it AG04. That way it's easy to tell what
prototype goes with what source member and which service program.
The PI:
p getMbrList b export
d getMbrList pi
d inpFile 10 value
d inpLib 10 value
d outMbrArray 60 dim(10)
This goes in right after the 'dbgview(*list)' comment line. You'll need to
drop a
' p e' line at the very end of the source member in
order to complete the procedure definition.
The last change is to remove the *ENTRY PLIST section. It's being replaced
by our PR.
The binder source is used to explicitly tell what we intend to make public
for this version of the code (there will be future versions, and we don't
want to re-compile clients that only need this primitive functionality.) I
put the binder source in QSRVSRC and call it AG04. Same name as everything
else. I'm not bright enough to remember a complex naming scheme so I make
everything the same!
STRPGMEXP PGMLVL(*CURRENT) SIGNATURE(' 1.00 08 Mar 02')
EXPORT SYMBOL(getMbrList)
ENDPGMEXP
To make it easy on everybody still interested, here's the complete RPG IV
source for AG04:
* Get an array of members using the list member API
h nomain
h debug option(*srcstmt: *nodebugio)
* crtmod dbgview(*list)
* CRTSRVPGM SRVPGM(AG04) ACTGRP('QILE')
d/copy qprotosrc,ag04
p getMbrList b export
d getMbrList pi
d inpFile 10 value
d inpLib 10 value
d outMbrArray 60 dim(10)
d* These "D" specs were copied from the IBM library QSYSINC
d* and then modified
D*******************************************************************
D*Type Definition for the Input Parameter Section of the user
D*space in the QUSLMBR API.
D*******************************************************************
DQUSQLI00 DS
Qdb Ldbm Input
D QUSSPACE00 1 10
Userspace
D QUSULIB00 11 20
Userspace Library
D SPC 1 20
combined
D QUSFN03 21 28
Format Name
D QUSFILN00 29 38
File Name
D QUSFILLN00 39 48
File Library Name
D QUSMN 49 58
Member Name
D QUSRRIDE00 59 59
Override
D*
D*******************************************************************
D*Type Definition for the MBRL0200 format of the userspace in the
D*QUSLBMR API.
D*******************************************************************
DQUSL0200 DS
Qdb Ldbm MBRL0200
D QUSMN01 1 10
Member Name
D QUSST 11 20
Source Type
D QUSCDT 21 33
Creation Date Time
D QUSLSDT 34 46
Last Source Date Tim
D QUSMD 47 96
Member Description
D QUSCCSID05 97 100i 0
Member Description C
D*
* Generic header
d GENHDR DS INZ
d USRARA 1 64
d SIZGEN 65 68i 0
d RLSLVL 69 72
d UFMTNM 73 80
d APIUSE 81 90
d DATTIM 91 103
d INFSTS 104 104
d SIZUSE 105 108i 0
d OFFINP 109 112i 0
d SIZINP 113 116i 0
d OFFHDR 117 120i 0
d SIZHDR 121 124i 0
d OFFLST 125 128i 0
d SIZLST 129 132i 0
d NUMLST 133 136i 0
d SIZENT 137 140i 0
d* Error code
d ERRRTC ds INZ
d ERRSIZ 1 4i 0 Inz(%size(ERRRTC))
d ERRAVL 5 8i 0
d ERRID 9 15
d SSTART s 10i 0
d SLEN s 10i 0
d qualFile s 20
d i s 10i 0
c* Name of space to hold list
c MOVEL(P) 'QUSLMBR ' QUSSPACE00
c MOVEL(P) 'QTEMP' QUSULIB00
c* Create user space to hold list
c CALL 'QUSCRTUS'
c PARM SPC
c PARM *BLANKS SPCATR 10
c PARM 100000 SPCSZE 10 0
c PARM x'00' SPCINT 1
c PARM '*ALL ' SPCAUR 10
c PARM *BLANKS SPCTXT 50
c PARM '*YES ' SPCRPL 10
c PARM ERRRTC
c* Check for errors
c If ErrID<>*Blanks
c Dump
c Goto EndofPgm
c Endif
c* Set up parms for spooled file list API
c eval QUSFN03 = 'MBRL0200'
c eval qualFile = inpFile + inpLib
c eval QUSMN = '*ALL'
c eval QUSRRIDE00 = '0'
c* Put the list into the space
c CALL 'QUSLMBR'
c PARM SPC
c PARM QUSFN03
c PARM QualFile
c PARM QUSMN
c PARM QUSRRIDE00
c PARM ERRRTC
c* Check for errors
c If ErrID<>*Blanks
c Dump
c Goto EndofPgm
c Endif
c* Determine how many entries,
c* where they begin
c* by examining the generic header
c*
c Z-ADD 1 SSTART
c Eval SLEN=%size(GENHDR)
c*
c CALL 'QUSRTVUS'
c PARM SPC
c PARM SSTART
c PARM SLEN
c PARM GENHDR
c PARM ERRRTC
c* Check for errors
c If ErrID<>*Blanks
c Dump
c Goto EndofPgm
c Endif
* Did the list fit in the space? (list complete)
c if INFSTS <> 'C'
c 'Not complete'Dump
c Goto EndofPgm
c endif
c* Working offset will be changed in the loop, but for the start, point
to the list and
c* retrieve "list entry size" bytes
c OFFLST ADD 1 SSTART
c eval slen = SIZENT
* Did the API return more data than my structure can hold?
* maybe the API returns more information in this release...
c if SIZENT > %size(QUSL0200)
c 'API struc' Dump
c endif
c* Extract list from user space 1 at a time
c DO NUMLST i
c CALL 'QUSRTVUS'
c PARM SPC
c PARM SSTART
c PARM SLEN
c PARM QUSL0200
c PARM ERRRTC
c* Check for errors
c If ErrID<>*Blanks
c Dump
c Goto EndofPgm
c Endif
* Load as far as the array and no farther
c if i <= %elem(outMbrArray)
c movel QUSMN01 outMbrArray(i)
c move QUSMD outMbrArray(i)
c else
c leave
c endif
c* Next entry
c ADD SIZENT SSTART
c ENDDO
c EndofPgm Tag
c return
p e
Compile this with PDM option 15 - CRTRPGMOD. Then create the service
program with CRTSRVPGM ACTGRP('QILE'). Because I have a bad memory, I put
special compiler options and the lot in comment lines after my
H-specifications. Then I can use the Windows copy/paste commands to put
them on the command line. So when taking PDM option 15, I paste
'dbgview(*list)' on the command line before I press Enter. This means I
don't have to prompt the command and try to locate the right panel to make
the change on. It works best when I'm re-compiling several modules at the
same time.
That's our service program. It has one function that the outside world can
use: getMbrList. When I say 'outside world', I mean code outside of the
service program. We'll add more functions later.
Now for the client; the mainline code (Has ANYBODY got a better name for
this?)
AG05 needs a copy of the prototype (the compiler is strongly typed, so it
wants to know the specifics of the parameter list to make sure we're using
the procedure right.) Because the prototype is in a /COPY member, referring
to it is as easy as
d/copy qprotosrc,ag04
before the D-specifications.
In the loadSfl subroutine, we need to replace the CALL/PARM with
c callp getMbrList(wname: wlib: array)
For convenience, here is the complete source for AG05:
* Work with a single page of source members
h debug option(*srcstmt: *nodebugio)
* crtrpgmod ag05 dbgview(*list)
* crtpgm ag05 bndsrvpgm(*libl/ag04) dftactgrp(*no) actgrp(QILE)
fag03 cf e workstn
f SFILE(mbrsfl:dspRRN)
* get the prototype definitions for member service program
d/copy qprotosrc,ag04
d dspRRN s 4s 0
d array s 60 dim(10)
d i s 10i 0
d sds
d tmname 244 253
* initial display
c seton 42
sfldspctl
c setoff 41
sfldsp
c setoff 30
alarm
c exfmt mbrctl
* continue to display
c dow *in03 = *off
c exsr loadSfl
c exfmt mbrctl
* see what option was chosen
c if *in41 = *on
sfldsp
c do 10 dspRRN
c dspRRN chain mbrsfl
c if %found
c select
c when wopt = 'P'
c call(e) 'AG01CL'
c parm wname
c parm wlib
c parm wmbr
c endsl
c eval wopt = *blank
c update mbrsfl
c endif
c enddo
c endif
c exfmt mbrctl
c enddo
c seton lr
c loadSfl begsr
* clear the existing page
c setoff 42
sfldspctl
c seton 40
sflclr
c write mbrctl
c setoff 40
sflclr
c setoff 41
sfldsp
c seton 42
sfldspctl
c eval dspRRN = 0
* get the list
c callp getMbrList(wname: wlib: array)
* load a single page - artificially stupid to make the code simple
c do 10 i
c eval dspRRN = dspRRN + 1
c movel array(i) wmbr
c move array(i) wtext
c write mbrsfl
c seton 41
sfldsp
c enddo
c endsr
Compile this with PDM option 15 and then create the program with CRTPGM ag05
bndsrvpgm(*libl/ag04) dftactgrp(*no) actgrp(QILE). This will create a
program object that will refer to the service program AG04. When you CALL
AG05 for the first time, not only will AG05 activate, but AG04 will, too.
All of the storage for AG04 and 05 will get initialised, default file opens
will occur, etc. Should I detail that 'etc.' or has everyone read the ILE
Concepts manual? It's at
http://publib.boulder.ibm.com/pubs/html/as400/v5r1/ic2924/books/c415606502.h
tm#ToC or http://makeashorterlink.com/?Y3165148 Activation is discussed in
Chapter 3.
The client (AG05) and service program (AG04) both run in AG('QILE'). This
means that no matter how many times you call them during the say, they will
be activated just once; initialised just once, etc. Unless you issue a
RCLACTGEP('QILE'). Since you know the name of the AG, you can clean up just
this one AG and leave others (like GL or AP) intact for this job. Something
to think about: Does this application need shared storage/overrides or will
it run correctly (produce the proper output) if it didn't? If AG04 ran in a
different AG than AG05, would it make a difference in terms of the output of
AG05? Test your assumptions by re-creating them to run in separate AGs.
I'll give you a chance to get these two compiled and tested (CALL AG05)
before posting the next bit; Trial 3, in which AG05 becomes *NEW and AG04
becomes *CALLER.
--buck
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.
