H DFTNAME(TESTJSON2) DATEDIT(*YMD/) BNDDIR('QC2LE') H CCSID(*GRAPH:*SRC) F********** JSON パーサーのテスト 2 *********************************** F* F********************************************************************** * CRTBNDRPG OBJ(OBJLIB/TESTJSON2) SRCFILE(MYSRCLIB/QRPGLESRC) * DFTACTRP(*NO) ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL) *-------------------------------------------------------------------* * 2021/12/01 : 作成 *-------------------------------------------------------------------* /COPY QSYSINC/QRPGLESRC,IFS **************************************************** * プロシージャーのプロトタイプ宣言 * **************************************************** D*( JSON2XML のプロトタイプ宣言 ) D JSON2XML PR 10I 0 D JSON_P * Vｱﾂﾏｵ D XML_P * Vｱﾂﾏｵ D XMLEN_P * Vｱﾂﾏｵ D OPTIONS 128A Vｱﾂﾏｵ *( 作業変数 ) D XMLIFS S 128A INZ('/AS400-NET.USR/TEMP/TEST.JSN') D STAT_ DS LIKEDS(ﾍﾎｱﾎ_ﾎ) D TRUE# S 10I 0 INZ(0) D FALSE# S 10I 0 INZ(-1) D JSON S 512A D XML S 32763A D UCS2 S 32763C CCSID(1200) D MSG S 80A D XMLEN S 10I 0 D RECORD DS QUALIFIED DIM(30) D SHCODE 1 10A D SHNAME 11 34A D SHTANK 35 41S 0 D SHSCOD 42 45A /FREE JSON2XML(%ADDR(XMLIFS): %ADDR(XML): %ADDR(XMLEN): 'ｴﾅｳ=ｶｹﾂｵ'); //JSON を XML に変換する XML-INTO RECORD %XML(%UCS2(XML): 'ﾆｱﾎｸ=ｶｹﾂｵ/ﾈｵｳﾅﾈｴ ｳｳﾍｹｴ=ﾏｳﾍ2 ｳｱﾍｵ=ｱﾄﾓ ｴﾅｳ=ﾍﾎﾈｹﾄｷ'); /END-FREE C SETON LR C RETURN ************************************************************ * JSON2XML : JSON を XML に変換する ************************************************************ *---( JSON2XML ここから )-----------------------* * JSON を XML に変換する P JSON2XML B D PI 10I 0 D FILE_P * Vｱﾂﾏｵ D XML_P * Vｱﾂﾏｵ D XMLEN_P * Vｱﾂﾏｵ D OPTIONS 128A Vｱﾂﾏｵ * *( 作業変数 ) D FILE S 128A BASED(FILE_P) D XML S 32763A BASED(XML_P) D XMLEN S 10I 0 BASED(XMLEN_P) D FD S 10I 0 D JSON S 1A DIM(32763) D OPTION S 128A BASED(OPTION_P) D N S 10I 0 D LEN S 10I 0 D X S 4S 0 D FLD S 10A D VALUE S 256A D ｲFLD S N INZ(*OFF) D ｲVALUE S N INZ(*OFF) D ｲOE S N INZ(*OFF) D ｲRECORD S N INZ(*OFF) D ｲFILE S N INZ(*OFF) D OE S 1A INZ(X'0E') D OF S 1A INZ(X'0F') D CR S 1A INZ(X'0D') D LF S 1A INZ(X'25') D TMPBUF S 32763A D TMPLEN S 10I 0 D BYTE_RED S 10I 0 D CCS5035 S 10I 0 INZ(5035) D CCS1200 S 10I 0 INZ(1200) D STAT DS LIKEDS(ﾍﾎｱﾎ_ﾎ) C IF %SCAN('ｴﾅｳ=ｶｹﾂｵ':OPTIONS) > 0 /FREE FD = ﾅﾆｵﾄ(%TRIMR(FILE): O_RDONLY + O_TEXTDATA + O_CCSID:0:CCS5035); IF FD = FALSE#; MSG = ' ファイル ' + %TRIMR(FILE) + ' のオープンに失敗しました。 '; RETURN FALSE#; ENDIF; ﾂﾍﾎｱﾎ(%TRIM(FILE): STAT_); TMPLEN = STAT_.ﾍﾎ_ﾍｹﾔｵ + 100; BYTE_RED = ﾈｵｱｴ (FD: %ADDR(TMPBUF): TMPLEN); CALLP ｳﾂﾅﾍｵ(FD); /END-FREE C MOVEA TMPBUF JSON C EVAL LEN = BYTE_RED C ELSE /FREE BYTE_RED = %LEN(FILE) + 1; /END-FREE C EVAL LEN = %LEN(%TRIMR(FILE)) C MOVEA FILE JSON C ENDIF /FREE X = 0; FOR N = 1 TO LEN; SELECT; WHEN JSON(N) = '{'; IF ｲFILE = *OFF; XML = %TRIMR(XML) + ''; ｲFILE = *ON; ENDIF; IF ｲRECORD = *OFF; XML = %TRIMR(XML) + ''; ｲRECORD = *ON; ENDIF; WHEN JSON(N) = '"'; IF ｲOE = *ON; VALUE = %TRIMR(VALUE) + JSON(N); // 漢字中 ITER; ENDIF; IF ｲFLD = *OFF; IF %LEN(%TRIMR(FLD)) > 0; // フィールドの終わり ｲFLD = *ON; XML = %TRIMR(XML) + '<' + %TRIMR(FLD) + '>'; ENDIF; ELSE; IF ｲVALUE = *OFF; IF %LEN(%TRIMR(VALUE)) > 0; ｲVALUE = *ON; // 値の終わり XML = %TRIMR(XML) + %TRIMR(VALUE) + ''; ENDIF; ELSE; ENDIF; ENDIF; WHEN JSON(N) = ':'; IF ｲOE = *ON; VALUE = %TRIMR(VALUE) + JSON(N); // 漢字中 ITER; ENDIF; WHEN JSON(N) = ','; IF ｲOE = *ON; VALUE = %TRIMR(VALUE) + JSON(N); // 漢字中 ITER; ENDIF; ｲFLD = *OFF; ｲVALUE = *OFF; FLD = ' '; VALUE = ' '; WHEN JSON(N) = '}'; IF ｲOE = *OFF; IF ｲRECORD = *ON; XML = %TRIMR(XML) + ''; ｲRECORD = *OFF; ELSE; XML = %TRIMR(XML) + ''; ｲFILE = *OFF; ENDIF; ｲFLD = *OFF; ｲVALUE = *OFF; FLD = ' '; VALUE = ' '; ELSE; VALUE = %TRIMR(VALUE) + JSON(N); // 漢字中 ENDIF; WHEN JSON(N) = CR; IF ｲOE = *ON; VALUE = %TRIMR(VALUE) + JSON(N); // 漢字中 ITER; ENDIF; IF JSON(N+1) = LF; N = N + 1; ENDIF; OTHER; IF JSON(N) = OE; ｲOE = *ON; ELSE; IF JSON(N) = OF; ｲOE = *OFF; ENDIF; ENDIF; IF ｲFLD = *OFF; FLD = %TRIMR(FLD) + JSON(N); ELSE; VALUE = %TRIMR(VALUE) + JSON(N); ENDIF; ENDSL; ENDFOR; /END-FREE C EVAL XMLEN = %LEN(%TRIMR(XML)) C RETURN TRUE# P E *---( JSON2XML ここまで )----------------------*