Problem solve Get help with specific problems with your technologies, process and projects.

Check & run commands in RPG

This tip walks you through a simple way to check and run commands in RPG.

Sometimes you need to ask the user for a command or simply run a command saved previously. This function gives...

you the option in a very simple way.


 
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*   EUR
'    '*sChecking and / or running a command                              '*   EUR
'    '*-------------------------------------------------------------------*   EUR
'    '*  Module. . . . . . . . .  AUX017R1                         *   EUREUR
'    '*  Aplication. . . . . . .  GPI400                                  *   EUREUR
'    '*  Company . . . . . . . .  Aunde, S.A.                             *   EUREUR
'    '*  User. . . . . . . . . .  Victor Roig Lopez                       *   EUREUR
'    '*  Date. . . . . . . . . .  11/05/2001                              *   EUREUR
'    '*-------------------------------------------------------------------*   EUR
'    '*     D E S C R I P T I O N                                        *   EUR
'    '*-------------------------------------------------------------------*   EUR
'    '*  We define This BIF                                               *   EUR
'    '*                                                                   *   EUREUR
'    '*   * Chk_Cmd  Check command                                        *   EUREUR
'    '*   * Run_Cmd  Ejecutar mandato.                                    *   EUREUR
'    '*                                                                   *   EUREUR
'    '*  And the internal function:                                       *   EUR
'    '*   * Call_API   call to QCAPCMD API                                *   EUREUR
'    '*                                                                   *   EUREUR
'    '*  This functions return the ID of error if there are. also, if the *   EUREUR
'    '*  user change some parm in th original, the final command is returned*   EUREUR
'    '*                                                                   *   EUREUR
'    '*-------------------------------------------------------------------*   EUR
'    '*      U P D A T E S   &   P A T C H S                              *   EUREUR
'    '*-------------------------------------------------------------------*   EUR
'    '* Date     | Programmer|Mark  |Description                    *   EUREUR
'    '*----------|-----------|------|-------------------------------------*   EUR
'    '*          |           |      |                                     *   EUREUR
'    '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*   EUR
     HCopyRight('(c) Aunde, S.A.')
     HDatFmt(*EUR) DatEdit(*DMY) DecEdit(',') Debug(*Yes)
      * Compiler instructions
     HOption(*ShowCpy) Indent('|') Optimize(*Full)
     HBndDir('*LIBL/BNDDIR')
     H NoMain

     D Chk_Cmd         PR             7A
     D    Aux_Cmd                   255A
     D    Aux_Tip                     9B 0 Const Options(*NoPass)
     D    Aux_Prompt                   N   Const Options(*NoPass)

     D Run_Cmd         PR             7A
     D    Aux_Cmd                   255A
     D    Aux_Prompt                   N   Const Options(*NoPass)

     D Proc_Cmds       PR                  ExtPgm('QCAPCMD')
     D    CA_Cmd                    255A   Const
     D    CA_CmdL                     9B 0 Const
     D    CA_OCB                     20A   Const
     D    CA_OCBL                     9B 0 Const
     D    CA_OCBF                     8A   Const
     D    CA_CmdC                   255A
     D    CA_CmdCL                    9B 0 Const
     D    CA_CmdCL1                   9B 0
     D    CA_Err                     16A

     D Call_API        PR             7A
     D    Aux_Cmd                   255A
     D    Aux_Tip                     9B 0 Const
     D    Aux_Prompt                   N   Const
'    '*-------------------------------------------------------------------*   EUR
'    '* Call_API      Internal call to API                                *   EUREUR
'    '*-------------------------------------------------------------------*   EUR
     P Call_API        B
     D Call_API        PI             7A
     D    Aux_Cmd                   255A
     D    Aux_Tip                     9B 0 Const
     D    Aux_Prompt                   N   Const

'    '* User space error code                                                 EUREUR
      /Copy QSYSINC/QRPGLESRC,QUSEC
'    '*                                                                       EUREUR
     D QCA_CMD         S            255A
     D QCA_CMDL        S              9B 0 Inz(%Size(QCA_Cmd))
     D QCA_OCB         S             20A   Based(pQCPOP0100)
     D QCA_OCBL        S              9B 0 Inz(%Size(QCA_OCB))
     D QCA_OCBF        S              8A   Inz('CPOP0100')
     D QCA_CMDR        S            255A   Inz(*Blanks)
     D QCA_CMDRL       S              9B 0 Inz(%Size(QCA_CMDR))
     D QCA_CMDRL1      S              9B 0 Inz(%Size(QCA_CMDR))

     D PQCPOP0100      S               *   Inz(%Addr(QCPOP0100))
     D QCPOP0100       DS
     D   QCPO_TYPE                    9B 0 Inz
     D   QCPO_DBCS                    1A   Inz('0')
     D   QCPO_PRMT                    1A
     D   QCPO_STX                     1A   Inz('0')
     D   QCPO_MKEY                    4A   Inz(*Blanks)
     D   QCPO_RSV                     9A   Inz(x'000000000000000000')

     c                   Eval      QUsBPrv   = %Size(QUSEC)
     c                   Eval      QCA_CMD   = Aux_Cmd
     c                   Eval      QCPO_TYPE = Aux_Tip
     c                   Eval      QCPO_PRMT = Aux_Prompt

     c                   CallP     Proc_Cmds(QCA_CMD: QCA_CMDL:
     c                                       QCA_OCB: QCA_OCBL: QCA_OCBF:
     c                                       QCA_CMDR: QCA_CMDRL: QCA_CMDRL1:
     c                                       QUSEC)

     c                   Eval      Aux_Cmd = QCA_CMDR
     c                   Return    QUSEI

     P Call_API        E

'    '*-------------------------------------------------------------------*   EUR
'    '* Chk_Cmd       Check command                                       *   EUREUR
'    '*-------------------------------------------------------------------*   EUR
     P Chk_Cmd         B                   Export
     D Chk_Cmd         PI             7A
     D    Aux_Cmd                   255A
     D    Aux_Tip                     9B 0 Const Options(*NoPass)
     D    Aux_Prompt                   N   Const Options(*NoPass)
'    '* fields for the call                                                   EUREUR
     D Cmd             S            255A   Inz
     D Tip             S              9B 0 Inz(1)
     D Prompt          S               N   Inz(*ON)
     D Err             S              7A   Inz

     c                   If        %Parms > 1
     c                   Eval      Tip = Aux_Tip
     c                   EndIf
     c                   If        %Parms > 2
     c                   Eval      Prompt = Aux_Prompt
     c                   EndIf

     c                   Eval      Cmd  = Aux_Cmd
     c                   If        (Tip < 0) OR (Tip > 9)
     c                   Return    'CPF0008'
     c                   EndIf

     c                   Eval      Err = Call_API(Cmd: Tip: Prompt)

     c                   If        Err <> *Blanks
     c                   Return    Err
     c                   Else
     c                   Eval      Aux_Cmd  = Cmd
     c                   Return    *Blanks
     c                   EndIf

     P Chk_Cmd         E
'    '*-------------------------------------------------------------------*   EUR
'    '* Run_Cmd       Run the command                                     *   EUREUR
'    '*-------------------------------------------------------------------*   EUR
     P Run_Cmd         B                   Export
     D Run_Cmd         PI             7A
     D    Aux_Cmd                   255A
     D    Aux_Prompt                   N   Const Options(*NoPass)
'    '* fields for the call                                                   EUREUR
     D Cmd             S            255A   Inz
     D Prompt          S               N   Inz(*OFF)
     D Err             S              7A   Inz

     c                   If        %Parms > 1
     c                   Eval      Prompt = Aux_Prompt
     c                   EndIf

     c                   Eval      Cmd  = Aux_Cmd
     c                   Eval      Err = Call_API(Cmd: 2: Prompt)

     c                   If        Err <> *Blanks
     c                   Return    Err
     c                   Else
     c                   Eval      Aux_Cmd  = Cmd
     c                   Return    *Blanks
     c                   EndIf

     P Run_Cmd         E 
This was last published in June 2001

Dig Deeper on RPG iSeries programming

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close