练习时做的AS/400　subfile 的一个例子！（3）

最新推荐文章于 2019-07-28 08:09:16 发布

feigme

最新推荐文章于 2019-07-28 08:09:16 发布

阅读量1.5k

点赞数

分类专栏： as/400 文章标签： c disk

本文链接：https://blog.csdn.net/feigme/article/details/1567146

版权

as/400 专栏收录该内容

18 篇文章 1 订阅

订阅专栏

其中的主要RPG程序

FMT H .....H........1..CDYI....S..............1.F............................
*************** Beginning of data *************************************

*************** Feigme H.Guo*************************************

0001.00      H             Y
0002.00       *
0003.00      FCUSZIPL IF E           K        DISK
0004.00      FCUSSRC CF E                    WORKSTN
0005.00      F                                        @RRN KSFILE SUBFILE
0006.00       *----------------------------------------------------*
0007.00       *      KLIST                                         *
0008.00       *----------------------------------------------------*
0009.00      C           KCUS      KLIST
0010.00      C                     KFLD           ZIP
0011.00       *----------------------------------------------------*
0012.00       *      MAIN                                          *
0013.00       *----------------------------------------------------*
0014.00       *
0015.00      C                     EXSR #S001
0016.00      C                     EXSR #ENDPG                                                                              0017.00       *
0018.00       *----------------------------------------------------*
0019.00       * #ENDPG -- END PG                                   *
0020.00       *----------------------------------------------------*
0021.00      C           #ENDPG    BEGSR
0022.00       *
0023.00      C                     SETON                     LR
0024.00      C                     RETRN
0025.00       *
0026.00      C                     ENDSR
0027.00       *----------------------------------------------------*
0028.00       * #INITIAL PGM                                       *
0029.00       *----------------------------------------------------*
0030.00      C           *INZSR    BEGSR
0031.00       *
0032.00      C                     MOVE 'Y'       @YES    1
0033.00      C                     MOVE 'N'       @NO     1
0034.00      C                     MOVE *BLANK    @LOOP1 1
0035.00      C                     Z-ADD0         @RRN    50
0036.00       *
0037.00      C                     ENDSR
0038.00       *----------------------------------------------------*
0039.00       * #S001 -- SCREEN 1                                  *
0040.00       *----------------------------------------------------*
0041.00      C           #S001     BEGSR
0042.00       *
0043.00      C                     MOVE @YES      @LOOP1
0044.00      C           @LOOP1    DOWEQ@YES
0045.00      C                     WRITEFOOT1
0046.00      C                     WRITEHEAD
0047.00      C                     EXFMTPROMPT
0048.00       *
0049.00      C           *IN03     IFEQ *ON
0050.00      C                     LEAVE
0051.00      C                     ENDIF
0052.00       *
0053.00      C                     EXSR #CHK01
0054.00      C                     ENDDO
0055.00       *
0056.00      C                     ENDSR
0057.00       *----------------------------------------------------*
0058.00       * #CHK01                                             *
0059.00       *----------------------------------------------------*
0060.00      C           #CHK01    BEGSR
0061.00       *
0062.00      C           ZIP       IFNE *ZERO
0063.00      C           KCUS      SETLLCUSREC                   20
0064.00      C           *IN20     IFEQ *ON
0065.00      C                     EXSR #SFPRC
0066.00      C                     ENDIF
0067.00      C                     ENDIF
0068.00       *
0069.00      C                     ENDSR
0070.00       *----------------------------------------------------*
0071.00       * #SFCLR -- SUBFILE CLEAR                            *
0072.00       *----------------------------------------------------*
0073.00      C           #SFCLR    BEGSR
0074.00       *
0075.00      C                     SETON                     55
0076.00      C                     WRITESUBCTL
0077.00      C                     SETOF                     55
0078.00      C                     SETOF                     21
0079.00      C                     Z-ADD0         @RRN
0080.00       *
0081.00      C                     ENDSR
0082.00       *----------------------------------------------------*
0083.00       * #SFPRC                                             *
0084.00       *----------------------------------------------------*
0085.00      C           #SFPRC    BEGSR
0086.00       *
0087.00      C                     EXSR #SFCLR
0088.00      C                     EXSR #SFRED
0089.00       *
0090.00      C                     WRITEFOOT2
0091.00      C                     WRITEHEAD
0092.00      C                     EXFMTSUBCTL
0093.00       *
0094.00      C                     ENDSR
0095.00       *----------------------------------------------------*
0096.00       * #SFRED                                             *
0097.00       *----------------------------------------------------*
0098.00      C           #SFRED    BEGSR
0099.00       *
0100.00      C           *IN21     DOWEQ*OFF
0101.00      C           ZIP       READECUSREC                   71
0102.00      C           *IN71     IFEQ *ON
0103.00      C                     SETON                     33
0104.00      C                     MOVE '1'       *IN21
0105.00      C                     ELSE
0106.00      C                     ADD 1         @RRN
0107.00      C                     WRITESUBFILE                  71
0108.00      C                     ENDIF
0109.00      C                     ENDDO
0110.00       *
0111.00      C                     ENDSR
        ****************** End of data ****************************************