midrange.com code scratchpad
Name:
Gary Thompson
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
05/19/2014 09:11:45 pm
IP:
Logged
Description:
Post code attempt #2
RPGLE source to update a program defined file.
Design is targeted at replacing "Color Attribute bytes" with blank characters.
Purpose is to make source members "play nice" with RDi
CMD source makes it easier to call RPGLE
Code:
  1. /* The RPGLE code:
  2.      H OPTION(*SRCSTMT: *NODEBUGIO)
  3.       **************************************************************************
  4.       * SPECIAL    : NONE                                                      *
  5.       *                                                                        *
  6.       * DESCRIPTION: Convert characters Less Than Blank to a Blank (Hex 40)    *
  7.       *                                                                        *
  8.       *                                                                        *
  9.       * NOTES      :                                                           *
  10.       *                                                                        *
  11.       *    1) Created to prepare source that has color attribute bytes to      *
  12.       *       be edited with the Rational Developer for Power Systems which    *
  13.       *       does not "recognize" characters less than *Blank (x'40').        *
  14.       *                                                                        *
  15.       *    2) Assumes typical record format of a File Type = *SRC, meaning     *
  16.       *       that positions 1-12 of the record format are sequence number     *
  17.       *       and change yymmdd.                                               *
  18.       *                                                                        *
  19.       *    3) Works only for EBCDIC (not for ASCII)                            *
  20.       *                                                                        *
  21.       * FREQUENCY  : ON DEMAND                                                 *
  22.       * CALLED BY  : command line                                              *
  23.       *                                                                        *
  24.       * PARAMETERS   NAME          TYPE      DESCRIPTION                       *
  25.       *          1 : sMbr          Input     source MEMBER                     *
  26.       *          2 : File_Lib      Input     file NAME and LIBRARY             *
  27.       *                                                                        *
  28.       *------------------------------------------------------------------------*
  29.       * DATE    INIT SMR#  MODIFICATION COMMENTS                               *
  30.       *------------------------------------------------------------------------*
  31.       * 12/12/11 gdt       Replace 2 file data for version upgrade             *
  32.       **************************************************************************
  33.      FMYSRCF    UF   F 1000        DISK    USROPN INFDS(f1_INFDS)
  34.  
  35.      D LTBNK2BNKR      PR                  extpgm('LTBNK2BNKR')
  36.      D  sMbr                         10A
  37.      D  fNam_Lib                     20A
  38.  
  39.      D QCMDEXC         PR                  ExtPgm('QCMDEXC')
  40.      D   QCcmd                    32702A   const options(*varsize)
  41.      D   QClen                       15P 5 const
  42.  
  43.      D LTBNK2BNKR      PI
  44.      D  sMbr                         10A
  45.      D  fNam_Lib                     20A
  46.  
  47.       * Program Status Data Structure
  48.      D                SDS
  49.      D sdsPgm            *PROC
  50.  
  51.       * File Feedback Information for MYSRCF
  52.      Df1_INFDS         DS
  53.      D f1_File8                1      8A                                        File name
  54.       *                                                                           *FILE
  55.      D f1_Open                 9      9N                                        Open indicator
  56.      D f1_Eof                 10     10N                                        EOF indicator
  57.      D f1_Status              11     15S 0                                      Status code
  58.       *                                                                           *STATUS
  59.      D f1_Opcode              16     21A                                        Operation cd
  60.       *                                                                           *OPCODE
  61.      D f1_Routine             22     29A                                        RPG Routine
  62.       *                                                                           *ROUTINE
  63.      D f1_SrcStmt             30     37A                                        Source Statement #
  64.      D f1_UserRsn             38     42S 0                                      User Reason for
  65.       *                                                                           SPECIAL file error
  66.      D f1_Record              38     45A                                        Record Name for
  67.       *                                                                           external file
  68.       *                                                                           *RECORD
  69.      D f1_MsgId               46     52A                                        Error Message ID
  70.      D f1_ScrSize             67     70S 0                                      Screen size
  71.       *                                                                           *SIZE
  72.      D f1_NlsInp              71     72S 0                                      NLS Input = 0
  73.       *                                                                           *INP
  74.      D f1_NlsOut              73     74S 0                                      NLS Output = 0
  75.       *                                                                           *OUT
  76.      D f1_NlsMode             75     76S 0                                      NLS Preferred = 0
  77.       *                                                                           *MODE
  78.      D f1_OdpType             81     82A                                        Open Data Path type
  79.       *                                                                           DS = device file
  80.       *                                                                           DB = Database mbr
  81.       *                                                                           SP = Spool file
  82.      D f1_FileName            83     92A                                        File Name
  83.      D f1_FileLib             93    102A                                        File Library Name
  84.      D f1_SpoolName          103    112A                                        Spool File Name
  85.      D f1_SpoolLib           113    122A                                        Spool File Library
  86.      D f1_SpoolNbr           123    124B 0                                      Spool File Number
  87.      D f1_RecLen             125    126B 0                                      Record Length
  88.      D f1_MbrName            129    138A                                        File Member Name
  89.      D f1_DspRows            152    153B 0                                      Display File rows
  90.      D f1_DspCols            154    155B 0                                      Display File columns
  91.      D f1_MbrRecs            156    159B 0                                      File Member Records
  92.      D f1_OvrLine            188    189B 0                                      Spool Overflow Line
  93.      D f1_RecFmt             261    270A                                        Record Format Name
  94.       *
  95.       * File Feedback Information specific to Database files
  96.      D f1_DbRrn              397    400I 0                                      DB file RRN
  97.  
  98.      D DltOvr1         C                   'DLTOVR FILE(MYSRCF)'
  99.      D OvrDbf1         C                   'OVRDBF FILE(MYSRCF) TOFILE('
  100.      D OvrDbf2         C                   ') MBR('
  101.      D OvrDbf3         C                   ')'
  102.      D RplChrCnt       S             10U 0 Inz(0)                               Replaced char count
  103.      D SndPgmMsg1      C                   'SNDPGMMSG  MSGID(CPF9898) MSGF(QCPF-
  104.      D                                      MSG) MSGDTA(''Characters replaced: '
  105.      D SndPgmMsg2      C                   ''') TOPGMQ(*EXT) MSGTYPE(*STATUS)'
  106.      D wkCmd           S            500A   varying
  107.  
  108.      D RplChrDS        DS
  109.      D  RplChrX                1     15A                                        replaced chracters X
  110.      D  RplChrS                1     15S 0                                         "         "
  111.  
  112.      D  wkNamLib       DS
  113.      D  wkFile                 1     10A                                        ffffffffff
  114.      D  wkLib                 11     20A                                                  LLLLLLLLLL
  115.  
  116.       * Start: Data to handle source file record -------------------------------
  117.      D  Dta@           S              5U 0                                      SrcDta# index
  118.      D  DtaMax         C                   1000                                 SrcDta# max
  119.      D  SrcEof         S               N   Inz(*Off)                            Source End Of File
  120.      D  SrcUpd         S               N   Inz(*Off)                            Source Update flag
  121.       *
  122.      D SrcDS           DS
  123.      D  SrcSeq                 1      6A                                        sequence nbr
  124.      D  SrcDat                 7     12A                                        change YYMMDD
  125.      D  SrcDta                13   1000A                                        data
  126.      D  SrcDta#               13   1000A   Dim(988)                             data array
  127.       * End  : Data to handle source file record -------------------------------
  128.  
  129.      C                   Exsr      $aaMain
  130.      C                   Eval      *INLR = *On
  131.      C                   Return
  132.       /free
  133.        //***********************************************************************
  134.        // Open selected member and call replace character routine              *
  135.        //***********************************************************************
  136.        Begsr $aaMain;
  137.  
  138.        wkNamLib =  fNam_Lib;
  139.        //override to member selected by user
  140.        wkCmd = OvrDbf1 + %Trim(wkLib) + '/' + %Trim(wkFile) +
  141.                OvrDbf2 + %Trim(sMbr) + OvrDbf3;
  142.        CALLP(E)  QCMDEXC (wkCmd : %Len(wkCmd));
  143.        If (%Error);
  144.          LeaveSR;
  145.        Endif;
  146.  
  147.        OPEN(E) MYSRCF;
  148.        If (%Error);
  149.          LeaveSR;
  150.        Endif;
  151.  
  152.        If (f1_MbrName = sMbr);
  153.          Exsr $RplChr;
  154.        Endif;
  155.  
  156.        CLOSE MYSRCF;
  157.  
  158.        //remove override
  159.        wkCmd = DltOvr1;
  160.        CALLP(E)  QCMDEXC (wkCmd : %Len(wkCmd));
  161.  
  162.        //send message to user
  163.        RplChrS =  RplChrCnt;
  164.        wkCmd = SndPgmMsg1 + %TrimL(RplChrX:'0') + %Trim(SndPgmMsg2);
  165.        CALLP(E)  QCMDEXC (wkCmd : %Len(wkCmd));
  166.  
  167.        Endsr;
  168.        //***********************************************************************
  169.        // Replace characters < *Blank with *Blank                              *
  170.        // Input                                                                *
  171.        //   user-specified member open for update                              *
  172.        // Output                                                               *
  173.        //   member updated with characters < *Blank replaced with *Blank       *
  174.        //***********************************************************************
  175.        Begsr $RplChr;
  176.  
  177.        Read MYSRCF SrcDS;
  178.        If (%EOF);
  179.          SrcEof = *On;
  180.        Endif;
  181.  
  182.        //Start: loop to process all source lines ===============================
  183.        Dow (SrcEof = *Off);
  184.          SrcUpd = *Off;
  185.          //Start: loop to process source data characters -----------------------
  186.          For Dta@ = 1  To  DtaMax;
  187.            If Dta@  > f1_RecLen;
  188.              Leave;                                                 // exit loop
  189.            Endif;
  190.            If SrcDta#(Dta@) < *Blank;
  191.              SrcDta#(Dta@) = *Blank;
  192.              RplChrCnt    += 1;
  193.              SrcUpd        = *On;
  194.            Endif;
  195.          Endfor;
  196.          //End  : loop to process source data characters -----------------------
  197.  
  198.          If (SrcUpd);
  199.            Update MYSRCF SrcDS;
  200.          Endif;
  201.  
  202.          Read MYSRCF SrcDS;
  203.          If (%EOF);
  204.            SrcEof = *On;
  205.          Endif;
  206.        Enddo;
  207.        //End  : loop to process all source lines ===============================
  208.  
  209.        Endsr;
  210.       /end-free 
  211.  
  212. /* The CMD code:
  213. /******************************************************************************/
  214. /* SPECIAL      Works only for iSeries files using EBCDIC (no ASCII)          */
  215. /*                                                                            */
  216. /* DESCRIPTION: Convert any character less than blank (x40) to a blank        */
  217. /*              character (Hex 40)                                            */
  218. /* NOTES                                                                      */
  219. /*   1) Use to prepare source that has color attribute bytes to be edited     */
  220. /*      with the Rational Developer for Power Systems which does not          */
  221. /*      "recognize" characters less than *Blank (x'40').                      */
  222. /*                                                                            */
  223. /*   2) Assumes typical record format of a File Type = *SRC, meaning that     */
  224. /*      positions 1-12 of the record format are sequence number and change    */
  225. /*      yymmdd.                                                               */
  226. /*                                                                            */
  227. /*   3) FROMFILE passed to command program as one parm: ffffffffffLLLLLLLLLL  */
  228. /*                                                                            */
  229. /* FREQUENCY  : on demand                                                     */
  230. /*                                                                            */
  231. /* CALLED BY  : command line                                                  */
  232. /*                                                                            */
  233. /* PARAMETERS : NAME          TYPE      DESCRIPTION                           */
  234. /*              SRCMBR        Input     source MEMBER name                    */
  235. /*              FROMFILE      Input     File and Library name                 */
  236. /*----------------------------------------------------------------------------*/
  237. /* DATE    INIT SMR#  MODIFICATION COMMENTS                                   */
  238. /*----------------------------------------------------------------------------*/
  239. /* 07/03/13 gd5       NEW - copied from SWIRE/SRC(CMPDBF)                     */
  240. /******************************************************************************/
  241.              CMD        PROMPT('Convert < Blank to Blank')
  242.  
  243.              PARM       KWD(SRCMBR) TYPE(*NAME) LEN(10) MIN(1) +
  244.                           EXPR(*YES) PROMPT('Source Member name')
  245.  
  246.              PARM       KWD(SRCFILE) TYPE(QUAL1) MIN(1) +
  247.                           PROMPT('Source File name')
  248.  
  249.  QUAL1:      QUAL       TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
  250.              QUAL       TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)  +
  251.                           PROMPT('Library name') 
© 2004-2019 by midrange.com generated in 0.006s valid xhtml & css