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
