QJo...Retrieve Journal APIs (A RPGIV Demo)
**
** Program . . : CBX126T
** Description : Demonstrate the use of the QjoRetrieveJournalInformation API
** Author . . : Carsten Flensburg
** Published . : Club Tech iSeries Programming Tips Newsletter
** Date . . . : October 28, 2004
**
**
** To run this sample program compile it as described below, start a
** debug session, call it, and then step throug the program in the
** debugger:
**
** StrDbg Pgm( CBX126T ) - Press F10
**
** Call Pgm( CBX126T ) - Press F10 repeatedly
**
**
** Compile options:
**
** CrtRpgMod Module( CBX126T )
** DbgView( *LIST )
**
** CrtPgm Pgm( CBX126T )
** Module( CBX126T )
**
**
**-- Header specifications: --------------------------------------------**
H Option( *SrcStmt )
**-- Global declarations:
D Idx s 10u 0
D ApiRcvSiz s 10u 0
**-- Api error data structure:
D ERRC0100 Ds Qualified
D BytPro 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0 Inz
D MsgId 7a
D 1a
D MsgDta 128a
**-- Journal information:
D RJRN0100 Ds Based( pJrnInf ) Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D OfsKeyInf 10i 0
D JrnNam 10a
D JrnLib 10a
D ASP 10i 0
D MsgQnam 10a
D MsgQlib 10a
D MngRcvOpt 1a
D DltRcvOpt 1a
D RsoRit 1a
D RsoMfl 1a
D RsoMo1 1a
D RsoMo2 1a
D Rsv1 3a
D JrnTyp 1a
D RmtJrnTyp 1a
D JrnStt 1a
D JrnDlvMod 1a
D LocJrnNam 10a
D LocJrnLib 10a
D LocJrnSys 8a
D SrcJrnNam 10a
D SrcJrnLib 10a
D SrcJrnSys 8a
D RdrRcvLib 10a
D JrnTxt 50a
D MinEntDtaAr 1a
D MinEntFiles 1a
D Rsv2 9a
D NbrAtcRcv 10i 0
D AtcRcvNam 10a
D AtcRcvLib 10a
D AtcLocSys 8a
D AtcSrcSys 8a
D AtcRcvNamDu 10a
D AtcRcvLibDu 10a
D MngRcvDly 10i 0
D DltRcvDly 10i 0
D AspDevNam 10a
D LclJrnAspGrp 10a
D SrcJrnAspGrp 10a
D FixDtaJob 1a
D FixDtaUsr 1a
D FixDtaPgm 1a
D FixDtaPgmLib 1a
D FixDtaSysSeq 1a
D FixDtaRmtAdr 1a
D FixDtaThd 1a
D FixDtaLuw 1a
D FixDtaXid 1a
D Rsv3 145a
D NbrKey 10i 0
**
D JrnKey Ds Based( pJrnKey ) Qualified
D Key 10i 0
D OfsKeyInf 10i 0
D KeyHdrSecLn 10i 0
D NbrEnt 10i 0
D KeyInfEntLn 10i 0
**
D JrnKeyHdr1 Ds Based( pKeyHdr1 ) Qualified
D RcvNbrTot 10i 0
D RcvSizTot 10i 0
D RcvSizMtp 10i 0
D Rsv 8a
**
D JrnKeyEnt1 Ds Based( pKeyEnt1 ) Qualified
D RcvNam 10a
D RcvLib 10a
D RcvNbr 5a
D RcvAtcDts 13a
D RcvSts 1a
D RcvSavDts 13a
D LocJrnSys 8a
D SrcJrnSys 8a
D RcvSiz 10i 0
D Rsv 56a
**
D JrnKeyHdr2 Ds Based( pKeyHdr2 )
D JrnFilNbrTot 10i 0
D JrnMbrNbrTot 10i 0
D JrnDtaNbrTot 10i 0
D JrnDtqNbrTot 10i 0
D JrnIfsNbrTot 10i 0
D Rsv 16a
**
D JrnKeyEnt2 Ds Based( pKeyEnt2 ) Qualified
D ObjTyp 10a
D ObjNam 10a
D ObjLib 10a
D ObjFilId 16a
D Rsv 2a
**
D JrnKeyHdr3 Ds Based( pKeyHdr3 ) Qualified
D RmtJrnNbrTot 10i 0
D Rsv 16a
**
D JrnKeyEnt3 Ds Based( pKeyEnt3 ) Qualified
D RdbDirE 18a
D RmtJrnNam 10a
D RmtJrnLib 10a
D RmtJrnRcvLb 10a
D CijJrnRcv 10a
D CijJrnRcvLb 10a
D CijSeqNbr 10i 0
D Rsv1 10i 0
D RmtJrnTyp 1a
D RmtJrnStt 1a
D RmtJrnDlvMd 1a
D Rsv2 1a
D SndTskPty 10i 0
D CijSeqNbrLg 20a
D Rsv3 60a
D RdbDirDtl 512a
D Rsv 348a
**-- Journal information specification:
D JrnInfRtv1 Ds Qualified
D NbrVarRcd 10i 0 Inz( 1 )
D VarRcdLen 10i 0 Inz( 12 )
D Key 10i 0 Inz( 1 )
D DtaLen 10i 0 Inz( 0 )
**
D JrnInfRtv2 Ds Qualified
D NbrVarRcd 10i 0 Inz( 1 )
D VarRcdLen 10i 0 Inz( 22 )
D Key 10i 0 Inz( 2 )
D DtaLen 10i 0 Inz( %Size( JrnInfRtv2.Dta ))
D Dta
D JrnObjInf 10a Overlay( Dta ) Inz( '*ALL' )
**
D JrnInfRtv3 Ds Qualified
D NbrVarRcd 10i 0 Inz( 1 )
D VarRcdLen 10i 0 Inz( 60 )
D Key 10i 0 Inz( 3 )
D DtaLen 10i 0 Inz( %Size( JrnInfRtv3.Dta ))
D Dta
D RdbDirEinf 18a Overlay( Dta ) Inz( '*ALL' )
D RmtJrnNam 20a Overlay( Dta: *Next ) Inz( '*ALL' )
**-- Receiver information:
D RRCV0100 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D RcvNam 10a
D RcvLib 10a
D JrnNam 10a
D JrnLib 10a
D Thh 10i 0
D Siz 10i 0
D ASP 10i 0
D NbrJrnEnt 10i 0
D MaxEspDtaLn 10i 0
D MaxNulInd 10i 0
D FstSeqNbr 10i 0
D MinEntDtaAr 1a
D MinEntFiles 1a
D Rsv1 2a
D LstSeqNbr 10i 0
D Rsv2 10i 0
D Sts 1a
D MinFxlVal 1a
D RcvMaxOpt 1a
D Rsv3 4a
D AtcDts 13a
D DtcDts 13a
D SavDts 13a
D Txt 50a
D PndTrn 1a
D RmtJrnTyp 1a
D LocJrnNam 10a
D LocJrnLib 10a
D LocJrnSys 8a
D LocRcvLib 10a
D SrcJrnNam 10a
D SrcJrnLib 10a
D SrcJrnSys 8a
D SrcRcvLib 10a
D RdcRcvLib 10a
D DuaRcvNam 10a
D DuaRcvLib 10a
D PrvRcvNam 10a
D PrvRcvLib 10a
D PrvRcvNamDu 10a
D PrvRcvLibDu 10a
D NxtRcvNam 10a
D NxtRcvLib 10a
D NxtRcvNamDu 10a
D NxtRcvLibDu 10a
D NbrJrnEntL 20s 0
D MaxEspDtlL 20s 0
D FstSeqNbrL 20s 0
D LstSeqNbrL 20s 0
D AspDevNam 10a
D LocJrnAspGn 10a
D SrcJrnAspGn 10a
D FldJob 1a
D FldUsr 1a
D FldPgm 1a
D FldPgmLib 1a
D FldSysSeq 1a
D FldRmtAdr 1a
D FldThd 1a
D FldLuw 1a
D FldXid 1a
D Rsv4 21a
**-- Retrieve journal information:
D RtvJrnInf Pr ExtProc( 'QjoRetrieveJournal-
D Information' )
D JiRcvVar 65535a Options( *VarSize )
D JiRcvVarLen 10i 0 Const
D JiJrnNam 20a Const
D JiFmtNam 8a Const
D JiInfRtv 65535a Const Options( *VarSize )
D JiError 32767a Options( *VarSize: *Omit )
**-- Retrieve journal receiver information:
D RtvRcvInf Pr ExtProc( 'QjoRtvJrnReceiver-
D Information' )
D RiRcvVar 65535a Options( *VarSize )
D RiRcvVarLen 10i 0 Const
D RiRcvNam 20a Const
D RiFmtNam 8a Const
D RiError 32767a Options( *VarSize: *Omit )
**
/Free
ApiRcvSiz = 10240;
pJrnInf = %Alloc( ApiRcvSiz );
RJRN0100.BytAvl = *Zero;
DoU RJRN0100.BytAvl <= ApiRcvSiz Or
ERRC0100.BytAvl > *Zero;
If RJRN0100.BytAvl > ApiRcvSiz;
ApiRcvSiz = RJRN0100.BytAvl;
pJrnInf = %ReAlloc( pJrnInf: ApiRcvSiz );
EndIf;
RtvJrnInf( RJRN0100
: ApiRcvSiz
: 'NOVAJRN NOVAJRNLIB'
: 'RJRN0100'
: JrnInfRtv1
: ERRC0100
);
EndDo;
If ERRC0100.BytAvl = *Zero;
ExSr PrcKeyEnt1;
EndIf;
DoU RJRN0100.BytAvl <= ApiRcvSiz Or
ERRC0100.BytAvl > *Zero;
If RJRN0100.BytAvl > ApiRcvSiz;
ApiRcvSiz = RJRN0100.BytAvl;
pJrnInf = %ReAlloc( pJrnInf: ApiRcvSiz );
EndIf;
RtvJrnInf( RJRN0100
: ApiRcvSiz
: 'NOVAJRN NOVAJRNLIB'
: 'RJRN0100'
: JrnInfRtv2
: ERRC0100
);
EndDo;
If ERRC0100.BytAvl = *Zero;
ExSr PrcKeyEnt2;
EndIf;
DoU RJRN0100.BytAvl <= ApiRcvSiz Or
ERRC0100.BytAvl > *Zero;
If RJRN0100.BytAvl > ApiRcvSiz;
ApiRcvSiz = RJRN0100.BytAvl;
pJrnInf = %ReAlloc( pJrnInf: ApiRcvSiz );
EndIf;
RtvJrnInf( RJRN0100
: ApiRcvSiz
: 'NOVAJRN NOVAJRNLIB'
: 'RJRN0100'
: JrnInfRtv3
: ERRC0100
);
EndDo;
If ERRC0100.BytAvl = *Zero;
ExSr PrcKeyEnt3;
EndIf;
DeAlloc pJrnInf;
Return;
// Process key entries:
BegSr PrcKeyEnt1;
pJrnKey = pJrnInf + RJRN0100.OfsKeyInf + %Size( RJRN0100.NbrKey );
pKeyHdr1 = pJrnKey + JrnKey.OfsKeyInf;
pKeyEnt1 = pKeyHdr1 + %Size( JrnKeyHdr1 );
For Idx = 1 to JrnKey.NbrEnt;
RtvRcvInf( RRCV0100
: %Size( RRCV0100 )
: JrnKeyEnt1.RcvNam + JrnKeyEnt1.RcvLib
: 'RRCV0100'
: ERRC0100
);
If ERRC0100.BytAvl = *Zero;
// Do whatever...
EndIf;
If Idx < JrnKey.NbrEnt;
Eval pKeyEnt1 = pKeyEnt1 + JrnKey.KeyInfEntLn;
EndIf;
EndFor;
EndSr;
BegSr PrcKeyEnt2;
pJrnKey = pJrnInf + RJRN0100.OfsKeyInf + %Size( RJRN0100.NbrKey );
pKeyHdr2 = pJrnKey + JrnKey.OfsKeyInf;
pKeyEnt2 = pKeyHdr1 + %Size( JrnKeyHdr2 );
For Idx = 1 to JrnKey.NbrEnt;
// Do whatever...
If Idx < JrnKey.NbrEnt;
Eval pKeyEnt2 = pKeyEnt2 + JrnKey.KeyInfEntLn;
EndIf;
EndFor;
EndSr;
BegSr PrcKeyEnt3;
pJrnKey = pJrnInf + RJRN0100.OfsKeyInf + %Size( RJRN0100.NbrKey );
pKeyHdr3 = pJrnKey + JrnKey.OfsKeyInf;
pKeyEnt3 = pKeyHdr1 + %Size( JrnKeyHdr3 );
For Idx = 1 to JrnKey.NbrEnt;
// Do whatever...
If Idx < JrnKey.NbrEnt;
Eval pKeyEnt3 = pKeyEnt3 + JrnKey.KeyInfEntLn;
EndIf;
EndFor;
EndSr;
/End-Free
Thanks to Carsten Flensburg writing for
Club Tech iSeries Programming Tips Newsletter
阅读(1542) | 评论(0) | 转发(0) |
