2010-03-03 如何於 CLP 中將英文字轉換為大寫(uppercase)或小寫(lowercase)？(Command CVTCASE with Convert Case API QLGCNVCS)

如何於 CLP 中將英文字轉換為大寫(uppercase)或小寫(lowercase)？(Command CVTCASE with Convert Case API QLGCNVCS)

File  : QCLSRC
Member: CVTCASE
Type  : CLP
Usage : CRTCLPGM CVTCASE

/*  ===============================================================  */
/*  = Command CvtCase    CPP                                      =  */
/*  =   CvtCase    CLP                                            =  */
/*  =   Paramater notes:                                          =  */
/*  =     VALUE :   string to be converted                        =  */
/*  =     TOVAR :   CL var for converted data                     =  */
/*  =     OPTION:   convert option *UPPER or *LOWER               =  */
/*  ===============================================================  */
/*  = Date  : 2010/03/03                                          =  */
/*  = Author: Vengoal Chang                                       =  */
/*  ===============================================================  */

pgm        (&InValue &OutToVar &InOption)

/*--------------------------------------------------------*/
/*  declaration                                           */
/*--------------------------------------------------------*/
             dcl        &InValue   *char   4096
             dcl        &CvtText   *char   4096
             dcl        &OutToVar  *char   4096
             dcl        &OutValue  *char   4096
             dcl        &InOption  *char   6
             dcl        &InValueL   *dec    5 0
             dcl        &OutToVarL  *dec    5 0
             dcl        &LenC       *char   2
             dcl        &ReqUpper  *char   22
             dcl        &ReqLower  *char   22
             dcl        &upper     *lgl

             dcl        &CCSIDReq  *char    4 x'00000001'
             dcl        &CCSIDInp  *char    4 x'00000000'
             dcl        &Uppercase *char    4 x'00000000'
             dcl        &Lowercase *char    4 x'00000001'
             dcl        &Reserved  *char   10 x'00000000000000000000'

          /*----------------------------------------------*/
          /*  QLGCNVCS - Convert Case QlgConvertCase      */
          /*----------------------------------------------*/
             dcl        &DataLen   *char    4 x'00000050'
             dcl        &ErrCde    *char    4 x'00000000'

             dcl        &MsgId   *char      7
             dcl        &MsgDta  *char    256
             dcl        &Msgf    *char     10
             dcl        &MsgfLib *char     10
             dcl        &MsgTxt  *char    256

             monmsg     msgid(CPF0000 MCH0000) exec(goto Error)

/*--------------------------------------------------------*/
/*  Setup Request Control Block                           */
/*--------------------------------------------------------*/
             chgvar     &ReqUpper      (&CCSIDReq       || +
                                        &CCSIDInp       || +
                                        &Uppercase      || +
                                        &Reserved)
             chgvar     &ReqLower      (&CCSIDReq       || +
                                        &CCSIDInp       || +
                                        &Lowercase      || +
                                        &Reserved)

             chgvar     &LenC %sst(&InValue 1 2)
             chgvar     &InValueL %bin(&LenC)
             chgvar     &LenC %sst(&OutToVar 1 2)
             chgvar     &OutToVarL %bin(&LenC)

             chgvar     %bin(&Datalen)    &InValueL
             If (&InValueL > &OutToVarL) +
                chgvar     %bin(&Datalen)    &OutToVarL

             chgvar &CvtText %sst(&InValue 3 &InValueL)
             chgvar &OutValue ' '

/*----------------------------------------------*/
/*  Convert to Upper                            */
/*----------------------------------------------*/
             if        (&InOption *EQ '*UPPER')            do
               Call       Pgm(QLGCNVCS)                    +
                            parm(&ReqUpper                 +
                                 &CvtText                  +
                                 &OutValue                 +
                                 &Datalen                  +
                                 &ErrCde  )
             enddo
/*--------------------------------------------------------*/
/*  Convert to lower case                                 */
/*--------------------------------------------------------*/
             else do
                 Call       Pgm(QLGCNVCS)                  +
                              parm(&Reqlower               +
                                   &CvtText                +
                                   &OutValue               +
                                   &Datalen                +
                                   &ErrCde  )
             enddo

             chgvar %sst(&OutToVar 3 &OutToVarL) &OutValue

             Return

/*  ===============================================================  */
/*  = Error routine                                               =  */
/*  ===============================================================  */

Error:

  RcvMsg     MsgType( *Excp )                                         +
             MsgDta( &MsgDta )                                        +
             MsgID( &MsgID )                                          +
             MsgF( &MsgF )                                            +
             MsgFLib( &MsgFLib )
  MonMsg     ( CPF0000 MCH0000 )

SndMsg:

  SndPgmMsg  MsgID( &MsgID )                                          +
             MsgF( &MsgFLib/&MsgF )                                   +
             MsgDta( &MsgDta )                                        +
             MsgType( *Escape )
  MonMsg     ( CPF0000 MCH0000 )

/*  ===============================================================  */
/*  = End of program                                              =  */
/*  ===============================================================  */

             EndPgm



File  : QMDSRC
Member: CVTCASE
Type  : CMD
Usage : CRTCMD CMD(xxx/CvtCase)
               PGM(*LIBL/CvtCase)
               SRCFILE(xxx/QCMDSRC) 
               SRCMBR(CvtCase)
               ALLOW(*BMOD *BPGM *IMOD *IPGM) 


/*  ===============================================================  */
/*  = Command....... CvtCase                                      =  */
/*  = CPP........... CvtCaseC CLP                                 =  */
/*  = Description... Convert string to upper or lower case        =  */
/*  =                                                             =  */
/*  ===============================================================  */
/*  = To create:                                                  =  */
/*  =                                                             =  */
/*  =  CRTCMD CMD(xxx/CvtCase)                                    =  */
/*  =         PGM(*LIBL/CvtCase)                                  =  */
/*  =         SRCFILE(xxx/QCMDSRC)                                =  */
/*  =         SRCMBR(CvtCase)                                     =  */
/*  =         ALLOW(*BMOD *BPGM *IMOD *IPGM)                      =  */
/*  =                                                             =  */
/*  ===============================================================  */
/*  = Date  : 2010/03/03                                          =  */
/*  = Author: Vengoal Chang                                       =  */
/*  ===============================================================  */

             CMD        PROMPT('Convert case to upper or lower')

             PARM       KWD(VALUE) TYPE(*CHAR) LEN(4096) MIN(1) +
                          EXPR(*YES) VARY(*YES *INT2) CASE(*MONO) +
                          PROMPT('Value')
             PARM       KWD(TOVAR) TYPE(*CHAR) LEN(1) RTNVAL(*YES) +
                          MIN(1) VARY(*YES *INT2) PROMPT('CL var +
                          for converted data')
             PARM       KWD(OPTION) TYPE(*CHAR) LEN(6) RSTD(*YES) +
                          DFT(*UPPER) VALUES(*UPPER *LOWER) +
                          PROMPT('Convert to')


File  : QCLSRC
Member: CVTCASET
Type  : CLP
Usage : CRTCLPGM PGM(*LIBL/CvtCaseT)
               SRCFILE(xxx/QCLSRC) 
               SRCMBR(CvtCaseT)
        CALL CvtCaseT


PGM
      DCL &CVTTEXT *CHAR 20 'abc DeF Ghj'
      DCL &OUTPUT  *CHAR 20

             CVTCASE    VALUE(&CVTTEXT) TOVAR(&OUTPUT)
             SNDPGMMSG  MSG('String' *BCAT &CVTTEXT *BCAT +
                            'TO UPPER case:' *BCAT +
                            &OUTPUT) MSGTYPE(*COMP)
             CVTCASE    VALUE(&CVTTEXT) TOVAR(&OUTPUT) OPTION(*LOWER)
             SNDPGMMSG  MSG('String' *BCAT &CVTTEXT *BCAT +
                            'TO UPPER case:' *BCAT +
                            &OUTPUT) MSGTYPE(*COMP)
ENDPGM