RPGIV @ Work

A unique site for RPG and System i Lovers

Welcome!

Hi, this site will provide all what you need in System i and RPG developments.

My Name is Chamara Withanachchi, System i Expert and RPG Developer. And in the field for last 11 years.

I hope you will find lot of valuable information from this site

Save Logs and Security Journals Print E-mail
User Rating: / 1
PoorBest 
Written by Chamara Withanachchi   
     H DATEDIT(*YMD) FORMSALIGN(*NO) INDENT('| ') DECEDIT(*JOBRUN)
     H OPTION(*NODEBUGIO:*SRCSTMT) DFTACTGRP(*NO)

      *---------------------------------------------------------------*
      *                                                               *
      * Application      : Utilities                                  *
      * Module           : Save                                       *
      * Title            : Save Journals and Logs                     *
      * Description      : This program will save QAUD Journals and   *
      *                    job logs to tape drive also saves          *
      *                    application related journals to tape drive *
      *                                                               *
      * Author           : Chamara Withanachchi                       *
      * Version          : V 1.0.0                                    *
      * Date             : 2010/09/14                                 *
      *                                                               *
      *---------------------------------------------------------------*
      * MODIFICATIONS                                                 *
      *                                                               *
      *---------------------------------------------------------------*

      *---------------------------------------------------------------*
      /TITLE File specifications
      *---------------------------------------------------------------*

      * NO FILES

      *---------------------------------------------------------------*
      /TITLE *ENTRY
      *---------------------------------------------------------------*
     D saveLog_Jrn     PR                  ExtPgm('SAVLOGJRN')
     D   tapName                     10a

     D saveLog_Jrn     PI
     D   tapName                     10a

      *---------------------------------------------------------------*
      /TITLE Work Variables
      *---------------------------------------------------------------*
     D prvDate         S              5a
     D objExtFlag      S              1a
     D objName         S             10a
     D objType         S             10a
     D cUsrSpcNam      S             20a   Inz('SAVUSROBJ QTEMP     ')
     D max#Objs        S              9b 0 Inz(%Elem(ObjArr))
     D lenUsrSpc       S              9b 0
     D startPos        S              9b 0 Inz(1)
     D auxForce        S              1a
     D rError          S              4
     D size            S             10i 0
     D MsgKey          S              4a
     D ErrCode         S              8a   inz(x'0000000000000000')
     D devExtFlag      S              1a

      *---------------------------------------------------------------*
      /TITLE Data Strectures
      *---------------------------------------------------------------*
      *  Data structure for user space (note, 4-byte binary fields must
      *  be defined as 9.0 in RPG). Lx = record length, Kx = Key,
      *  LPx = Length of key-specific Parameter data.

     D UsrSpc          DS
      *     #Keys = the number of records that follow.
     D   #Keys                        9b 0 Inz(4)
      *     Library info record.
     D   L1                           9b 0 Inz(26)
     D   K1                           9b 0 Inz(2)
     D   LP1                          9b 0 Inz(14)
     D   #Libs                        9b 0 Inz(1)
     D   LibName                     10
      *     Tape device record.
     D   L2                           9b 0 Inz(26)
     D   K2                           9b 0 Inz(3)
     D   LP2                          9b 0 Inz(14)
     D   #Devs                        9b 0 Inz(1)
     D   devName                     10
      *     End-of-tape option record.
     D   L3                           9b 0 Inz(13)
     D   K3                           9b 0 Inz(10)
     D   LP3                          9b 0 Inz(1)
     D   EndTapeOpt                   1    Inz('1')
      *     Object info record (length not known).
     D   L4                           9b 0
     D   K4                           9b 0 Inz(1)
     D   LP4                          9b 0
     D   #Objs                        9b 0
     D   objArr                      20    dim(5)

     D dsEC            DS                  qualified
     D  BytesProvided                10i 0 inz(%size(dsEC))
     D  BytesAvail                   10i 0 inz(0)
     D  MessageID                     7a
     D  Reserved                      1a
     D  MessageData                 240a

      *---------------------------------------------------------------*
      /TITLE Procedure Definitions
      *---------------------------------------------------------------*
     D chkObjExt       PR             1a
     D  objName                      10a
     D  objType                      10a

     D saveObject      PR

     D inzForNewCall   PR

     D wtrUsrSpc       PR                  EXTPGM('QUSCHGUS')
     D   usrSpcName                  20a
     D   strPos                            Like(StartPos)
     D   usrLen                            Like(LenUsrSpc)
     D   usrSpce                           Like(UsrSpc)
     D   Force2Aux                    1a

     D savObject       PR                  EXTPGM('QSRSAVO')
     D   spcName                     20a
     D   resigError                   4

     D crtUsrSpc       PR                  extpgm('QUSCRTUS')
     D   UsrSpc                      20a   const
     D   ExtAttr                     10a   const
     D   InitialSize                 10i 0 const
     D   InitialVal                   1a   const
     D   PublicAuth                  10a   const
     D   Text                        50a   const
     D   Replace                     10a   const
     D   ErrorCode                32766a   options(*nopass: *varsize)

     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   CallStkCnt                  10I 0 Const
     D   MessageKey                   4A
     D   ErrorCode                    1A

      *---------------------------------------------------------------*
      /TITLE Main Line Program
      *---------------------------------------------------------------*

      /Free

         // Initialize for every call
         inzForNewCall();

         // Validate Tape Drive Name
         objType = '*DEVD';
         devExtFlag = chkObjExt(tapName : objType);
         If devExtFlag = '0';
           // Terminate the Program
           SndPgmMsg( 'CPF9897'
                      : 'QCPFMSG   *LIBL'
                      : 'Invalid Tape Drive'
                      : 80
                      : '*ESCAPE'
                      : '*PGMBDY'
                      : 1
                      : MsgKey
                      : ErrCode );
           *inLR = *ON;
           Return;
         EndIf;

         // Check for History Log
         objExtFlag = chkObjExt(objName : objType);

         If objExtFlag = '1'; // Object Found
            // First Save the QHST log Version for the julian date created above
            objName = 'QHST' + %Trim(prvDate) + '*';
            libName = 'QSYS';
            objArr(1) = objName + objType;
            EndTapeOpt = '0';
            saveObject();
         EndIf;

         // Save the Audit Journals
         objName = 'AUDRCV' + '*';
         objType = '*JRNRCV';
         libName = 'QGPL';
         EndTapeOpt = '0';
         objArr(1) = objName + objType;
         saveObject();

         // Save the Journal Receivers
         objName = '#*';
         objType = '*JRNRCV';
         libName = 'I720SDBRCV';
         EndTapeOpt = '0';
         objArr(1) = objName + objType;
         saveObject();

         *inLR = *ON;

      /End-Free

      *---------------------------------------------------------------*
      /TITLE Subprocedure Section
      *---------------------------------------------------------------*

      *---------------------------------------------------------------*
      * This procedure will check the existance of the object         *
      * before running the backup command                             *
      *                                                               *
      * Name       : chkObjExt                                        *
      * Parameters : objName - Object Name                            *
      * Return     : Object Exists/Not                                *
      *---------------------------------------------------------------*
     P chkObjExt       B

     D chkObjExt       PI             1a
     D  objName                      10a
     D  objType                      10a

     D objFound        S              1a
     D objNam          S             10a
     D objLib          S             10a
     D objTyp          S             10a

      * Api error data structure
     D apiError        DS
     D  aeBytPro                     10i 0 Inz( %Size( ApiError ))
     D  aeBytAvl                     10i 0 Inz
     D  aeMsgId                       7a
     D                                1a
     D  aeMsgDta                    128a

      * Object description structure OBJD0100
     D roData          DS
     D  roBytRtn                     10i 0
     D  roBytAvl                     10i 0
     D  roObjNam                     10a
     D  roObjLib                     10a
     D  roObjTypRt                   10a
     D  roObjLibRt                   10a
     D  roObjASP                     10i 0
     D  roObjOwn                     10a
     D  roObjDmn                      2a
     D  roObjCrtDts                  13a
     D  roObjChgDts                  13a
     D  roExtAtr                     10a
     D  roTxtDsc                     50a
     D  roSrcF                       10a
     D  roSrcLib                     10a
     D  roSrcMbr                     10a

      * Retrieve object description
     D rtvObjD         PR                  ExtPgm('QUSROBJD')
     D  roRcvVar                  32767a   Options( *VarSize )
     D  roRcvVarLen                  10i 0 Const
     D  roFmtNam                      8a   Const
     D  roObjNamQ                    20a   Const
     D  roObjTyp                     10a   Const
     D  roError                   32767a   Options( *VarSize )

      /Free

         objNam = objName;
         objLib = '*LIBL';
         objTyp = objType;

         RtvObjD( roData
                 : %Size( roData )
                 : 'OBJD0100'
                 : objNam + objLib
                 : objTyp
                 : apiError);

         If aeBytAvl > *Zero And (aeMsgId = 'CPF9801' Or
                                  aeMsgId = 'CPF9812' Or
                                  aeMsgId = 'CPF9814');
            // Object not found
            objFound = '0';
         Else;
            objFound = '1';
         EndIf;

         Return objFound;

      /End-Free

     P chkObjExt       E

      *---------------------------------------------------------------*
      * This procedure save objects to given tape drive               *
      *                                                               *
      * Name       : saveObject                                       *
      * Parameters : NONE                                             *
      * Return     : NONE                                             *
      *---------------------------------------------------------------*
     P saveObject      B

     D saveObject      PI

      /Free

         // Set the len of the var-len record (L4) and the len of
         //  parm data (LP4) for the Object Information record.
         LP4 = (#Objs * 20) + 4;
         L4 = LP4 + 12;

         // Set the len of data in data structure.
         LenUsrSpc = L1 + L2 + L3 + L4 + 4;

         // Write it to the user space.
         auxForce = '0';
         wtrUsrSpc(cUsrSpcNam :
                   StartPos   :
                   LenUsrSpc  :
                   UsrSpc     :
                   auxForce);

          // Call the QSRSAVO API to perform save.
          rError = x'00000000';
          savObject(cUsrSpcNam :
                    rError);

      /End-Free

     P saveObject      E

      *---------------------------------------------------------------*
      * This procedure will inizilize all variables for fresh program *
      * call.                                                         *
      *                                                               *
      * Name       : inzForNewCall                                    *
      * Parameters : NONE                                             *
      * Return     : NONE                                             *
      *---------------------------------------------------------------*
     P inzForNewCall   B

     D inzForNewCall   PI

      /Free

         dsEC.BytesProvided = 0;

         // Get the Prevous Day's Date (in Julian Format)
         prvDate = %Char((%Date() - %Days(1)) : *JUL0);

         // Check for object existence
         objName = 'QHST' + %Trim(prvDate) + 'A';
         objType = '*FILE';
         size = 12000;
         crtUsrSpc(cUsrSpcNam :
                   'USRSPC'   :
                   size       :
                   x'00'      :
                   '*ALL'     :
                   'Usr Spc'  :
                   '*YES'     :
                   dsEC       );
         devName = tapName;
         #Objs = 1;

      /End-Free

     P inzForNewCall   E
 

User Comments

Please login or register to add comments

<Previous   Next>