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.

By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Please create a username to comment.

-ADS BY GOOGLE

SearchDataCenter

Close