ILE-RPG(プログラミングメモ)
前ページ へ 目 次 へ



下記プログラムは、プログラミングに際してサンプルになるように
命令を集めたRPG−IIIをRPG−IVに変換したものです。
ロジック的には意味をもちません。
ソースファイルに登録して、参照用として利用して下さい。



     H* サンプルプログラム
     H DATEDIT(*YMD-)
     F* 画面ファイルの例
     FDSP23     CF   E             WORKSTN
     F                                     INFDS(WSINF)
     F                                     SFILE(SFL01:RRN)
     FF500      UF   E           K DISK    USROPN
     FF700      UF   E           K DISK    COMMIT
     FFILE1     IF   F   80        DISK
     FM520      IF   E           K DISK
     FM520A     IF   E           K DISK
     F                                     RENAME(M520R:M520RA)
     FQPRINT    O    F  132        PRINTER OFLIND(*INOV)
     D*---------------------------------------------------------------
     D COD             S              2    DIM(4) CTDATA PERRCD(1) ASCEND
     D NAM             S            022    DIM(4) ALT(COD)
     D ARY             S              5  0 DIM(5) CTDATA PERRCD(1)
     D CHR             S              1    DIM(26)
     D*---------------------------------------------------------------
     D*フィールドのリネーム
     D               E DS                  EXTNAME(F580)
     D  NEW01        E                     EXTFLD(EXT01)
     D  NEW02        E                     EXTFLD(EXT02)
     D* プログラム状況 PGM-ID JOB-ID USER JOB-NO
     D                SDS
     D  W@PID            *PROC
     D  W@JID                244    253
     D  W@USR                254    263
     D  W@JNO                264    269
     D*カーソル制御
     D WSINF           DS
     D  WSPOS                370    371B 0
     D  WSNO                 378    379B 0
     D* システム日付・時刻の構造--------------------------------
     D                 DS
     D  HMSYMD                 1     14  0
     D  TIME                   1      6  4
     D  DATE8                  7     14  0
     D  YEAR4                  7     10  0
     D  DATE                   9     14  0
     D  YEAR                   9     10  0
     D  MONTH                 11     12  0
     D  DAY                   13     14  0
     D* STR
     D REC1            DS
     D  FLD80                  1     80
     D* LOCAL-DATAAREA
     D LDA2            DS
     D  RC2                    1      2
     D  YMD                    5     10  0
     D* USER-DATAAREA
     D UDA2            DS
     D  OLD1                   1      1
     D  MARK                   1      1
     D  MASI                   3      5  0
     D  DUMMY2                 6     10
     D*呼出しスタック                     ↓OCCURS
     D STACK           DS                  OCCURS(10)
     D  S@ID                   1     10
     D  S@USR                 11     20
     D  NAMAE                 21     40
     D* F900の外部記述を使った構造体
     D STR900        E DS                  EXTNAME(F900)
     D* F900の外部記述を使った構造体      OCCURS
     D REC           E DS                  OCCURS(4) EXTNAME(M500)
     D* USER-DATAAREA
     D STR1            DS
     D  ITEM1                  1      4    INZ('ABCD')
     D  ITEM2                  5     10  0 INZ(123456)
     D*名前つき定数
     D ABC             C                   CONST('ABCDEFGHIJKLMNOPQRST-
     D                                     UVWXYZ')
     D ZAB             C                   CONST('ZABCDEFGHIJKLMNOPQRS-
     D                                     TUVWXY')
     D KANA01          C                   CONST('1111111111222222')
     C*---------------------------------------------------------------
     ** PLIST
     C     *ENTRY        PLIST
     C     MISE          PARM                    PARM1             2
     **
     C     PLIST1        PLIST
     C                   PARM                    PARM2
     C                   PARM                    PARM3             6
     ** KLIST
     C     KLIST1        KLIST
     C                   KFLD                    YY
     C     KLIST2        KLIST
     C                   KFLD                    FLD01             4
     C                   KFLD                    FLD02             6
     ** DEFN
     C     *LIKE         DEFINE    ITEM2         PARM2
     C     *LIKE         DEFINE    OLD1          NEW1
     C     *DTAARA       DEFINE    *LDA          LDA2                           LOCAL-DATA-ARA
     C     *DTAARA       DEFINE    ARA1          UDA2                           USER-DATA-ARA
     C                   IN        LDA2
     C                   IN        UDA2
     ** CLEAR/RESET
     C                   CLEAR                   STR1                           0 / BLANK
     C                   RESET                   STR1                           初期値
     ** DSPLY
     C                   MOVEL     ABC           C52              52            表示USER
     C     C52           DSPLY                                                  表示USER
     C     '1ST-STEP'    DSPLY                                                  表示USER
     C     '2ND-STEP'    DSPLY     '*EXT'                                       表示USER
     C     'JOB-END '    DSPLY     'QSYSOPR'                                    表示OPR
     C     'OK?'         DSPLY                   ANS               1            表示・返答
     **
     C                   MOVEL     *ALLX'F1'     FLAG              1
     C                   MOVEL     *ALL'-'       BAR              80
     C                   Z-ADD     011           A                 7 0           変数A
     C                   Z-ADD     003           B                 7 0           変数B
     C                   Z-ADD     000           X                 7 0           添字
     C                   Z-ADD     000           CNT               7 0           読取数
     C                   Z-ADD     000           RRN               7 0           RRN
     C                   Z-ADD     B             X                                X=B
     C                   Z-SUB     B             X                                X=-B
     C     A             ADD       B             X                                X=A+B
     C     A             SUB       B             X                                X=A-B
     C     A             MULT      B             X                                X=A*B
     C     A             DIV       B             X                                X=A/B
     C     A             DIV(H)    B             X                                X=A/B
     C* 剰余を取得
     C     WSPOS         DIV       256           LIN               2 0            行
     C                   MVR                     COL               2 0            カラム
     C*
     C                   ADD       B             X                                X=X+B
     C                   SUB       B             X                                X=X-B
     C   51
     CAN 52
     CAN 53              MULT      B             X                                X=X*B
     C*配列
     C                   SQRT      B             X                                X=SQRT(B)
     C                   XFOOT     ARY           X                                X=SUM (B)
     C                   SORTA     ARY                                           整列
     C*
     C                   MOVEA     'ABCDEFGH'    CHR(01)
     C                   MOVEA     '23456'       CHR(02)
     C                   Z-ADD     001           X
     C                   MOVEL     'CC'          C2                2
     C     C2            LOOKUP    COD(X)                                 12
     C     *IN12         IFEQ      *ON
     C                   MOVEL     NAM(X)        C22              22
     C                   ENDIF
     C*文字列の割付
     C                   MOVEL     'ABCD'        C08              08            左詰め(1)
     C                   MOVE      'ABCD'        C08              08            右詰め(2)
     C                   MOVEL     '12345678'    C08                             (3)
     C                   MOVEL     'ABCD'        C08                             (4)
     C                   MOVEL(P)  'ABCD'        C08                             (5)
     C* CAT (文字列の連結)
     C                   MOVEL     'ABC'         C03               3
     C     C03           CAT       '12345'       C08               8
     C                   MOVEL(P)  'ABC'         C10              10
     C                   CAT       'D':0         C10                            'ABCD      '
     C                   MOVEL(P)  'ABC'         C10              10
     C     C10           CAT       '@':1         C10                            'ABC @     '
     C* SCAN (文字列の探索)
     C                   MOVEL     'ABC12345'    C08               8
     C     '123'         SCAN      C08           S1                7 0
     C* CHECK
     C                   MOVEL     '  CDEFGH'    C08               8
     C     'X'           CHECK     C08           N                 7 0  51
     C     ' '           CHECK     C08           N                 7 0  51
     C     ' '           CHECK     C08:2         N                 7 0    52
     C* CHEKR
     C                   MOVEL     'ABCDE   '    C08               8
     C     ' '           CHECKR    C08           L                 7 0
     C* SUBST
     C                   Z-ADD     5             L                 7 0
     C     L             SUBST     ABC:3         C05               5
     C* XLATE 文字列ABCとZABを使用して変換する。結果は'HAL'
     C     ABC:ZAB       XLATE     'IBM'         C03               3
     C* OPEN /CLOSE
     C                   OPEN      F500
     C                   CLOSE     F500
     C* SETLL
     C                   MOVEL     020101        KEY1              6 0
     C     KEY1          SETLL     F500R
     C* SETGT
     C     *HIVAL        SETGT     F500R
     C* READ  一つ前のレコードの読取
     C                   READ      F500R                                  99
     C                   READ      FILE1         REC1                     98
     C* READP 一つ前のレコードの読取
     C                   READP     F500R                                  99
     C                   READP     FILE1         REC1                     98
     C* READE
     C     KANA01        READE     M520RA                                 99
     C* REDPR
     C     KANA01        READE     M520RA                                 99
     C* UPDAT 読取りしたレコードの更新
     C                   READ      F500R                                  99
     C     *IN99         IFEQ      *OFF
     C                   UPDATE    F500R
     C                   ENDIF
     C* UPDAT 読取りしたレコードの削除
     C                   READ      F500R                                  99
     C     *IN99         IFEQ      *OFF
     C                   DELETE    F500R
     C                   ENDIF
     C* WRITE              ・・・
     C                   WRITE     FMT99
     C* EXCPT
     C                   EXCEPT    DTL01
     C* EXFMT              ・・・
     C                   EXFMT     FMT01
     C* READC              ・・・
     C                   READC     SFL01                                  09
     C* CHAIN              ・・・
     C     KLIST1        CHAIN     F700R                              09
     C                   UPDATE    F700R
     C     '123'         CHAIN     M520R                              09
     C*実行制御
     C* IF                 ・・・
+----C     A             IFEQ      *ZERO
|    C                   Z-ADD     0             X
+----C                   ELSE
|    C                   Z-ADD     12            X
+----C                   ENDIF
     C* SELEC
+----C                   SELECT
+----C     FLAG          WHENEQ    'A'
|    C                   Z-ADD     1             X
+----C     FLAG          WHENEQ    'B'
|    C                   Z-ADD     2             X
+----C                   OTHER
|    C                   Z-ADD     0             X
+----C                   ENDSL
     C* DO                 ・・・
     C                   MOVEL     'CC'          C2                2
+----C     001           DO        004           X
|    C     C2            IFEQ      COD(X)
|    C                   MOVEL     NAM(X)        C22              22
|    C                   LEAVE
|    C                   ENDIF
+----C                   ENDDO
     C*
     C                   Z-ADD     000           N                 7 0
+----C                   DO        10
|    C                   ADD       2             N
+----C                   ENDDO
     C* DO-UNTIL
     C                   Z-ADD     0             N
+----C     *IN99         DOUEQ     *ON
|    C                   READ      FILE1         REC1                     99
|    C     *IN99         IFEQ      *OFF
|    C                   ADD       1             N
|    C                   ENDIF
+----C                   ENDDO
     C* DO-WHILE
     C                   READ      FILE1         REC1                     99
+----C     *IN99         DOWEQ     *OFF
|    C     MARK          ANDEQ     '*'
|    C                   READ      FILE1         REC1                     99
+----C                   ENDDO
     C* GOTO
     C                   GOTO      NEXT
     C*                    処理
     C     NEXT          TAG
     C* CALLプログラムの呼出し
     C                   CALL      'PGM01'
     C                   PARM      ITEM1         PARM1
     C                   PARM      ITEM2         PARM2
     C*
     C                   MOVEL(P)  'PGM02'       PGID             10
     C                   CALL      PGID
     C* RPGからCLコマンドの実行
     C                   CALL      'QCMDEXC'
     C                   PARM      'WRKSPLF'     P@CMD            30
     C                   PARM      030           P@LEN            15 5
     C* SETON/SETOF
     C                   SETON                                        414243
     C                   SETOFF                                       515253
     C*
     C                   SETON                                        U1U2U3     JOB-SW
     C* TESTN
     C                   MOVEL     '1234'        N1                4
     C                   MOVEL     '  34'        N2                4
     C                   MOVEL     '    '        N3                4
     C                   MOVEL     ' 2 4'        N4                4
     C                   MOVEL     'AAAA'        N5                4
     C*                                                    41 42 43
     C                   TESTN                   N1                   414243     1  0  0
     C                   TESTN                   N2                   414243     0  1  0
     C                   TESTN                   N3                   414243     0  0  1
     C                   TESTN                   N4                   414243     0  0  0
     C                   TESTN                   N5                   414243     0  0  0
     C* COMIT
     C                   COMMIT
     C* EXSR
     C                   EXSR      SUB99
     C* OCUR
     C     X             OCCUR     STACK
     C*---------------------------------------------------------------
     C* BEGSR
     C     SUB1          BEGSR
     C*                   処理
     C                   ENDSR
     C*---------------------------------------------------------------
     C     SUB99         BEGSR
     C*
     C                   SETON                                        LR        LAST REC
     C                   RETURN
     C*
     C                   ENDSR
     OQPRINT    E            DTL01       2
     O                       MISE                 3
     O                       NAMAE               24
**
AAバー竜宮城
BB居酒屋すずめの涙
CCボッタクリ鬼の館
DDパーラー天国
** ARY **
20000
02000
00200
00020
00002



前ページ 目 次