<pre> <b> File : QRPGLESRC Member : PRTLMTCMD Type : RPGLE Usage : CRTBNDRPG PGM(PRTLMTCMD) TGTRLS(V5R1M0) </b> ** ** Program . . : PrtLmtCmd ** Description : Print Allow Limit User Command ** Author . . : Vengoal Chang ** ** Input parameters ** Description Type Size How Used ** ----------- ---- ---- -------- ** InLibary Char 10 Library to search for objects ** ** ** Compile options: ** ** CrtBndRpg Pgm( PrtLmtCmd ) ** DbgView( *LIST ) TgtRls(V5R1M0) ** ** **-- Header Specifications: --------------------------------------------** H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*NEW) FQSYSPRT O F 132 Printer * * Program Info * d SDS d @PGM 1 10 d @PARMS 37 39 0 d @JOB 244 253 d @USER 254 263 d @JOB# 264 269 0 * * Field Definitions. * d AllText s 10 Inz('*ALL') d CmdString s 256 d CmdLength s 15 5 d Count s 4 0 d Format s 8 d GenLen s 8 d InLibrary s 10 d InType s 10 inz('*CMD') d ObjectLib s 20 d SpaceVal s 1 inz(*BLANKS) d SpaceAuth s 10 inz('*CHANGE') d SpaceText s 50 inz(*BLANKS) d SpaceRepl s 10 inz('*YES') d SpaceAttr s 10 inz(*BLANKS) d UserSpaceOut s 20 ? * ? ? * Data structures ? ? * ? d GENDS ds d OffsetHdr 1 4i 0 d NbrInList 9 12i 0 d SizeEntry 13 16i 0 * * Create userspace datastructure * d DS d StartPosit 10i 0 d StartLen 10i 0 d SpaceLen 10i 0 * * Date structure for retriving userspace info * d InputDs DS d UserSpace 1 20 d SpaceName 1 10 d SpaceLib 11 20 d InpFileLib 29 48 d InpFFilNam 29 38 d InpFFilLib 39 48 d InpRcdFmt 49 58 * d ObjectDs ds d Object 10 d Library 10 d ObjectType 10 d InfoStatus 1 d ExtObjAttrib 10 d Description 50 **-- API Error Data Structure: D ERRC0100 Ds Qualified Inz D BytPrv 10i 0 Inz( %Size( ERRC0100 )) D BytAvl 10i 0 D MsgId 7a D 1a D MsgDta 1024a **-- Global constants: D OFS_MSGDTA c 16 **-- Command information: D CMDI0100 Ds 10240 Qualified Inz D BytRtn 10i 0 D BytAvl 10i 0 D CmdNam_q 20a D CmdNam 10a Overlay( CmdNam_q: 1 ) D CmdLib 10a Overlay( CmdNam_q: 11 ) D CmdPgm_q 20a D PgmNam 10a Overlay( CmdPgm_q: 1 ) D PgmLib 10a Overlay( CmdPgm_q: 11 ) D SrcFil 10a D SrcLib 10a D SrcMbr 10a D VcpNam 10a D VcpLib 10a D ModeInf 10a D AlwInf 15a D AlwLmtUsr 1a D MaxPos 10i 0 D PmtMsfNam 10a D PmtMsfLib 10a D MsgFilNam 10a D MsgFilLib 10a D HlpPngNam 10a D HlpPngLib 10a D HlpId 10a D SchIdxNam 10a D SchIdxLib 10a D CurLib 10a D PrdLib 10a D PopNam 10a D PopLib 10a D RstTgtRls 6a D TxtDsc 50a D CppCalStt 2a D VcpCalStt 2a D PopCalStt 2a D OfsHlpBks 10i 0 D LenHlpBks 10i 0 D CcsId 10i 0 D EnbGui 1a D ThdSafInd 1a D MltJobAcn 1a D PxyCmdInd 1a D 14a **-- Retrieve command information: D RtvCmdInf Pr ExtPgm( 'QCDRCMDI' ) D RcvVar 65535a Options( *VarSize ) D RcvVarLen 10i 0 Const D FmtNam 10a Const D CmdNam_q 20a Const D Error 32767a Options( *VarSize ) **-- Send program message: D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' ) D MsgId 7a Const D MsgFil_q 20a Const D MsgDta 128a Const D MsgDtaLen 10i 0 Const D MsgTyp 10a Const D CalStkE 10a Const Options( *VarSize ) D CalStkCtr 10i 0 Const D MsgKey 4a D Error 32767a Options( *VarSize ) **-- Send completion message: D SndCmpMsg Pr 10i 0 D PxMsgId 7a Const D PxMsgFil 10a Const D PxMsgDta 512a Const Varying **-- Parameter definitions: D ObjNam_q Ds Qualified D ObjNam 10a D ObjLib 10a D ERRMSGID S 7a D firstRcd S N INZ('1') D matchRcd S N ? * ? * Create a userspace * c exsr $QUSCRTUS * c eval ObjectLib = AllText + InLibrary * * List all the objects to the user space * c eval Format = 'OBJL0200' * c call(e) 'QUSLOBJ' c parm Userspace UserSpaceOut c parm Format c parm ObjectLib c parm '*CMD' InType * * Retrive header entry and process the user space * c eval StartPosit = 125 c eval StartLen = 16 * * Retrive header entry and process the user space * c call 'QUSRTVUS' c parm UserSpace UserSpaceOut c parm StartPosit c parm StartLen c parm GENDS * c eval StartPosit = OffsetHdr + 1 c eval StartLen = %size(ObjectDS) * * ? * Do for number of fields ? * c if NbrInList > 0 B1 c Do NbrInList * c call(e) 'QUSRTVUS' c parm UserSpace UserSpaceOut c parm StartPosit c parm StartLen c parm ObjectDs * c eval ObjNam_q.ObjLib = Library c eval ObjNam_q.ObjNam = Object c c callp RtvCmdInf( CMDI0100 c : %Size( CMDI0100 ) c : 'CMDI0100' c : ObjNam_q c : ERRC0100 c ) c If ERRC0100.BytAvl > *Zero c c If ERRC0100.BytAvl < OFS_MSGDTA c eval ERRC0100.BytAvl = OFS_MSGDTA c EndIf c eval ErrMsgId = ERRC0100.MsgId c If ErrMsgId <> 'CPF6250' c except error c EndIf c Else c If (CMDI0100.AlwLmtUsr = '1') c If firstRcd c except head c eval firstRcd = *Off c eval matchRcd = *On c EndIf c except detail c EndIf c EndIf c eval StartPosit = StartPosit + SizeEntry c EndDo c EndIf c If matchRcd c callp SndCmpMsg( 'CPF9898' c :'QCPFMSG' c :'Print allow limit user command' + c ' on library ' + %trim(InLibrary)+ c ' completed' c ) c Else c callp SndCmpMsg( 'CPF9898' c :'QCPFMSG' c :'Library ' + %trim(InLibrary) + c ' no any allow limit user command' c ) c EndIf * c eval *Inlr = *On *=============================================== * $QUSCRTUS - API to create user space *=============================================== c $QUSCRTUS begsr * * Create a user space named ListObjects in QTEMP. * c movel(p) 'LISTOBJECTS' SpaceName c movel(p) 'QTEMP' SpaceLib * * Create the user space * c call(e) 'QUSCRTUS' c parm UserSpace UserSpaceOut c parm SpaceAttr c parm 4096 SpaceLen c parm SpaceVal c parm SpaceAuth c parm SpaceText c parm SpaceRepl c parm ERRC0100 * c endsr *================================================= * *Inzsr - One time run House keeping subroutine *================================================= c *Inzsr begsr * c *entry plist c parm InLibrary * c endsr *============================================== OQSYSPRT E HEAD 1 O 28 'Allow Limit User Command' O E HEAD 1 O 12 'Library' O 24 'Command' O E detail 1 O Library B 15 O Object B 27 O E error 1 O Library B 15 O Object B 27 O ERRMSGID B 37 **-- Send completion message: P SndCmpMsg B D Pi 10i 0 D PxMsgId 7a Const D PxMsgFil 10a Const D PxMsgDta 512a Const Varying ** D MsgKey s 4a /Free SndPgmMsg( PxMsgId : PxMsgFil + '*LIBL' : PxMsgDta : %Len( PxMsgDta ) : '*COMP' : '*PGMBDY' : 1 : MsgKey : ERRC0100 ); If ERRC0100.BytAvl > *Zero; Return -1; Else; Return 0; EndIf; /End-Free P SndCmpMsg E <b> File : QCMDSRC Member : PRTLMTCMD Type : CMD Usage : CRTCMD CMD(PRTLMTCMD) PGM(PRTLMTCMD) </b> /* =============================================================== */ /* = Command....... PrtLmtCmd = */ /* = CPP........... PrtLmtCmd = */ /* = Description... Print allow limit user command = */ /* = = */ /* = CrtCmd Cmd( PrtLmtCmd ) = */ /* = Pgm( PrtLmtCmd ) = */ /* = SrcFile( YourSourceFile ) = */ /* = = */ /* =============================================================== */ /* = Date : 2008/07/18 = */ /* = Author: Vengoal Chang = */ /* =============================================================== */ Cmd Prompt( 'Print Allow Limit User Command' ) PARM KWD(LIB) TYPE(*CHAR) LEN(10) MIN(1) + EXPR(*YES) PROMPT('Library') </pre>