2006012316262001-06-26 如何於 RPG 中檢核 Command 正確性及執行 Command?

本期目錄:
如何於 RPG 中檢核 Command 正確性及執行 Command?
用法
如 何於 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)



回本期目錄

回應
AS/400 系統應用電子報





Powered by Xuite
    沒有新回應!
平均分數:0 顆星
投票人數:0
我要評分:
關鍵字
IBM 最佳夥伴
AS/400 非官方網站