Check Daily Batch Jobs started or not
CHKBCHJOB CLP read file CHKBCHJOBP and check current time >= start time and current time < end time and chkflg ='Y',
then call API get the job active information, If job does not active, then send the job not acticve message to sysopr.
If job active, but status is MSGW, also send message to sysopr.
File : QDDSSRC
Member: CHKBCHJOBP
Type : PF
Usage : CrtPF File(CHKBCHJOBP)
A*****************************************************************
A* FUNCTION : CHKBCHJOB monitor batch job file
A* FILE : CHKBCHJOBP
A* AUTHOR : Vengoal Chang
A* DATE : 2018/12/03
A*****************************************************************
A UNIQUE
A R BCHJOBR TEXT('Batch job record')
A JOBNAME 10A COLHDG(' JOB NAME')
A JOBUSER 10A COLHDG(' USER')
A STRTIME 6S 0 COLHDG('start time')
A ENDTIME 6S 0 COLHDG('end time')
A CHKFLAG 1A COLHDG('check Y/N')
A NOTE 32O COLHDG('note')
A UPDDATE 8S 0 COLHDG('update date')
A UPDTIME 6S 0 COLHDG('update time')
A*----------------------------------------------------------------
A K JOBNAME
File : QCLSRC
Member: CHKBCHJOBC
Type : CLP
OS400 : V5R4 above
Usage : CrtClPgm Pgm(ChkBCHJOBC)
/* =============================================================== */
/* = Program ChkBchJobC = */
/* = ChkBchJob CLP = */
/* = Paramater notes: = */
/* = Read CHKBCHJOBP file to check daily job active or not = */
/* =============================================================== */
/* = Date : 2018/12/03 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
PGM
DCL &CURTIMEC *CHAR 6
DCL &STRTIMEC *CHAR 6
DCL &ENDTIMEC *CHAR 6
DCL &CURTIME *DEC (6 0)
DCL &MSGTEXT *CHAR 256
DCL &USP_NAME *CHAR 10
DCL &USP_LIB *CHAR 10
DCL &USP_QUAL *CHAR 20
DCL &USP_TYPE *CHAR 10
DCL &USP_SIZE *CHAR 4
DCL &USP_FILL *CHAR 1
DCL &USP_AUT *CHAR 10
DCL &USP_TEXT *CHAR 50
DCL &API_USQUAL *CHAR 20
DCL &API_JBQUAL *CHAR 26
DCL &API_JBNAM *CHAR 10
DCL &API_USER *CHAR 10
DCL &API_JOBNR *CHAR 6
DCL &API_STATUS *CHAR 10
DCL &STARTPOS *CHAR 4
DCL &DATALEN *CHAR 4
DCL &HEADER *CHAR 150
DCL &LST_OFFSET *DEC (10 0)
DCL &LST_SIZE *DEC (10 0)
DCL &LST_DATA *CHAR 4096
DCL &LST_NBR *DEC (5 0)
DCL &LST_LEN *DEC (5 0)
DCL &LST_LENBIN *CHAR 4
DCL &LST_POSBIN *CHAR 4
DCL &LST_COUNT *DEC (5 0) VALUE(0)
DCL &EXC_COUNT *DEC (5 0) VALUE(0)
DCL &TYPE *CHAR 1 VALUE('*')
DCL &NBRTORTN *CHAR 4
DCL &KEYSTORTN *CHAR 16
DCL &KEY1 *CHAR 4
DCL &KEY2 *CHAR 4
DCL &KEY3 *CHAR 4
DCL &KEY4 *CHAR 4
DCL &SBSSYS *CHAR 20
DCL &WRKSTS *CHAR 4
DCL &MSGRPLY *CHAR 1
DCL &USER *CHAR 10
DCL &CURUSR *CHAR 10
DCL &JOBNBR *CHAR 6
DCL &STATUS *CHAR 10
DCL &JOBTYPE *CHAR 1
DCL &SUBTYPE *CHAR 1
DCLF CHKBCHJOBP
MONMSG (CPF0000 MCH0000) *NONE GOTO ERROR
READF:
RCVF
MONMSG CPF0864 *N GOTO ENDF
RTVSYSVAL SYSVAL(QTIME) RTNVAR(&CURTIMEC)
CHGVAR &CURTIME &CURTIMEC
IF (&CURTIME >= &STRTIME *AND +
&CURTIME < &ENDTIME *AND +
&CHKFLAG = 'Y') Do
CallSubR SubR(ListJob)
If (&LST_NBR *EQ 0) Do
CHGVAR &STRTIMEC &STRTIME
CHGVAR &ENDTIMEC &ENDTIME
CHGVAR &MSGTEXT +
('* Bctch Job=' *CAT +
&JOBNAME *CAT 'run time : ' *CAT +
&STRTIMEC *BCAT '~' *BCAT &ENDTIMEC *CAT +
', program not started !')
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA(&MSGTEXT) TOMSGQ(*SYSOPR)
EndDo
EndDo
Goto READF
ENDF:
Return
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
/****************************************************************/
/* Sub routine ListJob */
/****************************************************************/
SUBR SUBR(ListJob)
CHGVAR VAR(%BIN(&NBRTORTN)) VALUE(4)
/* 0101 -- Ststus as WRKACTJOB */
CHGVAR VAR(%BIN(&KEY1 )) VALUE(0101)
/* 1906 -- Subsystem */
CHGVAR VAR(%BIN(&KEY2 )) VALUE(1906)
/* 1307 -- Message Reply */
CHGVAR VAR(%BIN(&KEY3 )) VALUE(1307)
/* 0305 -- Current user profile */
CHGVAR VAR(%BIN(&KEY4 )) VALUE(0305)
CHGVAR VAR(&KEYSTORTN) VALUE(&KEY1 *CAT &KEY2 *CAT +
&KEY3 *CAT &KEY4)
CHGVAR VAR(&USP_NAME) VALUE('CHKJOBNAME')
CHGVAR VAR(&USP_LIB) VALUE('QTEMP')
CHGVAR VAR(&USP_QUAL) VALUE(&USP_NAME *CAT +
&USP_LIB)
CHGVAR VAR(&USP_TYPE) VALUE('MYTYPE')
CHGVAR VAR(%BIN(&USP_SIZE)) VALUE(128000)
CHGVAR VAR(&USP_FILL) VALUE(' ')
CHGVAR VAR(&USP_AUT) VALUE('*USE')
CHGVAR VAR(&USP_TEXT) VALUE('my user space')
DLTUSRSPC USRSPC(&USP_LIB/&USP_NAME)
MONMSG CPF0000
CALL PGM(QUSCRTUS) PARM(&USP_QUAL &USP_TYPE +
&USP_SIZE &USP_FILL &USP_AUT &USP_TEXT)
CHGVAR VAR(&API_USQUAL) VALUE(&USP_QUAL)
CHGVAR VAR(&API_JBNAM) VALUE(&JOBNAME)
CHGVAR VAR(&API_USER) VALUE('*ALL')
/* CHGVAR VAR(&API_USER) VALUE(&JOBUSER) */
CHGVAR VAR(&API_JOBNR) VALUE('*ALL')
CHGVAR VAR(&API_STATUS) VALUE('*ACTIVE')
CHGVAR VAR(&API_JBQUAL) VALUE(&API_JBNAM *CAT +
&API_USER *CAT &API_JOBNR)
CALL PGM(QUSLJOB) PARM(&API_USQUAL 'JOBL0200' +
&API_JBQUAL &API_STATUS X'00000000' +
&TYPE &NBRTORTN &KEYSTORTN)
CHGVAR VAR(%BIN(&STARTPOS)) VALUE(1)
CHGVAR VAR(%BIN(&DATALEN)) VALUE(140)
CALL PGM(QUSRTVUS) PARM(&API_USQUAL &STARTPOS +
&DATALEN &HEADER)
CHGVAR VAR(&LST_OFFSET) VALUE(%BIN(&HEADER 125 4))
CHGVAR VAR(&LST_SIZE) VALUE(%BIN(&HEADER 129 4))
CHGVAR VAR(&LST_NBR) VALUE(%BIN(&HEADER 133 4))
CHGVAR VAR(&LST_LEN) VALUE(%BIN(&HEADER 137 4))
CHGVAR VAR(%BIN(&LST_POSBIN)) VALUE(&LST_OFFSET + 1)
CHGVAR VAR(&LST_LENBIN) VALUE(%SST(&HEADER 137 4))
CHGVAR VAR(&LST_COUNT) VALUE(0)
IF (&LST_NBR *EQ 0) DO
/* Job not found */
Goto Lst_End
ENDDO
LST_LOOP: IF COND(&LST_COUNT *EQ &LST_NBR) THEN(GOTO +
CMDLBL(LST_END))
CALL PGM(QUSRTVUS) PARM(&API_USQUAL &LST_POSBIN +
&LST_LENBIN &LST_DATA)
CHGVAR VAR(&JOBNAME) VALUE(%SST(&LST_DATA 1 10))
CHGVAR VAR(&USER) VALUE(%SST(&LST_DATA 11 10))
CHGVAR VAR(&JOBNBR) VALUE(%SST(&LST_DATA 21 6))
CHGVAR VAR(&STATUS) VALUE(%SST(&LST_DATA 43 10))
CHGVAR VAR(&JOBTYPE) VALUE(%SST(&LST_DATA 53 1))
CHGVAR VAR(&SUBTYPE) VALUE(%SST(&LST_DATA 54 1))
/* for status */
CHGVAR VAR(&WRKSTS ) VALUE(%SST(&LST_DATA 81 4))
/* for subsystem */
CHGVAR VAR(&SBSSYS ) VALUE(%SST(&LST_DATA 101 20))
/* for msgrply */
CHGVAR VAR(&MSGRPLY) VALUE(%SST(&LST_DATA 137 1))
/* for current user */
CHGVAR VAR(&CURUSR ) VALUE(%SST(&LST_DATA 157 10))
IF (&WRKSTS *EQ 'MSGW' *AND &MSGRPLY *EQ '1') DO
CHGVAR &MSGTEXT ('* Job' *BCAT +
&JOBNBR *TCAT '/' *CAT +
&USER *TCAT '/' *CAT +
&JOBNAME *BCAT 'status is' *BCAT +
&WRKSTS *TCAT '.')
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA(&MSGTEXT) TOMSGQ(*SYSOPR)
EndDo
CHGVAR VAR(&LST_COUNT) VALUE(&LST_COUNT + 1)
CHGVAR VAR(%BIN(&LST_POSBIN)) +
VALUE(%BIN(&LST_POSBIN) + &LST_LEN)
GOTO CMDLBL(LST_LOOP)
LST_END:
DLTUSRSPC USRSPC(&USP_LIB/&USP_NAME)
ENDSUBR
EndPgm:
EndPgm
File : QCLSRC
Member: CHKBCHJOB
Type : CLP
Usage : CRTCLPGM CHKBCHJOB
Insert your batch job which need to be monitored to CHKBCHJOBP
SBMJOB CMD(CALL CHKBCHJOB) JOB(CHKBCHJOB)
PGM
/*-- Global error monitoring: --------------------------------------*/
MonMsg CPF0000 *N GoTo Error
Loop:
Call ChkBchJobC
DlyJob 300
Goto Loop
Return:
Return
/*-- Error handling: -----------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
星期四, 11月 09, 2023
2018-12-03 Check Daily Batch Jobs started or not
2017-11-21 Check Message Queue Manager started or not
Check Message Queue Manager started or not
File : QCLSRC
Member: CHKMQM
Type : CLLE
Usage : CrtCLMod Module( ChkMqm )
CrtPgm Pgm( ChkMqm ) BndSrvPgm((QMQM/LIBMQM))
/*-------------------------------------------------------------------*/
/* */
/* Program . . : CHKMQM */
/* Description : Check MQM Status */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : November 21, 2017 */
/* */
/* Program function: CHKMQM command processing program */
/* */
/* */
/* Programmer's notes: */
/* */
/* Compile options: */
/* CrtCLMod Module( ChkMqm ) */
/* CrtPgm Pgm( ChkMqm ) */
/* BndSrvPgm((QMQM/LIBMQM)) */
/*-------------------------------------------------------------------*/
/* */
/* Exceptions monitored : */
/* MQCONN MQRC_Q_MGR_STOPPING */
/* MQRC_Q_MGR_QUIESCING */
/* MQRC_Q_MGR_NOT_AVAILABLE */
/* MQRC_STORAGE_NOT_AVAILABLE */
/* */
/*-------------------------------------------------------------------*/
Pgm ( &MQMName &RCChar)
Dcl &MQMName *CHAR 48
Dcl &RCChar *Char 10
/* Define local variables */
Dcl &HCONN *CHAR 4 X'00000000'
Dcl &CCODE *CHAR 4 X'00000000'
Dcl &REASON *CHAR 4 X'00000000'
Dcl &NOTAVAIL *CHAR 4 X'0000080B'
Dcl &STOPPING *CHAR 4 X'00000872'
Dcl &QUIESCING *CHAR 4 X'00000871'
Dcl &NOSTORAGE *CHAR 4 X'00000817'
Dcl &UNKNOWN *CHAR 4 X'0000080A'
Dcl &MsgDta *Char 256
Dcl &Rc *Dec (10 0)
/*-- Global error monitoring: --------------------------------------*/
MonMsg (CPF0000 MCH3601) *N GoTo Error
AddLibLe QMQM
MonMsg CPF0000
/******************************************************/
/* Connect to queue manager */
/******************************************************/
CallPrc 'MQCONN' (&MQMName &Hconn &Ccode &Reason)
If (%bin(&Ccode) *ne 0) Do
/*************************************************/
/* MQCONN failed */
/*************************************************/
ChgVar &Rc %Bin(&Reason)
ChgVar &RcChar &Rc
Select
When (&Reason = &STOPPING) Do
ChgVar &MsgDta ('Qmgr' *bcat &MQMName *Bcat +
'stopping, RC =' *bcat &RcChar)
EndDo
When (&Reason = &NOTAVAIL) Do
ChgVar &MsgDta ('Qmgr' *bcat &MQMName *Bcat +
'not available, RC =' *bcat &RcChar)
EndDo
When (&Reason = &QUIESCING) Do
ChgVar &MsgDta ('Qmgr' *bcat &MQMName *Bcat +
'quiescing, RC =' *bcat &RcChar)
EndDo
When (&Reason = &NOSTORAGE) Do
ChgVar &MsgDta ('Qmgr' *bcat &MQMName *Bcat +
'nostorage, RC =' *bcat &RcChar)
EndDo
When (&Reason = &UNKNOWN) Do
ChgVar &MsgDta ('Qmgr' *bcat &MQMName *Bcat +
'unknown, RC =' *bcat &RcChar)
EndDo
Otherwise Do
ChgVar &MsgDta ('Qmgr' *bcat &MQMName *Bcat +
'conn error, RC =' *bcat &RcChar)
EndDo
EndSelect
SndPgmMsg MsgId(CPF9898) MsgF(QCPFMSG) +
MsgDta(&MsgDta) ToPgmQ(*Ext) MsgType(*Info)
Goto Return
ENDDO
ChgVar &MsgDta ('Qmgr' *bcat &MQMName *Bcat +
'started')
SndPgmMsg MsgId(CPF9898) MsgF(QCPFMSG) +
MsgDta(&MsgDta) ToPgmQ(*EXT) MsgType(*INFO)
/******************************************************/
/* MQCONN worked so disonnect */
/******************************************************/
CallPrc 'MQDISC' (&Hconn &Ccode &Reason)
Return:
Return
/*-- Error handling: -----------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: CHKMQM
Type : CMD
Usage : CrtCmd Cmd( CHKMQM )
Pgm( CHKMQM )
SrcFile( QCMDSRC )
Allow( *IPGM *BPGM )
/*-------------------------------------------------------------------*/
/* */
/* Compile options: */
/* */
/* CrtCmd Cmd( CHKMQM ) */
/* Pgm( CHKMQM ) */
/* SrcMbr( CHKMQM ) */
/* Allow( *IPGM *BPGM ) */
/* */
/*-------------------------------------------------------------------*/
Cmd Prompt( 'Check MQ Queue Manager')
Parm Kwd(MQMNAME) Type(*CHAR) Len(48) Min(1) +
Prompt('Message Queue Manager name')
Parm Kwd(RC) Type(*CHAR) Len(10) +
RtnVal(*Yes) +
Prompt('Return code')
File : QCLSRC
Member: CHKMQMTSTC
Type : CLP
Usage : CRTCLPGM CHKMQMTSTC
PGM
DCL &MQMNAME *CHAR 48
DCL &RC *CHAR 10
/*-- Global error monitoring: --------------------------------------*/
MonMsg CPF0000 *N GoTo Error
CHGVAR &MQMNAME 'TEST'
CHKMQM MQMNAME(&MQMNAME) RC(&RC)
If (&RC *NE ' ') Do
DmpClPgm
/* MQM got Exception */
/* do exception process */
EndDo
CHGVAR &MQMNAME 'TEST1'
CHKMQM MQMNAME(&MQMNAME) RC(&RC)
If (&RC *NE ' ') Do
DmpClPgm
/* MQM got Exception */
/* do exception process */
EndDo
Return:
RCLACTGRP ACTGRP(*ELIGIBLE)
Return
/*-- Error handling: -----------------------------------------------*/
Error:
RCLACTGRP ACTGRP(*ELIGIBLE)
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
2016-12-26 Log message to IFS file with command LOGTOIFS
Log message to IFS file with command LOGTOIFS
File : QRPGLESRC
Member: LOGTOIFS
Type : RPGLE
Usage : CRTBNDRPG PGM(LOGTOIFS) SRCFILE(LIBxx/QRPGLESRC) SRCMBR(LOGTOIFS)
**===============================================================
** Command....... LogToIfs =
** CPP........... LogToIfs RPGLE =
** Description... Log Message to IFS File =
**===============================================================
** Date : 2016/12/26 =
** Author: Vengoal Chang =
**===============================================================
** =
** To compile: =
** CRTBNDRPG LOGTOIFS SRCFILE(lib/QRPGLESRC) DBGVIEW(*LIST) =
** =
**===============================================================
H DftActGrp(*NO)
H Debug Option(*SrcStmt:*NoDebugIo)
* PGM SDS
D SDS
D psdsPgmName *Proc
D psdsPgmLib 81 90 * Program library
D JobNam 244 253
D JobUsr 254 263
D JobNbr 264 269
D CurUsr 358 367
** API call to open a stream file
**
D open PR 10I 0 ExtProc('open')
D path * value options(*string)
D openflags 10I 0 value
D mode 10U 0 value options(*nopass)
D ccsid 10U 0 value options(*nopass)
D txtcreatid 10U 0 value options(*nopass)
D**********************************************************************
D* Flags for use in open()
D*
D* More than one can be used -- add them together.
D**********************************************************************
D* Writing Only
D O_WRONLY C 2
D* Create File if not exist
D O_CREAT C 8
D* Truncate File to 0 bytes
D O_TRUNC C 64
* Append to file
D O_APPEND C 256
D* Convert text by code-page
D O_CODEPAGE C 8388608
D* Convert text by ccsid
D O_CCSID C 32
D* Open in text-mode
D O_TEXTDATA C 16777216
* Note: O_TEXT_CREAT requires all of the following flags to work:
* O_CREAT+O_TEXTDATA+(O_CODEPAGE or O_CCSID)
D O_TEXT_CREAT C 33554432
D* owner authority
D**********************************************************************
D* Mode Flags.
D* basically, the mode parm of open(), creat(), chmod(),etc
D* uses 9 least significant bits to determine the
D* file's mode. (peoples access rights to the file)
D*
D* user: owner group other
D* access: R W X R W X R W X
D* bit: 8 7 6 5 4 3 2 1 0
D*
D* (This is accomplished by adding the flags below to get the mode)
D**********************************************************************
D S_IRUSR C 256
D S_IWUSR C 128
D S_IXUSR C 64
D S_IRWXU C 448
D* group authority
D S_IRGRP C 32
D S_IWGRP C 16
D S_IXGRP C 8
D S_IRWXG C 56
D* other people
D S_IROTH C 4
D S_IWOTH C 2
D S_IXOTH C 1
D S_IRWXO C 7
** API call to write data to a stream file
**
D write PR 10I 0 extproc('write')
D fildes 10I 0 value
D buf * value
D nbyte 10U 0 value
** API call to close a stream file
**
D close PR 10I 0 extproc('close')
D fildes 10I 0 value
D @__ERRNO PR * EXTPROC('__errno')
D STRERROR PR * EXTPROC('strerror')
D ERRNUM 10I 0 VALUE
D ERRNO PR 10I 0
D DIE PR
D PEMSG 256A CONST
D GetCaller PR
D CallingPgmNam 10
D CallingPgmLib 10
D fd S 10I 0
D data S 4096A
D IfsPath S 256A
D Curtime S Z
D PgmNam S 10
D PgmLib S 10
D Proc S 32
* Program parameters - title and page length in lines
D paIfsFile S 64
D paPath S 256
D paMessage S 2048
D paIncludeJob S 4
* Program parameters
C *Entry Plist
C Parm paIfsFile
C Parm paPath
C Parm paMessage
C Parm paIncludeJob
c eval *inlr = *on
C eval IfsPath = %trim(paPath) + '/' +
C %trim(paIfsFile)
C* Create an empty file
c eval fd = open(%trim(IfsPath)
c : O_CREAT + O_APPEND + O_WRONLY
c + O_CCSID + O_TEXT_CREAT
c + O_TEXTDATA
c : S_IWUSR+S_IRUSR+S_IRGRP+S_IROTH
c : 0
c : 0 )
c if fd < 0
c callp die('open(): ' + %Char(ERRNO) + ' ' +
c %trim(IfsPath) + ' ' +
c %STR(STRERROR(ERRNO)))
c return
c endif
C Time Curtime
C If paIncludeJob = '*YES'
C callp GetCaller ( PgmNam
C : PgmLib
C )
C eval data = %SubSt(%Char(Curtime):1:23)+ ' ' +
C JobNam + ' ' +
C JobUsr + ' ' +
C JobNbr + ' ' +
C PgmLib + ' ' +
C PgmNam + ' ' +
C %trimR(paMessage) + x'0D25'
C Else
C eval data = %SubSt(%Char(Curtime):1:23)+ ' ' +
C %trimR(paMessage) + x'0D25'
C EndIf
C
c callp write(fd: %addr(data): %len(%trim(data)))
C* Close the file:
c callp close(fd)
**********************************************************************
* Get Caller with Retrieve Call Stack API
**********************************************************************
P GetCaller B
D GetCaller PI
D CallingPgmNam 10
D CallingPgmLib 10
D RtvCallStack PR Extpgm('QWVRCSTK')
D 2000
D 10I 0
D 8 CONST
D 56
D 8 CONST
D 15
D Var DS 2000
D BytAvl 10I 0
D BytRtn 10I 0
D Entries 10I 0
D Offset 10I 0
D EntryCount 10I 0
D VarLen S 10I 0 Inz(%size(Var))
D ApiErr S 15
D JobIdInf DS
D JIDQName 26 Inz('*')
D JIDIntID 16
D JIDRes3 2 Inz(*loval)
D JIDThreadInd 10I 0 Inz(1)
D JIDThread 8 Inz(*loval)
D Entry DS 256
D EntryLen 10I 0
D PgmNam 10 Overlay(Entry:25)
D PgmLib 10 Overlay(Entry:35)
c eval CallingPgmNam = *blanks
c eval CallingPgmLib = *blanks
c callp RtvCallStack ( Var
c : VarLen
c : 'CSTK0100'
c : JobIdInf
c : 'JIDF0100'
c : ApiErr
c )
C Do EntryCount
C Eval Entry = %subst(Var:Offset + 1)
c if CallingPgmNam = *blanks and
c CallingPgmLib = *blanks
c if PgmNam = psdsPgmName and
c PgmLib = psdsPgmLib
C Else
c eval CallingPgmNam = Pgmnam
c eval CallingPgmLib = Pgmlib
C Endif
C Endif
C Eval Offset = Offset + EntryLen
C Enddo
C
C Return
P GetCaller E
**********************************************************************
* This ends this program abnormally, and sends back an escape.
* message explaining the failure.
**********************************************************************
P DIE B
D DIE PI
D PeMsg 256A CONST
D SndPgmMsg PR ExtPgm('QMHSNDPM')
D MessageId 7A Const
D QualMsgF 20A Const
D MsgData 256A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCct 10I 0 Const
D MessageKey 4A
D ErrorCode 32766A Options(*VarSize)
D Dsec DS
D DsecBytesP 1 4I 0 Inz(256)
D DsecBytesA 5 8I 0 Inz(0)
D DsecMsgId 9 15
D DsecReserv 16 16
D DsecMsgDta 17 256
D WWMsgLen S 10I 0
D WWTheKey S 4A
C EVAL WWMsgLen = %Len(%TrimR(PeMsg))
C IF WWMsgLen<1
C RETURN
C ENDIF
C Callp SndPgmMsg('CPF9897': 'QCPFMSG *LIBL':
C PeMsg: WWMsgLen: '*ESCAPE':
C '*PGMBDY': 1: WWTheKey: Dsec)
C RETURN
P DIE E
**********************************************************************
* This procedure return call socket C API errno
**********************************************************************
P ErrNo B
D ErrNo PI 10I 0
D P_EeeNo S *
D WWReturn S 10I 0 Based(P_Errno)
C EVAL P_Errno = @__Errno
C RETURN WWReturn
P Errno E
File : QCMDSRC
Member: LOGTOIFS
Type : CMD
Usage : CrtCmd Cmd( LogToIfs )
Pgm( LogToIfs )
SrcFile( QCMDSRC )
/* =============================================================== */
/* = Command....... LogToIfs = */
/* = CPP........... LogToIfs RPGLE = */
/* = Description... Log Message to IFS File = */
/* = = */
/* = CrtCmd Cmd( LogToIfs ) = */
/* = Pgm( LogToIfs ) = */
/* = SrcFile( QCMDSRC ) = */
/* =============================================================== */
/* = Date : 2016/12/26 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Cmd Prompt('Log Message To IFS File')
Parm Kwd(ToStmf) +
Type(*Name) Len(64) Min(1) +
Prompt('To stream file name')
Parm Kwd(ToDir) +
Type(*Pname) LEN(256) MIN(1) +
Prompt('To directory')
Parm Kwd(LogMsg) +
Type(*Char) Len(2048) Min(1) +
Prompt('Log message')
Parm Kwd(InCldJob) +
Type(*Char) Len(4) +
Rstd(*Yes) +
Dft(*No ) +
Values(*YES *NO) +
Prompt('Log include job info')
Usage example:
Log Message To IFS File (LOGTOIFS)
Type choices, press Enter.
To stream file name . . . . . .
To directory . . . . . . . . . .
Log message . . . . . . . . . .
...
Log include job info . . . . . . *NO *YES, *NO
LOGTOIFS TOSTMF(AP1LOG.TXT) TODIR('/tmp') LOGMSG('test 2') INCLDJOB(*YES)
LOGTOIFS TOSTMF(AP1LOG.TXT) TODIR('/tmp') LOGMSG('test 3') INCLDJOB(*YES)
LOGTOIFS TOSTMF(AP1LOG.TXT) TODIR('/tmp') LOGMSG('test 3')
LOGTOIFS TOSTMF(AP1LOG.TXT) TODIR('/tmp') LOGMSG('test 4')
DSPF STMF('/tmp/AP1LOG.TXT')
Browse : /tmp/AP1LOG.TXT
Record : 1 of 4 by 14 Column : 1 59 by 79
Control :
....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....
************Beginning of data**************
2016-12-26-15.25.45.104 QPADEV0047 USRTEST 317148 QSYS QUOCMD test 2
2016-12-26-15.25.50.561 QPADEV0047 USRTEST 317148 QSYS QUOCMD test 3
2016-12-26-15.25.57.791 test 3
2016-12-26-15.26.02.863 test 4
************End of Data********************
2016-10-04 Check MQ Job by APPLTYPE USER or SYSTEM(CHKMQJOB) with StrMqmMqsc command output
Check MQ Job by APPLTYPE USER or SYSTEM(CHKMQJOB) with StrMqmMqsc command output
File : QCLSRC
Member: CHKMQJOBC
Type : CLP
Usage : CRTCLPGM PGM(CHKMQJOBC)
/*-------------------------------------------------------------------*/
/* */
/* Program . . : CHKMQJOB */
/* Description : Check MQ User Job */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : July 25, 2016 */
/* */
/* Program function: CHKMQJOB command processing program */
/* */
/* */
/* Programmer's notes: */
/* CRTSRCPF FILE(QGPL/MQSRC) TEXT('MQ CMD SRC') */
/* Put following line to file QGPL/MQSRC menber CHKMQJOB */
/* DISPLAY CONN(*) TYPE(CONN) APPLTAG APPLTYPE */
/* */
/* Compile options: */
/* CrtClPgm Pgm( CHKMQJOB ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* */
/*-------------------------------------------------------------------*/
Pgm ( &Qmgr +
&ApplType +
&JobAction +
)
/*-- Parameters: ---------------------------------------------------*/
Dcl &Qmgr *Char 48
Dcl &ApplType *Char 10
Dcl &JobAction *Char 10
Dcl &MqSrcFile *Char 10 'MQSRC'
Dcl &MqSrcLib *Char 10 'QGPL'
Dcl &MqSrcMbr *Char 10 'CHKMQJOB'
/*-- Global error monitoring: --------------------------------------*/
MonMsg CPF0000 *N GoTo Error
DltF File(Qtemp/MqJobLst)
MonMsg CPF2105
CrtPf File(Qtemp/MqJobLst) RcdLen(133) IgcDta(*Yes)
StrMqmMqsc SrcMbr(&MqSrcMbr) SrcFile(&MqSrcLib/&MqSrcFile) +
MqmName(&Qmgr)
CpySplf File(QsysPrt) ToFile(Qtemp/MqJobLst) SplNbr(*Last)
Call ChkMqJobR (&Qmgr &ApplType &JobAction)
MonMsg CPF9898
DltSplF File(QsysPrt) SplNbr(*Last)
Return:
Return
/*-- Error handling: -----------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QRPGLESRC
Member: CHKMQJOBR
Type : RPGLE
Usage : CRTBNDRPG PGM(CHKMQJOBR)
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) dftactgrp(*NO)
FMQJOBLST IF F 133 DISK
**-- API error information:
D ERRC0100 Ds Qualified
D BytPro 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 256a
**-- Global variables:
D MsgKey s 4a
**-- 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 )
**-- Send completion message:
D SndCmpMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- Send escape message:
D SndEscMsg Pr 10i 0
D PxMsgDta 512a Const Varying
D ParseInput PR
D GetAtrValue PR 512 Varying
D inputStr 512 Const Varying
D atrName 64 Const Varying
**-- Execute command:
D RunCmd Pr ExtPgm( 'QCMDEXC' )
D CmdStr 4096a Const Options( *VarSize )
D CmdLen 15p 5 Const
D CmdIGC 3a Const Options( *NoPass )
D InputData DS
D saInput 133A
D APPLTAGDS DS dim(100) qualified
D CONNID 16
D APPLTAG 28
D APPLTYPE 10
D idx S 10I 0
D jobCount S 10I 0
D jobCmd S 128
D mqJob S 52
D AtrValue S 512a Varying
C *Entry Plist
C Parm pMqmName 48
C Parm pApplType 10
C Parm pJobAction 10
C READ MQJOBLST InputData LR
C DOW *INLR = *OFF
C CALLP ParseInput
C READ MQJOBLST InputData LR
C ENDDO
C eval jobCount = idx
C
C For idx = 1 to jobCount
1B C If pApplType='USER'
2B C If %trim(APPLTAGDS(idx).APPLTYPE) = 'USER'
3b C If pJobAction = '*DSP'
C eval mqJob = APPLTAGDS(idx).APPLTYPE +
C APPLTAGDS(idx).APPLTAG
C callp SndCmpMsg('DISPLAY ' + mqJob)
3x C Else
4b C If pJobAction = '*ENDJOB'
C eval jobCmd = 'ENDJOB JOB(' +
C %trim(APPLTAGDS(idx).APPLTAG) +
C ') OPTION(*IMMED)'
C callp(e) RunCmd(%Trim(jobCmd):%Len(%Trim(jobcmd)))
4e C EndIf
4b C If pJobAction = '*ENDCNN'
C eval jobCmd = 'ENDMQMCONN CONN(' +
C %trim(APPLTAGDS(idx).CONNID) +
C ') MQMNAME(' +
C %trim(pMqmName) + ')'
C callp(e) RunCmd(%Trim(jobCmd):%Len(%Trim(jobcmd)))
4e C EndIf
4b C If %error
C Callp SndEscMsg ('Command Error:' +
C %trim(jobCmd) +
C ', please see joblog'
C )
C Else
C Callp SndCmpMsg ('Command :' +
C %trim(jobCmd) +
C ' completed.'
C )
4e C EndIf
3e C EndIf
2e C EndIf
1X C Else
2b C If %trim(APPLTAGDS(idx).APPLTYPE) <>'USER'
C eval mqJob = APPLTAGDS(idx).APPLTYPE +
C APPLTAGDS(idx).APPLTAG
C callp SndCmpMsg('DISPLAY ' + mqJob)
2e C EndIf
1e C EndIf
C
C EndFor
**********************************************************************
P ParseInput B
D ParseInput PI
C eval AtrValue=
C %trim(GetAtrValue(saInput: 'CONN'))
C If %len(%trim(AtrValue)) = 16
C eval idx = idx + 1
C eval APPLTAGDS(idx).CONNID = %trim(AtrValue)
C EndIf
C eval AtrValue=
C %trim(GetAtrValue(saInput: 'APPLTAG'))
C If %len(%trim(AtrValue)) > 0
C eval APPLTAGDS(idx).APPLTAG = %trim(AtrValue)
C eval AtrValue=
C %trim(GetAtrValue(saInput: 'APPLTYPE'))
C eval APPLTAGDS(idx).APPLTYPE=%trim(AtrValue)
C EndIf
P ParseInput E
P GetAtrValue B
D GetAtrValue PI 512 Varying
D pInputStr 512a Const Varying
D pAtrName 64a Const Varying
D AtrName S 512a
D AtrValue S 512a Varying
C eval AtrValue = ''
C z-add 0 Str 5 0
C z-add 0 End 5 0
C Eval AtrName = %trim(pAtrName)+ '('
C Eval Str=%Scan(%trim(AtrName): pInputStr: 1)
C If Str > 0
C Eval End=%Scan(%trim(')'):saInput: Str)
C Eval AtrValue =
C %SubSt(pInputStr:
C str+%len(%trim(AtrName)):
C End-(str+%len(%trim(AtrName))))
C EndIf
C Return AtrValue
P GetAtrValue E
**-- Send escape message: ----------------------------------------------**
P SndEscMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
/Free
SndPgmMsg( 'CPF9898'
: 'QCPFMSG *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 completion message: ------------------------------------------**
P SndCmpMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
/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
File : QCMDSRC
Member: CHKMQJOB
Type : CMD
Usage : CrtCmd Cmd( CHKMQJOB )
Pgm( CHKMQJOBC )
SrcMbr( CHKMQJOB )
CRTSRCPF FILE(QGPL/MQSRC) TEXT('MQ CMD SRC')
Put following line to file QGPL/MQSRC menber CHKMQJOB
DISPLAY CONN(*) TYPE(CONN) APPLTAG APPLTYPE
/*-------------------------------------------------------------------*/
/* */
/* Compile options: */
/* */
/* CrtCmd Cmd( CHKMQJOB ) */
/* Pgm( CHKMQJOBC ) */
/* SrcMbr( CHKMQJOB ) */
/* */
/*-------------------------------------------------------------------*/
Cmd Prompt( 'Check MQ Job')
Parm QMNAME *Char 48 +
Min(1) +
Prompt('Queue manager name')
PARM ApplType *Char 10 +
Rstd(*YES) +
Dft(USER) +
Values(USER SYSTEM) +
Prompt('Application type')
PARM JobAction *Char 10 +
Rstd(*YES) +
Dft(*DSP) +
Values(*DSP *ENDCNN *ENDJOB) +
PmtCtl( P0001 ) +
Prompt('Job action')
P0001: PmtCtl Ctl( APPLTYPE ) +
Cond(( *EQ 'SYSTEM' ))
DEP Ctl(&APPLTYPE *EQ 'SYSTEM') +
Parm((&JOBACTION *EQ '*DSP')) +
NbrTrue( *EQ 1 )
Command sample:
Check MQ Job (CHKMQJOB)
Type choices, press Enter.
Queue manager name . . . . . . .
Application type . . . . . . . . USER USER, SYSTEM
Job action . . . . . . . . . . . *DSP *DSP, *ENDCNN, *ENDJOB
Note:
*DSP => display MQ job info
*ENDCNN => end MQ USER connection handle
*ENDJOB => end MQ USER connection job
參照: Start IBM MQ Commands (STRMQMMQSC)
參照: DISPLAY CONN
2015-06-08 如何讓 WRKACTJOB 畫面中欄位 Function 更容易明瞭？(Command CHGFUNCNAM -- Change Function Name with QWCCCJOB Change Current Job API)
如何讓 WRKACTJOB 畫面中欄位 Function 更容易明瞭？(Command CHGFUNCNAM -- Change Function Name with QWCCCJOB Change Current Job API)
File : QCLSRC
Member: CHGFUNCNAM
Type : CLP
Usage : CRTCLPGM PGM(CHGFUNCNAM)
/*-------------------------------------------------------------------*/
/* */
/* Program . . : CHGFUNCNAM */
/* Description : Change function name */
/* with Change Current Job (QWCCCJOB) API */
/* which support change function name from V6R1 */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : June 8, 2015 */
/* */
/* */
/* Program function: Change function name command allows you to */
/* change the description of the Function field */
/* on WRKACTJOB to provide a better description */
/* of what a job is doing. */
/* */
/* The value on WRKACTJOB would appear as */
/* USR-xxxx where xxxx is the 10 bytes specified */
/* on CHGFUNCNAM. */
/* */
/* This program expects a single parameter */
/* specifying the function name. */
/* */
/* */
/* Compile options: */
/* CrtClPgm Pgm( CHGFUNCNAM ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* */
/*-------------------------------------------------------------------*/
Pgm &FuncName
Dcl &FuncName *Char 10
Dcl &ChgInf *Char 22
MonMsg CPF0000 *N GoTo Error
ChgVar %Bin( &ChgInf 1 4 ) 1
ChgVar %Bin( &ChgInf 5 4 ) 3 /* Function name */
ChgVar %Bin( &ChgInf 9 4 ) 10 /* 10 byte */
Chgvar %Sst( &ChgInf 13 10 ) &FuncName
Call QWCCCJOB ( &ChgInf x'0000000000000000' )
Return
/*-- Error handling: -----------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: CHGFUNCNAM
Type : CMD
Usage : CrtCmd Cmd( CHGFUNCNAM )
Pgm( CHGFUNCNAM )
SrcFile( YourSourceFile )
Allow( *IPgm *BPgm )
/* =============================================================== */
/* = Command....... ChgFuncNam = */
/* = CPP........... ChgfuncNam CLP = */
/* = Description... Change Function Name = */
/* = = */
/* = = */
/* = CrtCmd Cmd( ChgFuncNam ) = */
/* = Pgm( ChgFuncNam ) = */
/* = SrcFile( YourSourceFile ) = */
/* = Allow( *IPgm *BPgm ) = */
/* =============================================================== */
/* = Date : 2015/06/08 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Cmd Prompt('Change Function Name')
Parm FuncName *Char 10 +
Prompt('Function name')
File : QCLSRC
Member: CHGFUNCTST
Type : CLLE
Usage : CrtCmd Cmd( CHGFUNCTST )
Pgm( CHGFUNCTST )
SrcFile( YourSourceFile )
SbmJob Cmd( Call CHGFUNCTST)
Job( CHGFUNCTST )
WRKACTJOB press F10 see the job CHGFUNCTST Function name
will change STEP1, STEP2, STEP1, STEP2 ...
/*-------------------------------------------------------------------*/
/* */
/* Program . . : CHGFUNCTST */
/* Description : Change function name Test */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : June 8, 2015 */
/* */
/* */
/* Program function: Change function name command test */
/* */
/* */
/* Compile options: */
/* CrtBndCl Pgm( CHGFUNCTST ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* */
/*-------------------------------------------------------------------*/
Pgm
Dcl &SleepSec *Int
ChgVar &SleepSec 1
Loop:
ChgFuncNam FuncName(STEP1)
CallPrc PRC('sleep') Parm((&SleepSec *ByVal))
ChgFuncNam FuncName(STEP2)
CallPrc PRC('sleep') Parm((&SleepSec *ByVal))
Goto Loop
EndPgm
參照: Change Current Job (QWCCCJOB) API
2015-06-01 如何取得系統正在執行中的子系統(Active subsystem)？(Command RTVACTSBS with List Active Subsystems (QWCLASBS) API)
如何取得系統正在執行中的子系統(Active subsystem)？(Command RTVACTSBS Retrieve active subsystems with List Active Subsystems (QWCLASBS) API)
File : QCLSRC
Member: RTVACTSBS
Usage : CRTCLPGM PGM(RTVACTSBS)
/*-------------------------------------------------------------------*/
/* */
/* Program . . : RTVACTSBS */
/* Description : Retrieve active subsystems CPP */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : June 1, 2015 */
/* */
/* Program function: Retrieve active subsystems */
/* */
/* */
/* Compile options: */
/* CrtClPgm Pgm( RTVACTSBS ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* */
/*-------------------------------------------------------------------*/
Pgm (&RtnSbs &NbrSbs)
Dcl &RtnSbs *char 9800
Dcl &NbrSbs *dec (5 0)
/* API User Space Variables */
Dcl &a_inl *char 1 value( x'00' ) /* Initializer */
Dcl &a_siz *int value( 16384 ) /* Initial size */
Dcl &offslst *int value( 1 ) /* Initial offset */
Dcl &nbrlste *int
Dcl &sizlste *int value( 150 ) /* Init entry sz */
/* General fields... */
Dcl &i *int /* Loop counter */
Dcl &us_hdr *char 150 /* Retrieved Hdr */
Dcl &SBSENT *char 20 /* Retrieved Ent */
Dcl &usrspc *char 10 value( 'ACTSBSD' )
Dcl &usrspclib *char 10 value( 'QTEMP' )
Dcl &qusrspc *char 20
Dcl &sbsd *char 10
Dcl &sbsdlib *char 10 value( '*LIBL' )
Dcl &pos *dec (5 0)
MonMsg ( Cpf0000 Mch0000 ) Exec( Goto Error )
Dltusrspc &usrspclib/&usrspc
MonMsg Cpf0000
/* Create *usrspc for the SBS info APIs... */
/* Active subsystems will be listed into the space. Basic info will be */
/* retrieved from the space header and used to loop through entries... */
/* Set the qualified *usrspc name... */
Chgvar &qusrspc ( &usrspc *cat &usrspclib )
Call QUSCRTUS ( +
&qusrspc +
'ACTSBSD' +
&a_siz +
&a_inl +
'*ALL ' +
'List active SBSDs ' +
'*YES ' +
x'0000000000000000' +
)
/* List the active SBSDs into our *usrspc... */
Call QWCLASBS ( +
&qusrspc +
'SBSL0100' +
x'00000000' +
)
/* Set our loop control from the *usrspc headers... */
Call QUSRTVUS ( +
&qusrspc +
&offslst +
&sizlste +
&us_hdr +
)
/* Get the offset to the list within the space, the number */
/* of list entries and size of each entry from the header. */
Chgvar &offslst %Bin( &us_hdr 125 4 )
Chgvar &nbrlste %Bin( &us_hdr 133 4 )
Chgvar &sizlste %Bin( &us_hdr 137 4 )
/* If no entries, then get out of here... */
If ( &nbrlste *eq 0 ) do
sndpgmmsg msgid( CPF9897 ) msgf( QCPFMSG ) +
msgdta( 'No active subsystems found.' )
goto Return
Enddo
/* Set the offset to the list within the space... */
Chgvar &offslst ( &offslst + 1 )
If (&Nbrlste > 490) Do
SndPgmMsg MsgId(CPF9898) +
MsgF(QCPFMSG) +
MsgDta('More than 490 active subsystems exist') +
MsgType(*Escape)
EndDo
Chgvar &NbrSbs (&Nbrlste)
DoFor &i From( 1 ) To( &Nbrlste )
/* Retrieve a list entry... */
Call QUSRTVUS ( +
&qusrspc +
&offslst +
&sizlste +
&SBSENT +
)
Chgvar &Pos (((&i-1) * 20) + 1)
Chgvar %SST(&RtnSbs &Pos 20) &SBSENT
Chgvar &SBSD %sst( &SBSENT 1 10 )
Chgvar &SBSDLIB %sst( &SBSENT 11 10 )
Chgvar &offslst ( &offslst + &sizlste )
EndDo
Return:
Dltusrspc &usrspclib/&usrspc
Return
/*-- Error processor ------------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY ' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: RTVACTSBS
Usage : CrtCmd Cmd( RtvActSbs )
Pgm( RtvActSbs )
SrcFile( YourSourceFile )
Allow ( *Ipgm *Bpgm )
/* =============================================================== */
/* = Command....... RTVACTSBS = */
/* = CPP........... RTVACTSBS CLP = */
/* = = */
/* = Description... = */
/* = Retrieve active subsystems = */
/* = = */
/* = CrtCmd Cmd( RtvActSbs ) = */
/* = Pgm( RtvActSbs ) = */
/* = SrcFile( YourSourceFile ) = */
/* = Allow ( *Ipgm *Bpgm ) = */
/* =============================================================== */
/* = Date : 2015/06/01 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Cmd Prompt( 'Retrieve Active Subsystems' )
Parm Kwd( RtnSbs ) +
Type( *Char ) +
Len( 9800 ) +
Rtnval( *Yes ) +
Prompt( 'CL var for RTNSBS (9800) .')
Parm Kwd( NbrSbs ) +
Type( *Dec ) +
Len( 5 0 ) +
Rtnval( *Yes ) +
Prompt( 'CL var for NBRSBS (5 0) .' )
File : QCLSRC
Member: RTVACTSBST
Usage : CrtClPgm Pgm( RTVACTSBS )
SrcFile( YourSourceFile )
Pgm
Dcl &RtnSbs *Char 9800
Dcl &NbrSbs *Dec (5 0)
Dcl &Idx *Dec (5 0)
Dcl &QualSbs *Char 20
Dcl &Sbsd *Char 10
Dcl &SbsdL *Char 10
RtvActSbs RtnSbs(&RtnSbs) NbrSbs(&NbrSbs)
ChgVar &Idx -19
Loop: ChgVar &Idx (&Idx + 20)
If (&Idx *LT 9781) Do /* Within area */
ChgVar &QualSbs %SST(&RtnSbs &Idx 20)
If (&QualSbs *NE ' ') Do /* Active sbs */
ChgVar &SBSD %SST(&QualSbs 1 10)
ChgVar &SBSDL %SST(&QualSbs 11 10)
SndPgmMsg Msgid( CPF9897 ) Msgf( QCPFMSG ) +
MsgDta( 'Found' *bcat &SBSDL *tcat '/' *cat +
&SBSD ) +
ToPgmq( *EXT ) MsgType( *STATUS )
DlyJob (1)
GoTo Loop
EndDo /* Active sbs */
EndDo /* Within area */
DMPCLPGM
EndPgm
參照: List Active Subsystems (QWCLASBS) API
2014-10-22 如何將指定的 audit journal reveiver journal entry 轉換至於 PF(Command CVTJRNE with API QjoRetrieveJournalEntries)
如何將指定的 audit journal reveiver journal entry 轉換至於 PF(Command CVTJRNE with API QjoRetrieveJournalEntries)
File : QDDSSRC
Member: JRNRCVRP
Type : PF
Usage : CRTPF JRNRCVRP
A R JRNRCVR
A SYSNAM 8
A JRNSEQ 20S 0
A JRNCDE 1
A JRNENTTYP 2
A JRNENTDTS 20
A JOBNAM 10
A USRNAM 10
A JOBNBR 6
A PGMNAM 10
A PGMLIB 10
A OBJECT 30
A USRPRF 10
A RCVNAM 10
A RCVLIB 10
A ADRFAM 1
A RMTADR 16
A RMTPORT 5S 0
A ARMNBR 5S 0
A PGMLIBASP 5S 0
A PGMLIBASPD 10
A OBJNAMID 1
A OBJTYPE 10
A ENTDTALEN 5S 0
A JRNENTDTA 8192
File : QRPGLESRC
Member: CVTJRNER
Type : RPGLE
Usage : CRTBNDRPG CVTJRNER
**
** Program . . : CBX1042
** Description : Retreive journal entries - format RJNE0200
** Author . . : Carsten Flensburg
** Published . : Club Tech iSeries Programming Tips Newsletter
** Date . . . : July 24, 2003
**
** Modified by : Vengoal Chang
** Modified date October 15, 2014
** Description : Convert journal entries to PF
**
** Program summary
** ---------------
**
** Journal and commit APIs:
** QjoRetrieveJournalEntries Retrieves journal entries based on
** a variety of selection criteria.
**
** The API provides a flexible and
** comprehensive interface to journal
** entries similar to - and also
** extending - the functions provided
** provided by journal CL commands
** like RCVJRNE and RTVJRNE.
**
** QjoDeletePointerHandle Deletes the specified pointer
** handle previously generated by the
** QjoRetrieveJournalEntries API.
**
** Miscellaneous APIs:
** QWCCVTDT Convert date and Converts date and time values from
** time format one format to another, including a
** system timestamp of type *DTS to
** character format.
** C library function:
** tstbts Test bits Tests the bit value of the bit
** located with the bit offset
** parameter, bit 0 being the
** leftmost and 64k the maximum.
**
**
** Sequence of events:
** 1. Initialization of the journal entry type selection criteria.
** A table describing the possible entry types is available here:
**
** http://publib.boulder.ibm.com/iseries/v5r2/ic2924/info/rzaki/
** finder/rzakijournalfinderall.htm
**
** All the journal entry selection records are optional - for
** each record not provided the default value is assumed.
** See API manual for the specific details.
**
** 2. The QjoRetrieveJournalEntries API is called until there are no
** more journal entries available for retrieval.
**
** 3. Each retrieved entry is processed - in this case written to
** the internally defined printer file.
**
** 4. The entry's timestamp is converted from system timestamp to
** character format prior to printing.
**
** 5. Some entry information is provided in the form of bit fields
** retrieved using a C library function.
**
** 6. If a pointer handle was returned by the API it is eventually
** deleted for housekeeping purposes.
**
** 7. After each call the continuation information returned in the
** entry header data - including continuation journal sequence
** number and receiver name - is used to offset the next entry
** retrieval correctly.
**
**
** Programmer's notes:
** Earliest release program will run: V5R2
**
**
** Compile options:
**
** CrtRpgMod Module( CVTJRNER ) DbgView( *LIST )
**
** CrtPgm Pgm( CVTJRNER )
** Module( CVTJRNER )
**
**
**-- Header specifications: --------------------------------------------**
H Option( *SrcStmt ) BndDir( 'QC2LE' ) DatEdit( *DMY/ )
H DFTACTGRP(*NO) Debug
**-- Printer file: -----------------------------------------------------**
FJRNRCVRP O E Disk
**-- Printer file information: -----------------------------------------**
D PrtLinInf Ds
D PlOvfLin 5i 0 Overlay( PrtLinInf: 188 )
D PlCurLin 5i 0 Overlay( PrtLinInf: 367 )
D PlCurPag 5i 0 Overlay( PrtLinInf: 369 )
**-- System information: -----------------------------------------------**
D SDs
D PsPgmNam *Proc
**-- API error data structure: -----------------------------------------**
D ApiError Ds
D AeBytPrv 10i 0 Inz( %Size( ApiError ))
D AeBytAvl 10i 0
**-- Global variables: -------------------------------------------------**
D Idx s 10i 0
D EntDta s 8192a Varying
**
D Time s 6s 0
D NbrRcds s 10u 0
D JrnEntDts s 20a Inz( *All'0' )
D*JrnDta s 24a
D JrnDta s 70a
**-- Retrieve journal entry data: --------------------------------------**
D JeRcvVar Ds Align
D JhJrnHdr
D JhBytRtn 10i 0 Overlay( JhJrnHdr: 1 )
D JhOfsHdrJrnE 10i 0 Overlay( JhJrnHdr: *Next )
D JhNbrEntRtv 10i 0 Overlay( JhJrnHdr: *Next )
D JhConInd 1a Overlay( JhJrnHdr: *Next )
D JhConRcvStr 10a Overlay( JhJrnHdr: *Next )
D JhConLibStr 10a Overlay( JhJrnHdr: *Next )
D JhConSeqNbr 20s 0 Overlay( JhJrnHdr: *Next )
D 11a Overlay( JhJrnHdr: *Next )
D JeData 32754a
**-- Entry header:
D JeEntHdr Ds Based( pEntHdr )
D JeOfsHdrJrnE 10u 0
D JeOfsNulValI 10u 0
D JeOfsEntDta 10u 0
D JeOfsTrnId 10u 0
D JeOfsLglUoW 10u 0
D JeOfsRcvInf 10u 0
D JeSeqNbr 20u 0
D JeTimStp 20u 0
D JeTimStpC 8a Overlay( JeTimStp )
D JeThrId 20u 0
D JeSysSeqNbr 20u 0
D JeCntRrn 20u 0
D JeCmtCclId 20u 0
D JePtrHdl 10u 0
D JeRmtPort 5u 0
D JeArmNbr 5u 0
D JePgmLibAsp 5u 0
D JeRmtAdr 16a
D JeJrnCde 1a
D JeEntTyp 2a
D JeJobNam 10a
D JeUsrNam 10a
D JeJobNbr 6a
D JePgmNam 10a
D JePgmLib 10a
D JePgmLibAspDv 10a
D JeObject 30a
D JeUsrPrf 10a
D JeJrnId 10a
D JeAdrFam 1a
D JeSysNam 8a
D JeIndFlg 1a
D JeObjNamInd 1a
D JeBitFld 1a
D JeObjTyp 10a
D JeRsv 3a
**
** JeBitFld:
D Ds
D JbRefCst 1s 0
D JbTrg 1s 0
D JbIncDta 1s 0
D JbIgnApyRmvJ 1s 0
D JbMinEntDta 1s 0
D JbFilTypInd 1s 0
D JbMinFldBnd 1s 0
D JbRsv 3a
**-- Null values - *VARLEN:
D JeNulValVar Ds Based( pNulVal )
D JnNulValLen 10i 0
D JnNulValIndV 512a
**-- Null values - length:
D JeNulValLen Ds Based( pNulVal )
D JnNulValIndL 512a
**-- Entry data:
D JeEntDta Ds Based( pEntDta )
D JdEntDtaLen 5s 0
D 11a
D JdEntDta 8192a
**-- Logical unit of work:
D JeLglUoW Ds Based( pLglUow )
D JuLglUoW 39a
**-- Receiver information:
D JeRcvInf Ds Based( pRcvInf )
D JrRcvNam 10a
D JrRcvLib 10a
D JrRcvLibAspDv 10a
D JrRcvLibAspNb 5i 0
**
**-- Retrieve journal entry selection records: -------------------------**
D JrnEntRtv Ds
D JeNbrVarRcd 10i 0
**-- RCVRNG - *CURRENT, *CURCHAIN
D JrnVarR01 Ds
D JvR01RcdLen 10i 0 Inz( %Size( JrnVarR01 ))
D JvR01Key 10i 0 Inz( 1 )
D JvR01DtaLen 10i 0 Inz( %Size( JvR01Dta ))
D JvR01Dta 40a Inz( '*CURCHAIN' )
D JvR01RcvStr 10a Overlay( JvR01Dta: 1 )
D JvR01LibStr 10a Overlay( JvR01Dta: *Next )
D JvR01RcvEnd 10a Overlay( JvR01Dta: *Next )
D JvR01LibEnd 10a Overlay( JvR01Dta: *Next )
**-- FROMENT - *FIRST
D JrnVarR02 Ds
D JvR02RcdLen 10i 0 Inz( %Size( JrnVarR02 ))
D JvR02Key 10i 0 Inz( 2 )
D JvR02DtaLen 10i 0 Inz( %Size( JvR02Dta ))
D JvR02Dta 20a Inz( '*FIRST' )
D JvR02SeqNbr 20s 0 Overlay( JvR02Dta )
**-- FROMTIME
D JrnVarR03 Ds
D JvR03RcdLen 10i 0 Inz( %Size( JrnVarR03 ))
D JvR03Key 10i 0 Inz( 3 )
D JvR03DtaLen 10i 0 Inz( %Size( JvR03Dta ))
D JvR03Dta 26a
**-- TOENT - *LAST
D JrnVarR04 Ds
D JvR04RcdLen 10i 0 Inz( %Size( JrnVarR04 ))
D JvR04Key 10i 0 Inz( 4 )
D JvR04DtaLen 10i 0 Inz( %Size( JvR04Dta ))
D JvR04Dta 20a Inz( '*LAST' )
**-- TOTIME
D JrnVarR05 Ds
D JvR05RcdLen 10i 0 Inz( %Size( JrnVarR05 ))
D JvR05Key 10i 0 Inz( 5 )
D JvR05DtaLen 10i 0 Inz( %Size( JvR05Dta ))
D JvR05Dta 26a
**-- NBRENT
D JrnVarR06 Ds
D JvR06RcdLen 10i 0 Inz( %Size( JrnVarR06 ))
D JvR06Key 10i 0 Inz( 6 )
D JvR06DtaLen 10i 0 Inz( %Size( JvR06Dta ))
D JvR06Dta 10i 0 Inz( 1000 )
**-- JRNCDE - *ALL, *CTL / *ALLSLT, *IGNFILSLT
D JrnVarR07 Ds
D JvR07RcdLen 10i 0 Inz( %Size( JrnVarR07 ))
D JvR07Key 10i 0 Inz( 7 )
D JvR07DtaLen 10i 0 Inz( %Size( JvR07Dta ))
D JvR07Dta
D JcNbrCod 10i 0 Overlay( JvR07Dta: 1 )
D JcJrnCod 20a Overlay( JvR07Dta: *Next )
D Dim( 16 )
D JcJrnCodVal 10a Overlay( JcJrnCod: 1 )
D JcJrnCodSlt 10a Overlay( JcJrnCod: *Next )
**-- ENTTYP - *ALL, *RCD
D JrnVarR08 Ds
D JvR08RcdLen 10i 0 Inz( %Size( JrnVarR08 ))
D JvR08Key 10i 0 Inz( 8 )
D JvR08DtaLen 10i 0 Inz( %Size( JvR08Dta ))
D JvR08Dta
D JcNbrTyp 10i 0 Overlay( JvR08Dta: 1 )
D JcEntTyp 10a Overlay( JvR08Dta: *Next )
D Dim( 16 )
**-- JOB - *ALL
D JrnVarR09 Ds
D JvR09RcdLen 10i 0 Inz( %Size( JrnVarR09 ))
D JvR09Key 10i 0 Inz( 9 )
D JvR09DtaLen 10i 0 Inz( %Size( JvR09Dta ))
D JvR09Dta 26a Inz( '*ALL' )
**-- PGM - *ALL
D JrnVarR10 Ds
D JvR10RcdLen 10i 0 Inz( %Size( JrnVarR10 ))
D JvR10Key 10i 0 Inz( 10 )
D JvR10DtaLen 10i 0 Inz( %Size( JvR10Dta ))
D JvR10Dta 10a Inz( '*ALL' )
**-- USRPRF * *ALL
D JrnVarR11 Ds
D JvR11RcdLen 10i 0 Inz( %Size( JrnVarR11 ))
D JvR11Key 10i 0 Inz( 11 )
D JvR11DtaLen 10i 0 Inz( %Size( JvR11Dta ))
D JvR11Dta 10a Inz( '*ALL' )
**-- CMTCYCID - *ALL
D JrnVarR12 Ds
D JvR12RcdLen 10i 0 Inz( %Size( JrnVarR12 ))
D JvR12Key 10i 0 Inz( 12 )
D JvR12DtaLen 10i 0 Inz( %Size( JvR12Dta ))
D JvR12Dta 20a Inz( '*ALL' )
**-- DEPENT - *ALL, *NONE
D JrnVarR13 Ds
D JvR13RcdLen 10i 0 Inz( %Size( JrnVarR13 ))
D JvR13Key 10i 0 Inz( 13 )
D JvR13DtaLen 10i 0 Inz( %Size( JvR13Dta ))
D JvR13Dta 10a Inz( '*ALL' )
**-- INCENT - *CONFIRMED, *ALL
D JrnVarR14 Ds
D JvR14RcdLen 10i 0 Inz( %Size( JrnVarR14 ))
D JvR14Key 10i 0 Inz( 14 )
D JvR14DtaLen 10i 0 Inz( %Size( JvR14Dta ))
D JvR14Dta 10a Inz( '*CONFIRMED' )
**-- NULLINDLEN - *VARLEN
D JrnVarR15 Ds
D JvR15RcdLen 10i 0 Inz( %Size( JrnVarR15 ))
D JvR15Key 10i 0 Inz( 15 )
D JvR15DtaLen 10i 0 Inz( %Size( JvR15Dta ))
D JvR15Dta 10a Inz( '*VARLEN' )
**-- FILE - *ALLFILE, *ALL
D JrnVarR16 Ds
D JvR16RcdLen 10i 0 Inz( %Size( JrnVarR16 ))
D JvR16Key 10i 0 Inz( 16 )
D JvR16DtaLen 10i 0 Inz( %Size( JvR01Dta ))
D JvR16Dta
D JcNbrFil 10i 0 Overlay( JvR16Dta: 1 )
D JcFilNamQ 30a Overlay( JvR16Dta: *Next )
D Dim( 16 )
D JfFilNam 10a Overlay( JcFilNamQ: 1 )
D JfLibNam 10a Overlay( JcFilNamQ: *Next )
D JfMbrNam 10a Overlay( JcFilNamQ: *Next )
**-- Retrieve journal entries: -----------------------------------------**
D RtvJrnE Pr ExtProc( 'QjoRetrieveJournalEntries')
D RjRcvVar 32767a Options( *VarSize )
D RjRcvVarLen 10i 0 Const
D RjJrnNamQ 20a Const
D RjRcvInfFmt 8a Const
D RjSltInf 32767a Const Options( *NoPass: *VarSize )
D RjError 32767a Options( *NoPass: *VarSize )
**-- Delete pointer handle: --------------------------------------------**
D DltPtrHdl Pr ExtProc( 'QjoDeletePointerHandle' )
D DhPtrHdl 10u 0 Const
D DhError 32767a Options( *NoPass: *VarSize )
**-- Test bit in string: -----------------------------------------------**
D tstbts Pr 10i 0 ExtProc( 'tstbts' )
D String * Value
D BitOfs 10u 0 Value
**-- Convert date & time: ----------------------------------------------**
D CvtDtf Pr ExtPgm( 'QWCCVTDT' )
D CdInpFmt 10a Const
D CdInpVar 17a Const Options( *VarSize )
D CdOutFmt 10a Const
D CdOutVar 17a Options( *VarSize )
D CdError 10i 0 Const
**-- Convert IP address to xxx.xxx.xxx.xxx format -----------------------**
D INET_NTOA PR * EXTPROC('inet_ntoa')
D INTERNET_ADDR 10U 0 VALUE
D IPADR DS 4
D SIN_ADR 10U 0
*Array for contain EntTyp
D EntTypAry S 2 Dim(50)
D EntTypAryDs DS
D EntTypSiz 4B 0
D EntTypAryTmp 2 Dim(50)
**-- --**
D CVTJRNER Pr
D RCVRNAME 10a Const
D RCVRLIB 10a Const
D ENTTYPDS 102a Const
D CVTJRNER Pi
D RCVRNAME 10a Const
D RCVRLIB 10a Const
D ENTTYPDS 102a Const
**
**-- Mainline: ---------------------------------------------------------**
**
C Eval *InLr = *On
**-- Setup entry type selection criteria - replace values and number
**-- of values if applicable for your test purposes:
C Eval JvR01RcvStr = RCVRNAME
C Eval JvR01LibStr = RCVRLIB
C Eval JvR01RcvEnd = RCVRNAME
C Eval JvR01LibEnd = RCVRLIB
C Eval EntTypAryDs = ENTTYPDS
C For idx = 1 to EntTypSiz
C Eval EntTypAry(idx) = EntTypAryTmp(idx)
C EndFor
**
**-- Replace journal name and library if appropriate for your
**-- environment. Journal selection entries can be added and
**-- removed as necessary - just set JeNbrVarRcd accordingly:
C Eval JeNbrVarRcd = 2
**
C DoU JhConInd = '0' Or
C AeBytAvl > *Zero
**
C CallP RtvJrnE( JeRcvVar
C : %Size( JeRcvVar )
C : 'QAUDJRN *LIBL '
C : 'RJNE0200'
C : JrnEntRtv +
C JrnVarR01 +
C JrnVarR02
C : ApiError
C )
**
C If AeBytAvl = *Zero
C Eval pEntHdr = %Addr( JeRcvVar ) +
C JhOfsHdrJrnE
**
C For Idx = 1 to JhNbrEntRtv
**
C ExSr PrcLstEnt
**
C If JePtrHdl > *Zero
C CallP(e) DltPtrHdl( JePtrHdl )
C EndIf
**
C If Idx < JhNbrEntRtv
C Eval pEntHdr = pEntHdr + JeOfsHdrJrnE
C EndIf
**
C EndFor
**
C If JhConInd = '1'
C Eval JvR01RcvStr = JhConRcvStr
C Eval JvR01LibStr = JhConLibStr
C* Eval JvR01RcvEnd = '*CURRENT'
C Eval JvR02SeqNbr = JhConSeqNbr
C EndIf
C EndIf
**
C EndDo
**
C Eval *InLr = *On
C Return
**
**-- Process list entry: -----------------------------------------------**
C PrcLstEnt BegSr
**
C Eval JbRefCst = tstbts( %Addr( JeBitFld ): 0 )
C Eval JbTrg = tstbts( %Addr( JeBitFld ): 1 )
C Eval JbIncDta = tstbts( %Addr( JeBitFld ): 2 )
C Eval JbIgnApyRmvJ = tstbts( %Addr( JeBitFld ): 3 )
C Eval JbMinEntDta = tstbts( %Addr( JeBitFld ): 4 )
C Eval JbFilTypInd = tstbts( %Addr( JeBitFld ): 5 )
C Eval JbMinFldBnd = tstbts( %Addr( JeBitFld ): 6 )
**
C Eval pEntDta = pEntHdr + JeOfsEntDta
C Eval EntDta = %SubSt( JdEntDta
C : 1
C : JdEntDtaLen
C )
**
C If JeOfsNulValI > *Zero
C Eval pNulVal = pEntHdr + JeOfsNulValI
C EndIf
**
C If JeOfsLglUoW > *Zero
C Eval pLglUow = pEntHdr + JeOfsLglUoW
C EndIf
**
C If JeOfsRcvInf > *Zero
C Eval pRcvInf = pEntHdr + JeOfsRcvInf
C EndIf
**
C Eval JrnDta = EntDta
C
C JeEntTyp lookup EntTypAry(1) 99
C If EntTypAry(1) = '*A' or
C *In99 = *On
**
C CallP CvtDtf( '*DTS'
C : JeTimStpC
C : '*YYMD'
C : JrnEntDts
C : 0
C )
**
C eval SYSNAM = JeSysNam
C eval JRNSEQ = JeSeqNbr
C eval JRNCDE = JeJrnCde
C eval JRNENTTYP = JeEntTyp
C eval JOBNAM = JeJobNam
C eval USRNAM = JeUsrNam
C eval JOBNBR = JeJobNbr
C eval PGMNAM = JePgmNam
C eval PGMLIB = JePgmLib
C eval OBJECT = JeObject
C eval USRPRF = JeUsrPrf
C eval RCVNAM = JrRcvNam
C eval RCVLIB = JrRcvLib
C eval ADRFAM = JeAdrFam
C If JeRmtAdr = *ALLX'00'
C eval RMTADR = ' '
C Else
C eval IPADR = %SubSt(JeRmtAdr:13:4)
C eval RMTADR = %STR(INET_NTOA(SIN_ADR))
C EndIf
C eval RMTPORT= JeRmtPort
C eval ARMNBR = JeArmNbr
C eval PGMLIBASP =JePgmLibAsp
C eval PGMLIBASPD=JePgmLibAspDv
C eval OBJNAMID =JeObjNamInd
C eval OBJTYPE =JeObjTyp
C eval ENTDTALEN = JdEntDtaLen
C eval JRNENTDTA = ENTDTA
C write JRNRCVR
**
C EndIf
C EndSr
File : QCLSRC
Member: CVTJRNEC
Type : CLP
Usage : CRTCLPGM CVTJRNEC
/*-------------------------------------------------------------------*/
/* */
/* Program . . : CVTJRNEC */
/* Description : Convert journal entry to PF */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : June 26, 2014 */
/* */
/* Program function: CVTJRNE command processing program */
/* */
/* */
/* Program summary */
/* --------------- */
/* */
/* */
/* */
/* Compile options: */
/* CrtClPgm Pgm( CVTJRNEC ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* */
/*-------------------------------------------------------------------*/
Pgm ( &QualRcvr +
&ToFile +
&EntTypDs +
)
/*-- Parameters: ---------------------------------------------------*/
Dcl &QualRcvr *Char 20
Dcl &ToFile *Char 20
Dcl &RcvrName *Char 10
Dcl &RcvrLib *Char 10
Dcl &RtnLib *Char 10
Dcl &ToFileName *Char 10
Dcl &ToFileLib *Char 10
Dcl &EntTypDs *Char 102
Dcl &NbrOfTypsC *Char 2
Dcl &NbrOfTyps *Dec (2 0)
/*-- Global error monitoring: --------------------------------------*/
MonMsg CPF0000 *N GoTo Error
ChgVar &RcvrName %SST(&QualRcvr 1 10)
ChgVar &RcvrLib %SST(&QualRcvr 11 10)
ChgVar &ToFileName %SST(&ToFile 1 10)
ChgVar &ToFileLib %SST(&ToFile 11 10)
ChgVar &NbrOfTypsC %SST(&EntTypDs 1 2)
ChgVar &NbrOfTyps %BIN(&NbrOfTypsC)
RtvObjD Obj(&RcvrLib/&RcvrName) +
ObjType(*JRNRCV) +
RtnLib(&RtnLib)
ChgVar &RcvrLib &RtnLib
DltF &ToFileLib/&ToFileName
MonMsg CPF0000
CrtDupObj Obj(JRNRCVRP) +
FromLib(*LIBL) +
ObjType(*FILE) +
ToLib(&ToFileLib) +
NewObj(&ToFileName) +
Cst(*NO) +
Trg(*NO)
OvrDbf File(JRNRCVRP) +
ToFile(&ToFileLib/&ToFileName) +
OvrScope(*JOB)
Call CVTJRNER ( &RcvrName &RcvrLib &EntTypDs)
DltOvr File(JRNRCVRP) Lvl(*JOB)
Return:
Return
/*-- Error handling: -----------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: CVTJRNE
Type : CMD
Usage : CRTCMD CMD(CVTJRNE) PGM(CVTJRNEC)
/*-------------------------------------------------------------------*/
/* */
/* Command . . : CVTJRNE */
/* Description : Convert journal entry to PF */
/* Author . . : Vrngoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : June 26, 2014 */
/* */
/* */
/* */
/* */
/* Programmer's notes: */
/* */
/* */
/* Compile options: */
/* */
/* CrtCmd Cmd( CVTJRNE ) */
/* Pgm( CVTJRNEC ) */
/* */
/*-------------------------------------------------------------------*/
Cmd Prompt( 'Convert journal entry to PF' )
Parm JRNRCVR Q0001 +
Min( 1 ) +
Choice( *NONE ) +
Prompt( 'Journal receiver' 1 )
Parm TOFILE Q0002 +
Min( 1 ) +
Choice( *NONE ) +
Prompt('To data base file' 2)
Parm KWD(ENTTYP) +
TYPE(*CHAR) +
LEN(2) +
DFT(*ALL) +
SPCVAL((*ALL '*A')) +
MAX(50) +
PROMPT('Journal entry types' 3)
Q0001: Qual *Name 10 +
Min( 1 ) +
Expr( *YES )
Qual Type(*Name) +
Len(10) +
Dft(*LIBL) +
SpcVal((*LIBL) (*CURLIB)) +
Expr(*YES) +
Prompt('Library')
Q0002: QUAL TYPE(*NAME) +
LEN(10) +
MIN(1) +
EXPR(*YES)
QUAL TYPE(*NAME) +
LEN(10) +
DFT(*LIBL) +
SPCVAL( +
(*LIBL ) +
(*CURLIB '*CURLIB ')) +
EXPR(*YES) +
PROMPT('Library')
訂閱：
文章 (Atom)