RPG - FAQ & Howtos (IT Part.4)

Last Updated on 12 Maggio 2021 by Roberto De Pedrini

Third episode of the RPG series – FAQ & Howtos, the previous episodes can be found here;

Index

RPG-FAQ-028: RPG Rimappare singoli campi in un Array

Spesso abbiamo la necessità di “rimappare” una serie di capi (ad esempio Mese01, Mese02 … Mese12) in un array per gestire i singoli valori dei campi in cicli DO ecc.

Possiamo utilizzare diverse tecniche … ne prendo un paio da questa discussione di Midrange.com;

Example 01:

Dcl-DS *N;
  SlOthCtr1;
  SlOthCtr2;
  SlOthCtr3;
  SlOthCtr4;
  SlOthCtr5;
  SlOthCtr6;
  SlOthCtr7;
  SlOthCtr8;
  SlOthCtr9;
  SlOthCtr10;
  SlOthCtr11;
  SlOthCtr12;
  SlOthCtr13;
  SlOthCtr14;
  SlOthCtr15;
  SlOthCtr16;
  SlOthCtr17;
  SlOthCtr18;
  SlOthCtr19;
  SlOthCtr20;
  SlOthCtr21;
  SlOthCtr22;
  SlOthCtr23;
  SlOthCtr24;
  SlOthCtr25;
  SlOthCtr26;
  SlOthCtr27;
  SlOthCtr28;
  Containers Char(40) Dim(28) Pos(1);
End-Ds;

Example 2, usinge SAMEPOS 
dcl-ds *n;
   SlOthCtr1;
   SlOthCtr2;
     .
     .
   SlOthCtr28;
   Containers like(SlOthCtr1) dim(28) samepos(SlOthCtr1);
end-ds;

Example 3, using pointer

Since you already have a data structure that contains the S1othCtr*
fields, try this:

Dcl-S Container Char(40) Dim(28) based(ptrCTR);

Dcl-S ptrCTR Pointer inz(%addr(S1OthCtr1));

Una alternativa interessante è quella di utilizzare il LATERAL join per portare i dati in “verticale” quindi permettersi una FETCH da SQL Embedded direttamente dentro l’array:

create table qtemp/monthly (month1 numeric(11,2), month2 numeric(11,
2), month3 numeric(11,2), month4 numeric(11,2), month5 numeric(11,2),
month6 numeric(11,2), month7 numeric(11,2), month8 numeric(11,2),
month9 numeric(11,2),  month10 numeric(11,2),
month11 numeric(11,2), month12 numeric(11,2));

insert into qtemp/monthly values(100, 200, 300, 400, 500, 600, 700, 800, 900, 1000, 1100, 1200);

select mo.* from monthly, lateral ( values 
(1, month1), 
(2, month2), 
(3, month3),
(4, month4), 
(5, month5), 
(6, month6),
(7, month7), 
(8, month8), 
(9, month9),
(10, month10), 
(11, month11), 
(12, month12)
)as mo (month, total)

RPG-FAQ-029: Gestione errori nelle API “Unix-Like”

Per intercettare gli errori quando utilizziamo le API Unix-Like dobbiamo “leggere” Error Number utilizzando la procedure “__errno”, come in questo esempio

//* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
//* GetErrorMessageId
//*   Get the error message Id for the Unix Error.
//*   Input     - None
//*   Out       - None
//*   Returns   - Message Id.
//* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
dcl-proc GetErrorMessageId;
  dcl-pi *N Char(7) end-pi;

  dcl-pr GetErrorNumberApi Pointer ExtProc('__errno') end-pr;

  dcl-s ErrorNumber Int(10) Based(PtrErrorNumber);

  PtrErrorNumber = GetErrorNumberApi();

  Return 'CPE' + %Char(ErrorNumber);

end-proc;

O, alternativamente, utilizzando le procedure della QCLE come in questo esempio:

H BNDDIR('QC2LE')
    
         D/copy qrpglesrc,socket_h
         D/copy qrpglesrc,errno_h
    
            .... more code is found here ....
    
         c                   if        socket(AF_INET:SOCK_STREAM:IPPROTO_IP)<0
         c
         c                   select
         c                   when      errno = EACCES
         c                   eval      Msg = 'Permission Denied'
    
         c                   when      errno = EAFNOSUPPORT
         c                   eval      Msg = 'Address Family not supported!'
    
         c                   when      errno = EIO
         c                   goto      TryAgainMaybe
    
            ... etc, etc, etc ...
    
         c                   endsl
    
            .... more code is found here ....
    
          /define ERRNO_LOAD_PROCEDURE
          /copy libsor/qrpglesrc,errno_h

Maggiori approfondimenti in questo post di Scott Klement: RPG IV Socket Tutorial – Error Handling

RPG-FAQ-030: Gestione Files e Directory IFS con RPG

Possiamo gestire (scrivere, leggere, modificare ecc) files e directory IFS da RPG utilizzando diverse tecniche:

Utilizzando le API “C_IFS”, come spiegato in questo post di Bob Cozzi ancora del 2002: Reading IFS FIles in RPG
Anche in questo post di Simon Hutchinson A better way to read a file in IFS with RPG
Ci sono anche le API “Unix-like”, come spiegato in questo post di Simon Hutchinson “Read an IFS file in RPG“
Anche Scott Klement ha messo a disposizione diverse API per getire oggetti IFS: Working with the IFS in RPG IV

RPG-FAQ-031: Retrieve Message from a Message File

Una richiesta su Midrange.com si chiedeva “I need a way to retrieve messages from a message file and merge the MSGDTA values into it.” e sono arrivati alcuni source che utilizzano l’API QMHRTVM:

RTVMSGTXT By Thomas Raddatz

**free
// ================================================================== *
//  Retrieve message text with QMHRTVM API
// By Thomas Raddatz
// ================================================================== *
ctl-opt main(main) dftactgrp(*no) actgrp(*new);

dcl-pr main extpgm('RTVMSGTXT');
end-pr;

dcl-pr retrieveMessageText like(string_t) extproc(*dclcase);
  i_library char(10) const;
  i_msgF    char(10) const;
  i_msgID   char(10) const;
  i_msgData char(4096) options(*varsize) const;
end-pr;

// Commonly used templates
dcl-s string_t varchar(2048) template;

dcl-ds qObj_t qualified template;
  name       char(10);
  lib        char(10);
end-ds;

dcl-ds errCode_t qualified template;
  bytPrv     int(10);
  bytAvl     int(10);
  excID      char(7);
  reserved_1 char(1);
  excDta     char(256);
end-ds;

// The program entry point
dcl-proc main;
  dcl-pi *n;
  end-pi;

  dcl-s msgText like(string_t);
  dcl-s dsplyTxt varchar(50);
  dcl-s rc char(1);

  msgText = retrieveMessageText(
            'QSYS': 'QCPFMSG': 'CPF9811': 'MYPGM     MYLIBRARY ');

  dsplyTxt = %subst(msgText: 1: 50);

  dsply dsplyTxt rc;

end-proc;

// -------------------------------------------------------------------
//   Retrieve message text.
// -------------------------------------------------------------------
dcl-proc retrieveMessageText;
  dcl-pi *n like(string_t);
    i_library char(10) const;
    i_msgF    char(10) const;
    i_msgID   char(10) const;
    i_msgData char(4096) options(*varsize) const;
  end-pi;

  // The return value
  dcl-s msgText like(string_t);

  // Format RTVM0100 of QMHRTVM API
  dcl-ds rtvm0100_t qualified template;
    bytRet     int(10);
    bytAvl     int(10);
    lenMsgRet  int(10);
    lenMsgAvl  int(10);
    lenHlpRet  int(10);
    lenHlpAvl  int(10);
    data       char(4096);
  end-ds;

  // The Retrieve Message (QMHRTVM) API
  dcl-pr QMHRTVM extpgm('QMHRTVM');
    o_msgInf         char(32767) options(*varsize);
    i_length         int(10)     const;
    i_format         char(8)     const;
    i_msgID          char(7)     const;
    i_qMsgF          char(20)    const;
    i_rplData        char(32767) const options(*varsize);
    i_rpldataLen     int(10)     const;
    i_rplVars        char(10)    const;
    i_rtnCtrlChrs    char(10)    const;
    io_ErrCode       char(32767) options(*varsize);
  end-pr;

  dcl-ds qMsgF likeds(qObj_t);
  dcl-ds errCode likeds(errCode_t);
  dcl-ds rtvm0100 likeds(rtvm0100_t);

  qMsgF.name = i_msgF;
  qMsgF.lib  = i_library;

  QMHRTVM(rtvm0100: %size(rtvm0100): 'RTVM0100': i_msgID: qMsgF:
          i_msgData: %len(i_msgData): '*YES': '*NO': errCode);

  if (errCode.bytAvl = 0 and rtvm0100.lenMsgRet > 0);
    msgText = %subst(rtvm0100.data: 1: rtvm0100.lenMsgRet);
  else;
    msgText = '';
  endif;

  return msgText;

end-proc;

e SYIMSGR di Darryl Freinkel

F* Program Name: SYIMSGR        Created:  4/22/2021 By DHF

     F* Overview: This program is a utility program that retrieves a message from a

     F*           message file and substitutes the MSGDTA values into the
 message

     F*           returning the message to the calling program.

     F*           This utility is needed as there are program in the system
that are either

     F*           cloned from an interactive program or are part of an
interactive program

     F*           but the screen functions have been bypassed. However, the
programs still

     F*           have code to display the message in the command line. When
the screen

     F*           displays are bypassed, the messages are sent to the
message queue but are

     F*           never displayed.
     F*

     F*           Use this utility to get a complete message and email the
message out,
     F*           or send the message to the joblog.
     F*

     F*           When emailing, use the command SYREMLC.
     F*
     F*    By Darryl Freinkel
     F*

     F********************************************************************

     F* Notes:

     F*

     F********************************************************************

     F* Modifications:                                                   *

     F********************************************************************

     F*

     F********************************************************************

     H*

     H optimize(*basic) option(*expdds:*nodebugio)

     h/if defined(*CRTBNDRPG)

     h dftactgrp(*no) actgrp(*New)

     h/else

     h* dftactgrp(*NO)

     h/endif

     H*

     F***************************************************************************

      * Retrieve Message data ( QMHRTVM ) API


      **************************************************************************

     D* #RtvMsg...

     D*                PI         32766a   varying

     D syimsgr         pi                    extpgm('SYIMSGR')

     D pMsgId                         7    const

     D pMsgFlib                      20    const

     D pMsgRplDta                  2048a   const options(*varsize)

     D pRplSubVal                    10    const

     D pFmtCtlChar                   10    const

     D pRtn_Message                  80a



      *include downloads/qcopysrc,RTVM0200Ds

      * Return format for QMHRTVM api

     D RTVM0200Ds      DS

     D  rBytRtn                      10i 0

     D  rBytAvl                      10i 0

     D  rMsgSev                      10i 0

     D  rAlertIndx                   10i 0

     D  rAlertOpt                     9a

     D  rLogInd                       1a

     D                                2a

     D  rLenRplyRet                  10i 0

     D  rLenRplyAvl                  10i 0

     D  rLenMsgRet                   10i 0

     D  rLenMsgAvl                   10i 0

     D  rLenMsgHlpRet                10i 0

     D  rLenMsgHlpAvl                10i 0

     D  rMessage                   4096a

     D  rMessageHelp               4096a


      *include downloads/qcopysrc,QMHRTVM

      * Receive Message QMHRTVM API

     D QMHRTVM         PR                  extpgm('QMHRTVM')

     D  pMsgData                  32767a   const options(*varsize)

     D  pMsgDataLen                  10i 0 const

     D  pFormat                       8a   const

     D  pMsgId                        7a   const

     D  pMsgFileLib                  20a   const

     D  pRplData                  32767a   const options(*varsize)

     D  pRplDataLen                  10i 0 const

     D  pRplSubVar                   10a   const

     D  pRtnCtlChar                  10a   const

     D  pErr0200                            like(Errc0200Ds)


      * API Error Data Structure - ERRC0200 format

     d ERRC0200ds      Ds                  inz qualified

     d  MsgKey                       10i 0 inz(-1)

     d  BytesProv                    10i 0 inz(%size(ERRC0200Ds.MsgData))

     d  BytesAval                    10i 0

     d  MsgID                         7a

     d  filler                        1a

     d  cCCSID                       10i 0

     d  OffMsgData                   10i 0

     d  LenMsgData                   10i 0

     d  MsgData                   32767a


     D LenRplDta       s             10i 0 inz

     D LenMsgDta       s             10i 0 inz

     d FmtCtlChr       s             10a

     d RplSubVal       s             10a


      /free

                clear Errc0200Ds;

                clear RTVM0200Ds;


                Errc0200Ds.BytesProv = %size(Errc0200Ds.MsgData);

                LenMsgDta = %size(RTVM0200ds);

                LenRplDta = 0;

                LenRplDta = %len(pMsgRplDta);

                if LenRplDta > 0;

                   RplSubVal   = '*YES';

                   FmtCtlChr   = '*NO';

                else;

                   RplSubVal   = '*NO';

                   FmtCtlChr   = '*NO';

                Endif;


                // Get message data

               QMHRTVM( RTVM0200Ds   :  LenMsgDta   :

                         'RTVM0200'   :  pMsgID      :

                         pMsgFlib     :

                         pMsgRplDta   : LenRplDta    :

                         RplSubVal    : FmtCtlChr    :

                         Errc0200Ds ) ;


                // return RTVM0200ds;

               prtn_message = %trim(rMessage);

                *inlr = *on;

      /end-free

     P*  #RtvMsg...

     P*                 E

RPG-FAQ-032: DSPF e i Check-Boxes (Booth Martin Tribute)

Riporto qui di seguito una serie di link al Booth Martin Tribute web site sotto Midrange.com …. Booth Martin, che ci ha lasciati ad Agosto 2020, aveva creato una raccolta di codice RPG e SQL veramente interessante … vi porto solo qualche esempio e vi invito a visitare il nuovo sito all’url: https://boothmartin.midrange.com/

Iniziamo con una guida all’uso dei Check Boxes nei Display File DSPF : https://boothmartin.midrange.com/Code_Samples/Check_Boxes/check_boxes.html