親−子−孫 ．．． のツリー状の階層構造を持つデータベースをRPGでアクセスする方法を紹介しよう。
Windowsでは ｢構造化記憶｣と呼ばれているものに等しい。
ソースを紹介する前に、
親
｜
子 子 子 子 子
｜ ｜ ｜ ｜ ｜
孫 孫 孫 孫 孫 孫 孫
階層の深さは RPGソースの配列の項目数を拡大するだけで良い。
親から 子へ 下がるときに 親の横の次の兄弟を配列に保管しておいてから階層を下る方法である。
このテクニックはIBMが古くから紹介した部品構成の読取り手法を元にしている。
001.00 E* ARA:LEVEL 別部品構成 KEY の配列
002.00 E ARA 20 10
003.00 E* ARA の長さ = 部品構成 KEY の合計 BYTE 数
004.00 E* ARA の項目数 = 最大 LEVEL の深さ
005.00 I*( 部品展開 KEY の DS 記述 )
006.00 I DS
007.00 I 1 20 T\KEY
008.00 I 1 10 OY\KEY
009.00 I 11 20 KO\KEY
010.00 C******************************************************
011.00 C READ BEGSR
012.00 C******************************************************
013.00 C*( 部品構成 FILE の READ )
014.00 CSR MOVE STRCOD OY\KEY
015.00 CSR MOVE *LOVAL KO\KEY
016.00 CSR MOVE *BLANKS ARA
017.00 CSR Z-ADD1 LV 20
018.00 CSR NXTCMP TAG
019.00 C*----------------------------------------------------+
020.00 C TENKEY KLIST |
021.00 C KFLD OYCODE |
022.00 C KFLD KOCODE |
023.00 C*----------------------------------------------------+
024.00 CSR MOVE OY\KEY OYCODE
025.00 CSR MOVE KO\KEY KOCODE
026.00 C*( 子部品があるか ?)
027.00 CSR SETOF 50
028.00 CSR TENKEY READETENKAI 50
029.00 C* 子部品なし
030.00 CSR *IN50 IFEQ '1' OY\KEY
031.00 C* LOW LEVEL= 1 であれば終了
032.00 CSR NXTLV TAG
033.00 CSR LV CABEQ1 REDEND
034.00 C* 親の兄弟を検索
035.00 CSR SUB 1 LV
036.00 C* 横部品あるか ?
037.00 CSR ARA,LV CABEQ*BLANKS NXTLV
038.00 CSR MOVE ARA,LV T\KEY
039.00 C* 子部品あり
040.00 CSR ELSE OY\KEY
041.00 CSR ADD 1 LV
042.00 CSR END OY\KEY
043.00 C* 部品構成 MASTER を検索
044.00 C*----------------------------------------------------+
045.00 C TENKEY KLIST |
046.00 C KFLD OYCODE |
047.00 C KFLD KOCODE |
048.00 C*----------------------------------------------------+
049.00 CSR SETOF 99
050.00 CSR TENKEY CHAINTENKAI 99
051.00 CSR *IN99 IFEQ '0'
052.00 C*( PROCES: 部品構成の処理 )
053.00 C*----------------------------------------------------+
054.00 C EXSR PROCES |
055.00 C*----------------------------------------------------+
056.00 CSR END
057.00 CSR TENKEY SETGTTENKAI
058.00 CSR SETOF 50
059.00 CSR OYKEY READETENKAI 50
060.00 CSR *IN50 IFEQ '1'
061.00 CSR MOVE *BLANKS ARA,LV
062.00 CSR ELSE
063.00 CSR MOVE OYCODE OY\KEY
064.00 CSR MOVE KOKEY KO\KEY
065.00 CSR MOVE T\KEY ARA,LV
066.00 CSR END
067.00 CSR MOVE KO\KEY OY\KEY
068.00 CSR MOVE *BLANKS KO\KEY
069.00 CSR GOTO NXTCMP
070.00 CSR ENDSR 