QCLSCAN で先行ゼロを取り除く

API の結果などでも、桁数いっぱい先行にゼロがきっちり埋まった数字フィールドが出てくることがあります。
ちょっとしたツールなどであればそのまま出力させてしまってもいいのですが、やっぱり見栄えをよくしたいという場合もあります。
そんなときのために、先行ゼロを取り除く処理を CL で書いてみました。


文字パターンのスキャン

QCLSCAN という API を使ってみてます。
(というか、この API の使い方を試すために書いてみた、というのが本当のところです)
文字を検索するためにある API ですね。

Scan for String Pattern (QCLSCAN) API

  Required Parameter Group:

1 Character string Input Char(*)
2 Length of character string Input Packed(3,0)
3 Starting position Input Packed(3,0)
4 Character pattern Input Char(*)
5 Length of character pattern Input Packed(3,0)
6 Translate characters Input Char((1)
7 Trim trailing blanks Input Char((1)
8 Wildcard character Input Char(1)
9 Character string result Output Packed(3,0)

  Default Public Authority: *USE

  Threadsafe: No

最初のパラメータは、検索を行う対象となる文字列、
次はその文字列の長さ、
3番目は検索を開始する文字列の中の位置、
4番目は、その文字列から探し出したい文字列、
5番目はその文字列の長さ、
6番目は小文字と大文字の変換を行うか、
7番目はブランクを取り除くか、
8番目はワイルドカード文字の指定、
でここまでが入力パラメータになります。
そして9番目は見つかった場合に、その位置が入ってくるパラメータです。

プログラミング例

             PGM        PARM(&CHAR10)                                           
                                                                                
             DCL        VAR(&CHAR10) TYPE(*CHAR) LEN(10)                        
                                                                                
             DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7) VALUE('CPF9898')         
             DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10) VALUE('QCPFMSG')         
             DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) +                     
                          VALUE('*LIBL')                                        
             DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(512)                       
             DCL        VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +                     
                          VALUE('*COMP')                                        
                                                                                
             DCL        VAR(&CHARLEN) TYPE(*DEC) LEN(3 0) VALUE(10)             
             DCL        VAR(&STRPOS) TYPE(*DEC) LEN(3 0) VALUE(1)               
             DCL        VAR(&SCANCHAR) TYPE(*CHAR) LEN(1) VALUE('0')            
             DCL        VAR(&SCANCHARL) TYPE(*DEC) LEN(3 0) VALUE(1)            
             DCL        VAR(&TRANSOPT) TYPE(*CHAR) LEN(1) VALUE('0')            
             DCL        VAR(&TRIMSOPT) TYPE(*CHAR) LEN(1) VALUE('1')            
             DCL        VAR(&WLDCRDOPT) TYPE(*CHAR) LEN(1) VALUE(' ')           
             DCL        VAR(&POS) TYPE(*DEC) LEN(3 0)                           
             DCL        VAR(&FROM) TYPE(*DEC) LEN(3 0)                          
             DCL        VAR(&RESULTLEN) TYPE(*DEC) LEN(3 0)                     
                                                                                
             MONMSG     MSGID(CPC0000 CPD0000 CPF0000 MCH0000) +                
                          EXEC(GOTO CMDLBL(ERROR))                              
                                                                                
 LOOP:       CALL       PGM(QCLSCAN) PARM(&CHAR10 &CHARLEN &STRPOS +            
                          &SCANCHAR &SCANCHARL &TRANSOPT &TRIMSOPT +            
                          &WLDCRDOPT &POS)                                      
             IF         COND(&POS > 0 & &POS < &CHARLEN & &POS = +              
                          &STRPOS) THEN(DO)                                     
             CHGVAR     VAR(%SST(&CHAR10 &POS 1)) VALUE(' ')                    
             CHGVAR     VAR(&FROM) VALUE(&POS)                                  
             CHGVAR     VAR(&STRPOS) VALUE(&STRPOS + 1)                         
             GOTO       CMDLBL(LOOP)                                            
             ENDDO                                                              
                                                                                
             CHGVAR     VAR(&RESULTLEN) VALUE(&CHARLEN - &STRPOS + 1)           
             CHGVAR     VAR(&CHAR10) VALUE(%SST(&CHAR10 &STRPOS +               
                          &RESULTLEN))                                          
                                                                                
             CHGVAR     VAR(&MSGDTA) VALUE('OUTPUT is: ' |> &CHAR10)            
             GOTO       CMDLBL(EXIT)                                            
                                                                                
 ERROR:      RCVMSG     MSGTYPE(*EXCP) RMV(*YES) MSGDTA(&MSGDTA) +              
                          MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGFLIB)           
             CHGVAR     VAR(&MSGTYPE) VALUE('*ESCAPE')                          
                                                                                
 EXIT:       SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +                    
                          MSGDTA(&MSGDTA) MSGTYPE(&MSGTYPE)                     
             ENDPGM                                                             

別のプログラミング例

実は、以前別のやり方で同じ処理を書いています。(このサイトのどこかで使用している気がするのですが…)
サブルーチンとして組み込むのには、こちらの方がシンプルで使いやすいかもしれませんね。

             PGM        PARM(&COUNTC)                                           
                                                                                
             DCL        VAR(&COUNTC) TYPE(*CHAR) LEN(10)                        
             DCL        VAR(&I) TYPE(*INT)                                      
             DCL        VAR(&T) TYPE(*INT)                                      
             DCL        VAR(&LEN) TYPE(*INT)                                    
                                                                                
             DOFOR      VAR(&I) FROM(1) TO(9) BY(1)                             
             IF         COND(%SST(&COUNTC &I 1) = '0') THEN(CHGVAR +            
                          VAR(%SST(&COUNTC &I 1)) VALUE(' '))                   
             ELSE       CMD(LEAVE)                                              
             ENDDO                                                              
                                                                                
             CHGVAR     VAR(&LEN) VALUE(11 - &I)                                
             CHGVAR     VAR(&COUNTC) VALUE(%SST(&COUNTC &I &LEN))               
                                                                                
             ENDPGM                                                             

[Top Pageに戻る]

Ads by TOK2