PGM                                                                
/*---------------------------------------------------------*/                   
/*   TESTICONV : ｹｳﾅﾄﾐ によるユニコード変換                */                   
/*                                                         */                   
/*   CRTCLMOD QTEMP/TESTICONV SRCFILE(MYSRCLIB/QCLLESRC)   */                   
/*            AUT(*ALL)                                    */                   
/*   CRTPGM   MYLIB/TESTICONV MODULE(QTEMP/TESTICONV)      */                   
/*            BNDSRVPGM(QSYS/QTQICONV) ACRGRP(*NEW)        */                   
/*            AUT(*ALL)                                    */                   
/*---------------------------------------------------------*/                   
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)                          
             DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                          
             DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                          
             DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)                       
             DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)                       
             DCL        VAR(&FROMCODE) TYPE(*CHAR) LEN(32)                      
             DCL        VAR(&TOCODE) TYPE(*CHAR) LEN(32)                        
             DCL        VAR(&BIN4) TYPE(*CHAR) LEN(4)                           
             DCL        VAR(&RTN4) TYPE(*INT)                                   
             DCL        VAR(&CD) TYPE(*CHAR) LEN(52)                            
             DCL        VAR(&CD_P) TYPE(*PTR)                                   
             DCL        VAR(&INPUT) TYPE(*CHAR) LEN(512)                        
             DCL        VAR(&INPUT_P) TYPE(*PTR)                                
             DCL        VAR(&OUTPUT) TYPE(*CHAR) LEN(512)                       
             DCL        VAR(&OUTPUT_P) TYPE(*PTR)                               
             DCL        VAR(&IN_BYTE) TYPE(*INT)                                
             DCL        VAR(&IN_BYTE_P) TYPE(*PTR)                              
             DCL        VAR(&OUT_BYTE) TYPE(*INT)                               
             DCL        VAR(&RTN_BYTE) TYPE(*INT)                               
             DCL        VAR(&TRUE) TYPE(*INT) VALUE(0)                          
             DCL        VAR(&FALSE) TYPE(*INT) VALUE(-1)                        
             DCL        VAR(&NULL28) TYPE(*CHAR) LEN(28) +                      
                          VALUE(X'00000000000000000000000000000000000+          
                          000000000000000000000')                               
             DCL        VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00')              
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))                 
                                                                                
/*(1) 変換ハンドルを作成 */                                                     
             CHGVAR     VAR(%BIN(&BIN4)) VALUE(5026)                            
             CHGVAR     VAR(&FROMCODE) VALUE(&BIN4 *CAT &NULL28)                
             CHGVAR     VAR(%BIN(&BIN4)) VALUE(1208)                            
             CHGVAR     VAR(&TOCODE) VALUE(&BIN4 *CAT &NULL28)                  
             CHGVAR     VAR(&CD_P) VALUE(%ADDR(&CD))                            
             CALLPRC    PRC('QﾎﾇIｳﾅﾄﾐOﾆｵﾄ') PARM((&TOCODE) +                    
                          (&FROMCODE)) RTNVAL(&CD)                              
             CHGVAR     VAR(&BIN4) VALUE(%SST(&CD 1 4))                         
             CHGVAR     VAR(&RTN4) VALUE(%BIN(&BIN4))                           
             IF         COND(&RTN4 *EQ &FALSE) THEN(DO)                         
             CHGVAR     VAR(&MSG) VALUE('ｹｳﾅﾄﾐ ﾅﾆｵﾄ ｵﾈﾈﾅﾈ')                     
             GOTO       SNDMSG                                                  
             ENDDO                                                              
             SNDPGMMSG  MSG('ｹｳﾅﾄﾐ OPEN.') MSGTYPE(*DIAG)                       
                                                                                
/*(2) 変換を実行 */                                                             
             CHGVAR     VAR(&CD_P) VALUE(%ADDR(&CD))                            
             CHGVAR     VAR(&INPUT) VALUE('ABC123' *CAT &NULL)                  
             CHGVAR     VAR(&INPUT_P) VALUE(%ADDR(&INPUT))                      
             CHGVAR     VAR(&IN_BYTE) VALUE(6)                                  
             CHGVAR     VAR(&IN_BYTE_P) VALUE(%ADDR(&IN_BYTE))                  
             CHGVAR     VAR(&OUTPUT_P) VALUE(%ADDR(&OUTPUT))                    
             CHGVAR     VAR(&OUT_BYTE) VALUE(512)                               
             CALLPRC    PRC('ｹｳﾅﾄﾐ') PARM((&CD *BYVAL) (&INPUT_P) +             
                          (&IN_BYTE) (&OUTPUT_P) (&OUT_BYTE)) +                 
                          RTNVAL(&RTN_BYTE)                                     
             IF         COND(&RTN_BYTE *EQ &FALSE) THEN(DO)                     
             CHGVAR     VAR(&MSG) VALUE('ｹｳﾅﾄﾐ ｳﾐﾎ ｵﾈﾈﾅﾈ')                      
             CALLPRC    PRC('ｹｳﾅﾄﾐ_ｳﾂﾅﾍｵ') PARM((&CD))                          
             GOTO       SNDMSG                                                  
             ENDDO                                                              
             SNDPGMMSG  MSG('ｹｳﾅﾄﾐ CONVERT  SUCCESS') MSGTYPE(*DIAG)            
                                                                                
/*(3) 変換ハンドルをクローズ */                                                 
CLOSE:                                                                          
             CALLPRC    PRC('ｹｳﾅﾄﾐ_ｳﾂﾅﾍｵ') PARM((&CD *BYVAL))                   
             SNDPGMMSG  MSG('ｹｳﾅﾄﾐ API CLOSED.') MSGTYPE(*DIAG)                 
             RETURN                                                             
                                                                                
 ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +                     
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +           
                          MSGFLIB(&MSGFLIB)                                     
 SNDMSG:                                                                        
             IF         COND(&MSGID *NE ' ') THEN(DO)                           
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +                    
                          MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)                      
             ENDDO                                                              
             ELSE       CMD(DO)                                                 
             SNDPGMMSG  MSG(&MSG) TOMSGQ(*TOPGMQ) MSGTYPE(*DIAG)                
             ENDDO                                                              
             ENDPGM