使用 API Open List of Objects (QGYOLOBJ) API 列出損壞的物件(object damaged) -- Command DSPOBJDMG
File : QRPGLESRC
Member: DSPOBJDMG
Type : RPGLE
Usage : CRTBNDRPG DSPOBJDMG
**
** Program . . : DSPOBJDMGR
** Description : Display Object Damage - CPP
** Author . . : Vengoal Chang
** Published . : AS400ePaper
** Date . . . : January 25, 2013
**
**
** Program summary
** ---------------
**
** Work management APIs:
** QGYOLOBJ Open List of Objects List of object names based on the
** specified selection criteria.
**
** Optionally a sort order for the
** returned objects can be specified.
**
** The QGYOLOBJ API is found in the
** QGY library as are all other open
** list APIs. From V5R3 open list
** APIs are part of QSYS.
**
** To retrieve open lists entries
** from an already open list the
** QGYGTLE (Get List Entries) API
** is available.
**
** Open list APIs:
** QGYGTLE 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.
**
** Message handling API:
** QMHSNDM Send message Sends a message to the specified
** non-program message queue - here
** an informational message is sent
** to the current user running this
** program.
**
** 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 note:
** As mentioned above library QGY must be in the job library list
** to succesfully run this program if on release V5R2 or earlier.
**
**
** Compile options:
** CrtBndRpg Pgm( DSPOBJDMG )
** DbgView( *LIST )
**
**
**-- Header specifications: --------------------------------------------**
H Option( *SrcStmt ) DftActGrp(*NO) Debug
**-- 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 constants:
D OFS_MSGDTA c 16
D CHAR_NLS c 4
D SORT_ASC c '1'
**-- Global variables:
D ObjNam_q Ds
D ObjNam 10a
D ObjLib 10a
D MsgQ_q Ds
D MsgQNam 10a Inz('QSYSOPR')
D MsgQLib 10a Inz('*LIBL')
D TempStr S 512a
D DmgCnt S 10i 0
**-- List API parameters:
D LstApi Ds Qualified Inz
D RtnRcdNbr 10i 0 Inz( 0 )
D NbrKeyRtn 10i 0 Inz( 1 )
D KeyFld 10i 0 Dim( 1 )
**-- Object information:
D ObjInf Ds 4096 Qualified
D ObjNam_q 20a
D ObjNam 10a Overlay( ObjNam_q: 1 )
D ObjLib 10a Overlay( ObjNam_q: *Next )
D ObjTyp 10a
D InfSts 1a
D 1a
D FldNbrRtn 10i 0
D Data Like( KeyInf )
**-- Key information:
D KeyInf Ds Qualified Based( pKeyInf )
D FldInfLen 10i 0
D KeyFld 10i 0
D DtaTyp 1a
D 3a
D DtaLen 10i 0
D Data 256a
D Key0200 Ds Qualified
D InfSts 1a
D ExdObjAtr 10a
D TxtDesc 50a
D UsrDfnAtr 10a
D OrdInLibl 10i 0
D Resvd 5a
**-- Authority control:
D AutCtl Ds Qualified
D AutFmtLen 10i 0 Inz( %Size( AutCtl ))
D CalLvl 10i 0 Inz( 0 )
D DplObjAut 10i 0 Inz( 0 )
D NbrObjAut 10i 0 Inz( 0 )
D DplLibAut 10i 0 Inz( 0 )
D NbrLibAut 10i 0 Inz( 0 )
D 10i 0 Inz( 0 )
D ObjAut 10a Dim( 10 )
D LibAut 10a Dim( 10 )
**-- Selection control:
**-- Select all damaged objects
D SltCtl Ds
D SltFmtLen 10i 0 Inz( %Size( SltCtl ))
D SltOmt 10i 0 Inz( 0 )
D DplSts 10i 0 Inz( 20 )
D NbrSts 10i 0 Inz( 2 )
D 10i 0 Inz( 0 )
D Status 2a Inz( 'DP' )
**-- Sort information:
D SrtInf Ds Qualified
D NbrKeys 10i 0 Inz( 4 )
D SrtStr 12a Dim( 4 )
D KeyFldOfs 10i 0 Overlay( SrtStr: 1 )
D KeyFldLen 10i 0 Overlay( SrtStr: 5 )
D KeyFldTyp 5i 0 Overlay( SrtStr: 9 )
D SrtOrd 1a Overlay( SrtStr: 11 )
D Rsv 1a Overlay( SrtStr: 12 )
**-- List information:
D LstInf Ds Qualified
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 objects:
D LstObjs Pr ExtPgm( 'QGYOLOBJ' )
D RcvVar 65535a Options( *VarSize )
D RcvVarLen 10i 0 Const
D LstInf 80a
D NbrRcdRtn 10i 0 Const
D SrtInf 1024a Const Options( *VarSize )
D ObjNam_q 20a Const
D ObjTyp 10a Const
D AutCtl 1024a Const Options( *VarSize )
D SltCtl 1024a Const Options( *VarSize )
D NbrKeyRtn 10i 0 Const
D KeyFld 10i 0 Const Options( *VarSize ) Dim( 32 )
D Error 1024a Options( *VarSize )
**
D JobIdInf 256a Options( *NoPass: *VarSize )
D JobIdFmt 8a Const Options( *NoPass )
**
D AspCtl 256a Options( *NoPass: *VarSize )
**-- Get open list entry:
D GetOplEnt Pr ExtPgm( 'QGYGTLE' )
D RcvVar 65535a Options( *VarSize )
D RcvVarLen 10i 0 Const
D Handle 4a Const
D LstInf 80a
D NbrRcdRtn 10i 0 Const
D RtnRcdNbr 10i 0 Const
D Error 1024a Options( *VarSize )
**-- Close list:
D CloseLst Pr ExtPgm( 'QGYCLST' )
D Handle 4a Const
D Error 1024a Options( *VarSize )
**-- Send message:
D SndMsg Pr ExtPgm( 'QMHSNDM' )
D SmMsgId 7a Const
D SmMsgF_q 20a Const
D SmMsgDta 512a Const Options( *VarSize )
D SmMsgDtaLen 10i 0 Const
D SmMsgTyp 10a Const
D SmMsgQ_q 1000a Const Options( *VarSize )
D SmMsgQnbr 10i 0 Const
D SmMsgQrpy 20a Const
D SmMsgKey 4a
D SmError 512a Options( *VarSize )
D SmCcsId 10i 0 Const Options( *NoPass )
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D MsgId 7a Const
D MsgFq 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 text message:
D SndTxtMsg Pr 10i 0
D PxMsgTxt 512a Const Varying
D PxMsgQ_q 20a Const
**-- Send joblog message:
D SndLogMsg 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 DSPOBJDMG Pr
D PxObjNam_q LikeDs( ObjNam_q )
**
D DSPOBJDMG Pi
D PxObjNam_q LikeDs( ObjNam_q )
/Free
ExSr LodObjLst;
*InLr = *On;
Return;
BegSr LodObjLst;
ExSr InzApiPrm;
pKeyInf = %Addr(ObjInf.Data);
LstObjs( ObjInf
: %Size( ObjInf )
: LstInf
: -1
: SrtInf
: PxObjNam_q
: '*ALL'
: AutCtl
: SltCtl
: LstApi.NbrKeyRtn
: LstApi.KeyFld
: 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 )
);
EndIf;
If ERRC0100.BytAvl = *Zero And LstInf.RcdNbrRtn > *Zero;
DoW LstInf.RcdNbrTot > LstApi.RtnRcdNbr;
LstApi.RtnRcdNbr += 1;
GetOplEnt( ObjInf
: %Size( ObjInf )
: LstInf.Handle
: LstInf
: 1
: LstApi.RtnRcdNbr
: 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 )
);
Leave;
EndIf;
If (ObjInf.InfSts = 'D' or ObjInf.InfSts = 'P');
SndTxtMsg( '*** Object damaged: ' +
ObjInf.ObjLib + '/' + ObjInf.ObjNam
: MsgQ_q
);
dmgCnt += 1;
EndIf;
EndDo;
EndIf;
If (%SubSt(PxObjNam_q:1:4) = '*ALL');
SndTxtMsg( %char(dmgCnt) + ' damaged objects in library ' +
%trim(%SubSt(PxObjNam_q:11:10))
: MsgQ_q
);
Else;
SndTxtMsg( %char(dmgCnt) + ' damaged objects for object ' +
%trim(%SubSt(PxObjNam_q:11:10)) + '/' +
%trim(%SubSt(PxObjNam_q:1:10))
: MsgQ_q
);
EndIf;
CloseLst( LstInf.Handle: ERRC0100 );
EndSr;
BegSr InzApiPrm;
LstApi.KeyFld(1) = 0200;
SrtInf.NbrKeys = 2;
SrtInf.KeyFldOfs(1) = 1;
SrtInf.KeyFldLen(1) = %Size( ObjNam );
SrtInf.KeyFldTyp(1) = CHAR_NLS;
SrtInf.SrtOrd(1) = SORT_ASC;
SrtInf.Rsv(1) = x'00';
SrtInf.KeyFldOfs(2) = 11;
SrtInf.KeyFldLen(2) = %Size( ObjLib );
SrtInf.KeyFldTyp(2) = CHAR_NLS;
SrtInf.SrtOrd(2) = SORT_ASC;
SrtInf.Rsv(2) = x'00';
EndSr;
/End-Free
**-- 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
**-- Send text message: ------------------------------------------------**
P SndTxtMsg B
D Pi 10i 0
D PxMsgTxt 512a Const Varying
D PxMsgQ_q 20a Const
D MsgKey s 4a
/Free
SndMsg( 'CPF9898'
: 'QCPFMSG *LIBL '
: PxMsgTxt
: %Len( PxMsgTxt )
: '*INFO'
: PxMsgQ_q
: 1
: *Blanks
: MsgKey
: ERRC0100
);
SndLogMsg( PxMsgTxt );
If ERRC0100.BytAvl > *Zero;
Return -1;
Else;
Return 0;
EndIf;
/End-Free
P SndTxtMsg E
**-- Send joblog message: ----------------------------------------------**
P SndLogMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
D MsgKey s 4a
/Free
SndPgmMsg( 'CPF9898'
: 'QCPFMSG *LIBL '
: PxMsgDta
: %Len( PxMsgDta )
: '*INFO'
: '*EXT'
: *Zero
: MsgKey
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return -1;
Else;
Return 0;
EndIf;
/End-Free
**
P SndLogMsg E
File : QCMDSRC
Member: DSPOBJDMG
Type : CMD
Usage :
/*-------------------------------------------------------------------*/
/* */
/* Compile options: */
/* */
/* CrtCmd Cmd( DSPOBJDMG ) */
/* Pgm( DSPOBJDMG ) */
/* SrcMbr( DSPOBJDMG ) */
/* */
/*-------------------------------------------------------------------*/
Cmd Prompt( 'Display Object Damage' )
Parm OBJ Q0001 +
Min( 1 ) +
Choice( *NONE ) +
Prompt( 'Object' )
Q0001: Qual *Generic 10 +
Min( 1 ) +
SpcVal(( *ALL )) +
Expr( *YES ) +
Qual *Name 10 +
Min( 1 ) +
Expr( *YES ) +
Prompt( 'Library' )
run the command DSPOBJDMG will send message to joblog and MSGQ QSYSOPR
DSPOBJDMG OBJ(QIWS/*ALL)
0 damaged objects in library QIWS.
DSPOBJDMG OBJ(QIWS/QCUST*)
0 damaged objects for object QIWS/QCUST*.
If QIWS library have 1 object damaged:
DSPOBJDMG OBJ(QIWS/*ALL) will get following message:
*** Object damaged: QIWS/xxxOBJNAM.
1 damaged objects in library QIWS.
星期四, 11月 09, 2023
2013-01-30 使用 API Open List of Objects (QGYOLOBJ) API 列出損壞的物件(object damaged) -- Command DSPOBJDMG
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言