QWVOLAGP & QWVOLACT -Open list of activation group & - attributes
**
** Program . . : CBX130
** Description : Analyze activation groups command
** Author . . : Carsten Flensburg
** Published . : Club Tech iSeries Programming Tips Newsletter
** Date . . . : February 10, 2005
**
**
** Program summary
** ---------------
**
** Work managemeny APIs:
** QWVOLAGP Open list of Generates a list of all the
** activation group activation groups that are
** attributes associated with a given job and
** their attributes.
**
** QWVOLACT Open list of Generates a list of all the
** activation activation attributes that are
** attributes associated with an activation
** group in a given job.
**
** Open list APIs:
** QGYCTLE Get list entries To retrieve open lists entries
** from an already open list the
** QGYGTLE (Get List Entries) API
** is available.
**
** QGYCLST Close list This API closes the previously
** opened list identified by the
** request handle parameter.
** Storage allocated is freed.
**
**
** Message handling API:
** QMHSNDPM Send program message Sends a message to a program stack
** entry (current, previous, etc.) or
** an external message queue.
**
** Both messages defined in a message
** file and immediate messages can be
** used. For specific message types
** only one or the other is allowed.
**
** Programmer's notes:
** Prior to V5R3 all Open List APIs are found in the QGY library.
** To run this program at V5R2 and earlier, library QGY needs to be
** in the job's library list.
**
** Open List APIs are located in option 12 - 'Host Servers' - of the
** operation system, and this option needs to be installed for these
** APIs to be available. Running the command DSPSFWRSC enables you
** to verify the presence of this option.
**
**
** Compile and setup instructions:
** CrtRpgMod Module( CBX130 )
** DbgView( *NONE )
** Aut( *USE )
**
** CrtPgm Pgm( CBX130 )
** Module( CBX130 )
** ActGrp( *NEW )
** Aut( *USE )
**
**
**-- Control specification: --------------------------------------------**
H Option( *SrcStmt: *NoDebugIo ) DecEdit( *JobRun )
**-- Printer file:
FQSYSPRT O F 132 Printer InfDs( PrtLinInf ) OflInd( *InOf )
**-- System information:
D PgmSts SDs Qualified
D PgmNam *Proc
D JobNam 26a Overlay( PgmSts: 244 )
D CurJob 10a Overlay( PgmSts: 244 )
D UsrPrf 10a Overlay( PgmSts: 254 )
D JobNbr 6a Overlay( PgmSts: 264 )
D CurUsr 10a Overlay( PgmSts: 358 )
**-- Printer file information:
D PrtLinInf Ds Qualified
D OvfLin 5i 0 Overlay( PrtLinInf: 188 )
D CurLin 5i 0 Overlay( PrtLinInf: 367 )
D CurPag 5i 0 Overlay( PrtLinInf: 369 )
**-- API error data structure:
D ERRC0100 Ds Qualified
D BytPrv 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 128a
**-- Global variables:
D LstTim s 6s 0
D AutFlg s 1a
**
D JobNam_q Ds Qualified
D JobNam 10a
D UsrPrf 10a
D JobNbr 6a
**-- List fields:
D JobNam s 10a
D UsrPrf s 10a
D JobNbr s 6a
**
D ActGrpNam s 10a
D ActGrpNbr s 10i 0
D NbrActs s 10i 0
D NbrHeaps s 10i 0
D StcStgSiz s 10i 0
D HeapStgSiz s 10i 0
D RootPgmNam s 10a
D RootPgmLib s 10a
D RootPgmTyp s 10a
D ActGrpStt s 8a
D ShrActGrp s 5a
D GrpInUse s 5a
**
D AtrActNbr s 10i 0
D AtrStcStg s 10i 0
D ActPgmNam s 10a
D ActPgmLib s 10a
D ActPgmTyp s 10a
**-- Global constants:
D OFS_MSGDTA c 16
**-- API parameters:
D RtnRcdNbr s 10i 0 Dim( 2 )
**-- Activation group information:
D RAGA0100 Ds Qualified
D ActGrpNam 10a
D 6a
D ActGrpNbr 10i 0
D NbrActs 10i 0
D NbrHeaps 10i 0
D StcStgSiz 10i 0
D HeapStgSiz 10i 0
D RootPgmNam 10a
D RootPgmLib 10a
D RootPgmTyp 1a
D ActGrpStt 1a
D ShrActGrpInd 1a
D InUseInd 1a
D 4a
**-- Activation attribute information:
D RACT0100 Ds Qualified
D ActGrpNam 10a
D 6a
D ActGrpNbr 10i 0
D 10i 0
D ActNbr 10i 0
D StcStgSiz 10i 0
D ActPgmNam 10a
D ActPgmLib 10a
D ActPgmTyp 1a
D 11a
**-- List information:
D LstInf Ds Qualified Dim( 2 )
D RcdNbrTot 10i 0
D RcdNbrRtn 10i 0
D Handle 4a
D RcdLen 10i 0
D InfSts 1a
D Dts 13a
D LstSts 1a
D 1a
D InfLen 10i 0
D Rcd1 10i 0
D 40a
**-- Open list of activation group attributes:
D LstActGrpA Pr ExtPgm( 'QWVOLAGP' )
D LaRcvVar 65535a Options( *VarSize )
D LaRcvVarLen 10i 0 Const
D LaLstInf 80a
D LaNbrRcdRtn 10i 0 Const
D LaFmtNam 10a Const
D LaJobNam_q 10a Const
D LaIntJobId 16a Const
D LaError 1024a Options( *VarSize )
**-- Open list of activation attributes:
D LstActAtr Pr ExtPgm( 'QWVOLACT' )
D LaRcvVar 65535a Options( *VarSize )
D LaRcvVarLen 10i 0 Const
D LaLstInf 80a
D LaNbrRcdRtn 10i 0 Const
D LaFmtNam 10a Const
D LaActGrpNbr 10i 0 Const
D LaJobNam_q 10a Const
D LaIntJobId 16a Const
D LaError 1024a Options( *VarSize )
**-- Get list entry:
D GetLstEnt Pr ExtPgm( 'QGYGTLE' )
D GlRcvVar 65535a Options( *VarSize )
D GlRcvVarLen 10i 0 Const
D GlHandle 4a Const
D GlLstInf 80a
D GlNbrRcdRtn 10i 0 Const
D GlRtnRcdNbr 10i 0 Const
D GlError 1024a Options( *VarSize )
**-- Close list:
D CloseLst Pr ExtPgm( 'QGYCLST' )
D ClHandle 4a Const
D ClError 1024a Options( *VarSize )
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D SpMsgId 7a Const
D SpMsgFq 20a Const
D SpMsgDta 128a Const
D SpMsgDtaLen 10i 0 Const
D SpMsgTyp 10a Const
D SpCalStkE 10a Const Options( *VarSize )
D SpCalStkCtr 10i 0 Const
D SpMsgKey 4a
D SpError 32767a Options( *VarSize )
**-- Write activation group detail line:
D WrtActGrpLin Pr
**-- Write activation attribute detail line:
D WrtActAtrLin Pr
**-- Write list header:
D WrtLstHdr Pr
D PxOvrFlwRel 10i 0 Const Options( *NoPass )
**-- Write group header:
D WrtGrpHdr Pr
**-- Write list trailer:
D WrtLstTrl Pr
**-- Send completion message:
D SndCmpMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- Send escape message:
D SndEscMsg Pr 10i 0
D PxMsgId 7a Const
D PxMsgF 10a Const
D PxMsgDta 512a Const Varying
D CBX130 Pr
D PxJobNam_q LikeDs( JobNam_q )
D PxActGrp 10a
**
D CBX130 Pi
D PxJobNam_q LikeDs( JobNam_q )
D PxActGrp 10a
/Free
If PxJobNam_q = '*';
PxJobNam_q = PgmSts.JobNam;
EndIf;
RtnRcdNbr(1) = 1;
LstActGrpA( RAGA0100
: %Size( RAGA0100 )
: LstInf(1)
: 1
: 'RAGA0100'
: PxJobNam_q
: *Blanks
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
If ERRC0100.BytAvl < OFS_MSGDTA;
ERRC0100.BytAvl = OFS_MSGDTA;
EndIf;
SndEscMsg( ERRC0100.MsgId
: 'QCPFMSG'
: %Subst( ERRC0100.MsgDta: 1: ERRC0100.BytAvl - OFS_MSGDTA )
);
Else;
DoW LstInf(1).LstSts <> '2' Or
LstInf(1).RcdNbrTot >= RtnRcdNbr(1);
If PxActGrp = '*ALL' Or PxActGrp = RAGA0100.ActGrpNam;
WrtLstHdr();
WrtGrpHdr();
ExSr GetActAtr;
EndIf;
RtnRcdNbr(1) += 1;
GetLstEnt( RAGA0100
: %Size( RAGA0100 )
: LstInf(1).Handle
: LstInf(1)
: 1
: RtnRcdNbr(1)
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Leave;
EndIf;
EndDo;
If PrtLinInf.CurLin = *Zero;
WrtLstHdr();
EndIf;
WrtLstTrl();
CloseLst( LstInf(1).Handle: ERRC0100 );
SndCmpMsg( 'List has been printed.' );
EndIf;
*InLr = *On;
Return;
BegSr GetActAtr;
RtnRcdNbr(2) = 1;
LstActAtr( RACT0100
: %Size( RACT0100 )
: LstInf(2)
: 1
: 'RACT0100'
: RAGA0100.ActGrpNbr
: PxJobNam_q
: *Blanks
: ERRC0100
);
If ERRC0100.BytAvl = *Zero;
DoW LstInf(2).LstSts <> '2' Or
LstInf(2).RcdNbrTot >= RtnRcdNbr(2);
WrtActAtrLin();
RtnRcdNbr(2) += 1;
GetLstEnt( RACT0100
: %Size( RACT0100 )
: LstInf(2).Handle
: LstInf(2)
: 1
: RtnRcdNbr(2)
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Leave;
EndIf;
EndDo;
CloseLst( LstInf(2).Handle: ERRC0100 );
EndIf;
EndSr;
BegSr *InzSr;
LstTim = %Int( %Char( %Time(): *ISO0));
PrtLinInf.CurLin = *Zero;
PrtLinInf.CurPag = *Zero;
EndSr;
/End-Free
**-- Printer file definition: ------------------------------------------**
OQSYSPRT EF Header 2 2
O UDATE Y 8
O LstTim 18 ' : : '
O 75 'Job activation group attri-
O butes'
O 107 'Program:'
O PgmSts.PgmNam 118
O 126 'Page:'
O PAGE + 1
**
OQSYSPRT EF LstHdr 2
O 16 'Job name . . . :'
O JobNam 28
O 46 'User . . . . . :'
O UsrPrf 58
O 76 'Number . . . . :'
O JobNbr 84
O 114 'Activation group . . . :'
O PxActGrp 126
**
OQSYSPRT EF ActGrpHdr 1
O 10 'Group name'
O 21 'Number'
O 34 'Activations'
O 43 'Heaps'
O 56 'Static stg.'
O 67 'Heap stg.'
O 81 'Root program'
O 95 'Root library'
O 106 'Root type'
O 114 'State'
O 124 'Shared'
O 132 'In use'
**
OQSYSPRT EF ActGrpLin 1
O ActGrpNam 10
O ActGrpNbr 3 21
O NbrActs 3 32
O NbrHeaps 3 43
O StcStgSiz 3 55
O HeapStgSiz 3 66
O RootPgmNam 79
O RootPgmLib 93
O RootPgmTyp 107
O ActGrpStt 117
O ShrActGrp 123
O GrpInUse 132
**
OQSYSPRT EF ActAtrHdr 1 1
O 17 'Activation nbr.'
O 31 'Static stg.'
O 41 'Program'
O 53 'Library'
O 62 'Type'
**
OQSYSPRT EF ActAtrLin 1
O AtrActNbr 3 12
O AtrStcStg 1 29
O ActPgmNam 44
O ActPgmLib 56
O ActPgmTyp 68
**
OQSYSPRT EF DtlBlk 1
**
OQSYSPRT EF LstTrl 1
O 40 '*** E N D O F L I S T -
O ***'
**-- Write list header: ------------------------------------------------**
P WrtLstHdr B
D Pi
D PxOvrFlwRel 10i 0 Const Options( *NoPass )
/Free
JobNam = PxJobNam_q.JobNam;
UsrPrf = PxJobNam_q.UsrPrf;
JobNbr = PxJobNam_q.JobNbr;
If %Parms = *Zero;
Except Header;
Except LstHdr;
Else;
If PrtLinInf.CurLin > PrtLinInf.OvfLin - PxOvrFlwRel;
Except Header;
Except LstHdr;
WrtGrpHdr();
EndIf;
EndIf;
/End-Free
P WrtLstHdr E
**-- Write group header: -----------------------------------------------**
P WrtGrpHdr B
D Pi
/Free
Except ActGrpHdr;
WrtActGrpLin();
Except ActAtrHdr;
/End-Free
P WrtGrpHdr E
**-- Write activation group detail line: -------------------------------**
P WrtActGrpLin B
D Pi
/Free
WrtLstHdr( 3 );
ActGrpNam = RAGA0100.ActGrpNam;
ActGrpNbr = RAGA0100.ActGrpNbr;
NbrActs = RAGA0100.NbrActs;
NbrHeaps = RAGA0100.NbrHeaps;
StcStgSiz = RAGA0100.StcStgSiz;
HeapStgSiz = RAGA0100.HeapStgSiz;
RootPgmNam = RAGA0100.RootPgmNam;
RootPgmLib = RAGA0100.RootPgmLib;
Select;
When RAGA0100.RootPgmTyp = 'N';
RootPgmTyp = '*DLT';
When RAGA0100.RootPgmTyp = '0';
RootPgmTyp = '*PGM';
When RAGA0100.RootPgmTyp = '1';
RootPgmTyp = '*SRVPGM';
When RAGA0100.RootPgmTyp = '2';
RootPgmTyp = '*JAVA';
Other;
RootPgmTyp = *Blanks;
EndSl;
Select;
When RAGA0100.ActGrpStt = '0';
ActGrpStt = '*USER';
When RAGA0100.ActGrpStt = '1';
ActGrpStt = '*SYSTEM';
Other;
ActGrpStt = *Blanks;
EndSl;
Select;
When RAGA0100.ShrActGrpInd = '0';
ShrActGrp = '*YES';
When RAGA0100.ShrActGrpInd = '1';
ShrActGrp = '*NO';
EndSl;
Select;
When RAGA0100.InUseInd = '0';
GrpInUse = '*NO';
When RAGA0100.InUseInd = '1';
GrpInUse = '*YES';
EndSl;
Except ActGrpLin;
/End-Free
P WrtActGrpLin E
**-- Write activation attribute detail line: ---------------------------**
P WrtActAtrLin B
D Pi
/Free
WrtLstHdr( 3 );
AtrActNbr = RACT0100.ActNbr;
AtrStcStg = RACT0100.StcStgSiz;
ActPgmNam = RACT0100.ActPgmNam;
ActPgmLib = RACT0100.ActPgmLib;
Select;
When RACT0100.ActPgmTyp = '0';
ActPgmTyp = '*PGM';
When RACT0100.ActPgmTyp = '1';
ActPgmTyp = '*SRVPGM';
Other;
ActPgmTyp = *Blanks;
EndSl;
Except ActAtrLin;
/End-Free
P WrtActAtrLin E
**-- Write list trailer: -----------------------------------------------**
P WrtLstTrl B
D Pi
/Free
Except LstTrl;
/End-Free
P WrtLstTrl E
**-- Send completion message: ------------------------------------------**
P SndCmpMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
/Free
SndPgmMsg( 'CPF9897'
: 'QCPFMSG *LIBL'
: PxMsgDta
: %Len( PxMsgDta )
: '*COMP'
: '*PGMBDY'
: 1
: MsgKey
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return -1;
Else;
Return 0;
EndIf;
/End-Free
**
P SndCmpMsg E
**-- Send escape message: ----------------------------------------------**
P SndEscMsg B
D Pi 10i 0
D PxMsgId 7a Const
D PxMsgF 10a Const
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
/Free
SndPgmMsg( PxMsgId
: PxMsgF + '*LIBL'
: PxMsgDta
: %Len( PxMsgDta )
: '*ESCAPE'
: '*PGMBDY'
: 1
: MsgKey
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return -1;
Else;
Return 0;
EndIf;
/End-Free
P SndEscMsg E
阅读(1031) | 评论(0) | 转发(0) |
