星期一, 11月 06, 2023

2003-03-12 如何於 CL 中轉換字串中每個英文單字的第一個字為大寫?


如何於 CL 中轉換字串中每個英文單字的第一個字為大寫?

File  : QCLSRC
Member: CVTCASEC
Type  : CLP
Usage : CRTCLPGM CVTCASEC
        CALL CVTCASEC 'AS/400 IS VERY GOOD.'


pgm        (&CvtText)     /* Convert this text     */

/*--------------------------------------------------------*/
/*  declaration                                           */
/*--------------------------------------------------------*/
             dcl        &CvtText   *char   80
             dcl        &ReqUpper  *char   22
             dcl        &ReqLower  *char   22
             dcl        &Pos       *dec     3   1
             dcl        &Posl      *dec     3   0
             dcl        &Len       *dec     3   0
             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        &Input     *char   80
             dcl        &Output    *char   80
             dcl        &DataLen   *char    4 x'00000050'
             dcl        &ErrCde    *char    4 x'00000000'

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

/*--------------------------------------------------------*/
/*  Convert Upper (First letter), then lower case         */
/*--------------------------------------------------------*/
 loop:
             if         (&Pos *ge 80)       goto endloop
          /*----------------------------------------------*/
          /*  Convert to Lower                            */
          /*----------------------------------------------*/
             if         (%sst(&CvtText &Pos 1) = ' ')      do
               if         (*Not &Upper)                    do
                 chgvar     &output         ' '
                 chgvar     %bin(&Datalen)  &len
                 Call       Pgm(QLGCNVCS)                  +
                              parm(&Reqlower               +
                                   &input                  +
                                   &output                 +
                                   &Datalen                +
                                   &ErrCde  )
                 chgvar     %sst(&CvtText &Posl &len)      &Output
               enddo
               chgvar     &upper            '1'
               chgvar     &Pos              (&Pos + 1)
             enddo
          /*----------------------------------------------*/
          /*  Convert to Upper                            */
          /*----------------------------------------------*/
             if         (%sst(&CvtText &Pos 1) *ne ' ')    do
             if         &upper                             do
               chgvar     &input            %sst(&CvtText &Pos 1)
               chgvar     &output           ' '
               chgvar     %bin(&Datalen)    1
               Call       Pgm(QLGCNVCS)                    +
                            parm(&ReqUpper                 +
                                 &input                    +
                                 &output                   +
                                 &Datalen                  +
                                 &ErrCde  )
               chgvar     %sst(&CvtText &Pos 1)  %sst(&Output  1 1)
               chgvar     &Pos              (&Pos + 1)
               chgvar     &Posl             &Pos
               chgvar     &upper            '0'
               chgvar     &len              0
             enddo
             else       do
               chgvar     &len              (&len + 1)
               chgvar     %sst(&input &len 1)    %sst(&CvtText &Pos 1)
               chgvar     &Pos              (&Pos + 1)
             enddo
             enddo

             goto       loop
 endloop:

             SndPgmMsg  Msg(&Cvttext) Msgtype(*Comp)

             EndPgm
            




沒有留言: