 |
|
| iSeries 400 Tips: |
|
|
|
ISERIES PROGRAMMER TIPS
Check & run commands in RPG
Victor Roig
06.21.2001
Rating: -3.79- (out of 5)
|
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.
Code
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* 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
|
|
Rate this Tip
|
To rate tips, you must be a member of Search400.com.
Register now
to start rating these tips. Log in if you are already a member.
|
DISCLAIMER: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.
|
|
|
|
|
|
|
|
|
|
| TechTarget provides technology professionals with the information they need to perform their jobs - from developing strategy, to making cost-effective purchase decisions and managing their organizations' technology projects - with its network of . |
|
| |
All Rights Reserved, , TechTarget |
|
|
|
|
|
