H DFTNAME(TOWATSON) DATEDIT(*YMD/) BNDDIR('QC2LE') F********** 初めてのワトソン ****************************************** FTOWATSONFMCF E WORKSTN F********************************************************************** * CRTRPGMOD OBJ(QTEMP/TOWATSON) SRCFILE(R610SRC/QRPGLESRC) * DBGVIEW(*SOURCE) AUT(*ALL) * CRTPGM PGM(QUATTRO/TOWATSON) MODULE(QTEMP/TOWATSON) * BNDSRVPGM(ASNET.COM/HTTPSRV) ACTGRP(*NEW) AUT(*ALL) *-------------------------------------------------------------------* * 2017/05/01 : 作成 *-------------------------------------------------------------------* *( 作業変数 ) D DCR S 1A DIM(15) CTDATA PERRCD(15) D AR S 1A DIM(256) D N S 4S 0 D M S 4S 0 D TRUE# S 4B 0 INZ(0) D FALSE# S 4B 0 INZ(-1) D NULL C CONST(X'00') D DS D 1 10A INZ('ｵﾄｵﾍｶﾈｹﾎﾀｱ') D LANG 1 10A DIM(5) D*( TRANSLATE のプロトタイプ宣言 ) D TRANSLATE PR D FROMLANG 2A VALUE D TOLANG 2A VALUE D FROMTXT 120A VALUE D TOTXT * VALUE D*( ENCODE のプロトタイプ宣言 ) D ENCODE PR 1000A D FROMSTR 120A VALUE D*( HTTP_REQUEST のプロトタイプ宣言 ) D HTTP_REQUEST PR 10I 0 D URLPATH * VALUE D RTNVALUE * VALUE D RTNLEN * VALUE D MODE 10I 0 VALUE C*( 明細画面 ) C*----------------------------------------------------+ C DSPLY TAG C EXFMT DSPDTA01 | C*----------------------------------------------------+ C SETOFF 99 C*( CF03 )- 終了 C *IN03 IFEQ *ON CF03 C SETON LR C LR RETURN C GOTO DSPLY C END CF03 C*( 実行キー ) C SETON 80 C WRITE DSPDTA01 C SETOFF 80 /FREE TRANSLATE(LANG(FROMLG):LANG(TOLANG):FROMTXT:%ADDR(TOTXT)); /END-FREE C GOTO DSPLY C SETON LR C RETURN C****************************************************** C *INZSR BEGSR C****************************************************** C Z-ADD 1 FROMLG C Z-ADD 5 TOLANG C MOVEL(P) 'I ｱﾃ ｱ ｲﾅﾓ' FROMTXT C ENDSR C****************************************************** P TRANSLATE B EXPORT C****************************************************** D PI D FROMLANG 2A VALUE D TOLANG 2A VALUE D FROMTXT 120A VALUE D TOTEXT_P * VALUE D STR1 S 1000A D STR2 S 1000A D RC S 10I 0 D TOTEXT S 120A BASED(TOTEXT_P) D TEXTBACK DS QUALIFIED D LEN 1 4S 0 D DATA 5 260A /FREE STR2 = ENCODE(%TRIMR(FROMTXT)); STR1 = *BLANKS; STR1 = 'ｸﾎﾎﾆﾍ://ﾑｱﾎﾍﾅﾄ-ｱﾆｹ-ｵﾒﾆﾂﾅﾈｵﾈ.ﾄｷ.ｲﾂﾏｵﾃｹﾒ.ﾄｵﾎ/' + 'ﾂｱﾄｷﾏｱｷｵ-ﾎﾈｱﾄﾍﾂｱﾎﾅﾈ/ｱﾆｹ/ﾐ2/ﾎﾈｱﾄﾍﾂｱﾎｵ?ﾃﾅｴｵﾂ_ｹｴ=' + FROMLANG + '-' + TOLANG + '&ﾎｵﾒﾎ=' + STR2 + NULL; STR1 = %TRIMR(STR1); RC = HTTP_REQUEST(%ADDR(STR1): %ADDR(TEXTBACK.DATA): %ADDR(TEXTBACK.LEN): 1); IF (TEXTBACK.LEN > 0); TOTEXT = TEXTBACK.DATA; ELSE; TOTEXT = *BLANKS; ENDIF; RETURN; /END-FREE P E C****************************************************** P ENCODE B EXPORT C****************************************************** D PI 1000A D FROMSTR 120A VALUE D TOSTR S 1000A D BUFLEN S 5P 0 D STRING S 256A D N S 4S 0 D POS S 4S 0 INZ(1) D AR S 1A DIM(256) D BR S 1A DIM(3) D FLD3 S 3A D UPPER S 1A D LOWER S 1A D DS D CH01 1 1 INZ(X'00') D CH02 2 2 D BIN4 1 2B 0 C FROMSTR CAT(P) NULL:0 STRING C EVAL BUFLEN = %LEN(%TRIMR(FROMSTR)) C*----------------------------------------------------+ C CALL 'QDCXLATE' 99 | C PARM BUFLEN | C PARM STRING | C PARM 'QASCII ' TBL 10 | C PARM 'QSYS ' TBLLIB 10 | C*----------------------------------------------------+ C MOVEA *BLANKS AR C MOVEA *BLANKS BR C EVAL BR(1) = '%' C 1 DO BUFLEN N C EVAL CH02 = %SUBST(STRING:N:1) C BIN4 DIV 16 BIN4 C MVR AMARI 2 0 *( 上位ビット ) C EVAL M = BIN4 C MOVE DCR(M) UPPER *( 下位ビット ) C AMARI IFGT 0 C Z-ADD AMARI BIN4 C Z-ADD AMARI M C MOVE DCR(M) LOWER C ELSE C MOVE '0' LOWER C ENDIF * /FREE FLD3 = '%' + UPPER + LOWER; /END-FREE C MOVEA FLD3 AR(POS) C ADD 3 POS C ENDDO C MOVEA(P) AR TOSTR C TOSTR CAT NULL:0 TOSTR C EVAL TOSTR = %TRIMR(TOSTR) C RETURN TOSTR P E ** DCR - 以下は配列 123456789ABCDEF