如何於 RPG 中檢核 Command 正確性及執行 Command？
File : QRPGLESRC
Member: CHKRUNCMDR
Type : RPGLE
*--------------------------------------------------------------*
* Vengoal Chang Development Resource 2001.06 *
* *
* \\\\\\\ *
* ( o o ) *
*-------------------oOO----(_)----OOo--------------------------*
* *
* Description : Checking or running command in RPG *
* *
* ooooO Ooooo *
* ( ) ( ) *
*-----------------( )-------------( )----------------------*
* (_) (_) *
* *
*--------------------------------------------------------------*
* D E S C R I P T I O N *
*--------------------------------------------------------------*
* Define This BIF *
* *
* * Chk_Cmd Check command *
* * Run_Cmd Ejecutar mandato. *
* *
* And the internal function: *
* * Call_API call to QCAPCMD API *
* *
* This functions return the ID of error if there are. also, if the *
* user change some parm in th original, the final command is returned*
* *
* *
*http://publib.boulder.ibm.com/pubs/html/as400/v5r1/ic2924/info/apis/qcapcmd.htm
* *
* Process Commands (QCAPCMD) API *
* Required Parameter Group:
* *
* 1 Source command string Input Char(*)
* *
* 2 Length of source command string Input Binary(4)
* *
* 3 Options control block Input Char(*)
* The options that control the handling of the command string.
* The layout of this parameter is the CPOP0100 format.
* *
* 4 Options control block length Input Binary(4)
* The length of the options control block. A minimum length of
* 20 is required for the CPOP0100 format.
* *
* 5 Options control block format Input Char(8)
* The format of the options control block. CPOP0100 is the
* only valid value.
* *
* 6 Changed command string Output Char(*)
* *
* 7 Length available for changed Input Binary(4)
* command string
* *
* 8 Length of changed command Output Binnary(4)
* string available to return
* *
* 9 Error Code I/O Char(*)
* You can use the QCAPCMD API to:
* Check the syntax of a command string prior to running it
* Prompt the command and receive the changed command string
* Run a command from an HLL
* CPOP0100 Format
* The CPOP0100 format includes information on the contents of the
* options control block parameter.
* Offset Type Field
* Dec Hex
* 0 0 BINARY(4) Type of command processing
* 0: AS/400 1: S/38
* 4 4 CHAR(1) DBCS data handling
* 0: Ignore 1: Handle
* 5 5 CHAR(1) Prompter action
* 0: Never Propmt
* 1: Always Prompt
* 2: Prompt the command if selective
* prompting characters are present in the
* command string.
* 3:Show help. Provides help display
* 6 6 CHAR(1) Command string syntax
* 0 :Command running.
* 1 :Command syntax check.
* 2 :Command line running.
* 3 :Command line syntax check.
* 4 <--> 10
*
* 7 7 CHAR(4) Message retrieve key
* The message key is valid for processing
* command types 0, 1, 2, and 3.
*
* 11 B CHAR(9) Reserved
*--------------------------------------------------------------*
H Debug Option(*SRCSTMT:*NODEBUGIO)
* Compiler instructions
H Indent('|') Optimize(*Full)
H BndDir('*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
用 法
1. CRTRPGMOD CHKRUNCMDR.
2. CRTBNDDIR BNDDIR.
3. ADDBNDDIRE BNDDIR(BNDDIR) OBJ((CHKRUNCMDR *MODULE))
4. Sample Usage pgm.
Copy the following to your Program, then define ErrCPFID CHAR(7) to receive ERROR Message ID using
ErrCPFID = Callp Chk_cmd (CMDStr) to check command, or
ErrCPFID = Callp Run_cmd (CMDStr) to run command.
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)
5. Compiled your program with
CRTBNDPGM PGM(your program) DFTACTGRP(*NO) BNDDIR(BNDDIR)
星期二, 10月 31, 2023
2001-06-26 如何於 RPG 中檢核 Command 正確性及執行 Command？
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言