Page History

...

詳細は、製品より提供されている RPG ソース・ファイル QRPGLRSRC、および QCLSRC ソース・ファイルの CRTDEMO プログラムのソースを参照してください。

以下の例には、必要なものはすべて含まれており、コンパイルを除き、その他の追加作業は必要ありません。

     H OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER)
     H BNDDIR('JSMBNDDIR')
      *
      * V6R1 - Limits
      * Maximum data structure size is 16,773,104 bytes
      * Data structure size = element size * occurrence
      *
     D ListDef1        S             60A   DIM(3) CTDATA
     D ListDefSize     S             10I 0 INZ(0)
     D ListEntSize     S             10I 0 INZ(0)
     D ListCount       S             10I 0 INZ(0)
     D ListMaxCount    S             10I 0 INZ(0)
      *
     D JSMHDL          S              4A   INZ(*BLANKS)
     D JSMSRV          S             50A   INZ(*BLANKS)
     D JSMSTS          S             20A   INZ(*BLANKS)
     D JSMMSG          S            512A   INZ(*BLANKS)
     D JSMCMD          S            512A   INZ(*BLANKS)
     D ZEROLENGTH      S             10I 0 INZ(0)
      *
     D COUNT           S              6S 0 INZ(0)
      *
     D LST1            DS                  OCCURS(9999)
     D  PRDID                        10A
     D  PRDNME                       20A
     D  PRDAMT                       10P 2
      *
     D LST2            DS                  DIM(9999) QUALIFIED
     D  PRDID                        10A
     D  PRDNME                       20A
     D  PRDAMT                       10P 2
      *
      * JSMX_BEGIN
      *
     C                   CALLB(D)  'JSMX_BEGIN'
     C                   PARM                    *OMIT
     C                   PARM                    ZEROLENGTH
      *
      * JSMX_OPEN - USE JSMCLTDTA FOR SERVER
      *
     C                   CLEAR                   JSMSRV
     C                   EVAL      JSMSRV = ''
     C                   CALLB(D)  'JSMX_OPEN'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMSRV
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * SERVICE_LOAD
      *
     C                   CLEAR                   JSMCMD
     C                   EVAL      JSMCMD = 'SERVICE_LOAD' +
     C                                      ' SERVICE(ExcelService)' +
     C                                      ' TRACE(*YES)'
     C                   CALLB(D)  'JSMX_COMMAND'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMCMD
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * CREATE
      *
     C                   CLEAR                   JSMCMD
     C                   EVAL      JSMCMD = 'CREATE'
     C                   CALLB(D)  'JSMX_COMMAND'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMCMD
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * ADD OBJECT(*SHEET)
      *
     C                   CLEAR                   JSMCMD
     C                   EVAL      JSMCMD = 'ADD OBJECT(*SHEET)' +
     C                                      ' SHEET(MyTest)'
     C                   CALLB(D)  'JSMX_COMMAND'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMCMD
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * ADD OBJECT(*CELLSTYLE)
      *
     C                   CLEAR                   JSMCMD
     C                   EVAL      JSMCMD = 'ADD OBJECT(*CELLSTYLE)' +
     C                                      ' TYPE(*NUMBER)' +
     C                                      ' COLUMN(5) RANGE(10,20)' +
     C                                      ' FONT(*TAHOMA)' +
     C                                      ' FORMAT(*FORMAT4)' +
     C                                      ' HALIGN(*RIGHT)' +
     C                                      ' BACKGROUND(*YELLOW)'
     C                   CALLB(D)  'JSMX_COMMAND'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMCMD
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * WRITE LIST
      *
     C                   EVAL      COUNT = 0
     C     1             DO        20
     C                   ADD       1             COUNT
     C     COUNT         OCCUR     LST1
     C                   EVAL      PRDID  = 'ID' + %CHAR (COUNT)
     C                   EVAL      PRDNME = 'Product ' + %CHAR (COUNT)
     C                   EVAL      PRDAMT = 1000.45 + COUNT
     C                   ENDDO
      *
      * Reset list to beginning
     C     1             OCCUR     LST1
     C                   EVAL      ListDefSize  = %SIZE(ListDef1:*ALL)
     C                   EVAL      ListEntSize  = %SIZE(LST1)
     C                   EVAL      ListCount    = COUNT
     C                   EVAL      ListMaxCount = %ELEM(LST1)
     C                   CALLB(D)  'JSMX_BINDLST'
     C                   PARM                    JSMHDL
     C                   PARM                    ListDef1
     C                   PARM                    ListDefSize
     C                   PARM                    LST1
     C                   PARM                    ListEntSize
     C                   PARM                    ListCount
     C                   PARM                    ListMaxCount
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * WRITE R1C1
      *
     C                   CLEAR                   JSMCMD
     C                   EVAL      JSMCMD = 'WRITE R1C1(10,3)'
     C                   CALLB(D)  'JSMX_COMMAND'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMCMD
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * WRITE LIST 2
      *
     C                   EVAL      COUNT = 0
     C     1             DO        20
     C                   ADD       1             COUNT
     C                   EVAL      LST2(COUNT).PRDID  = 'ID' + %CHAR (COUNT)
     C                   EVAL      LST2(COUNT).PRDNME = 'NME' + %CHAR (COUNT)
     C                   EVAL      LST2(COUNT).PRDAMT = 2000.47 + COUNT
     C                   ENDDO
      *
     C                   EVAL      ListDefSize  = %SIZE(ListDef1:*ALL)
     C                   EVAL      ListEntSize  = %SIZE(LST2)
     C                   EVAL      ListCount    = COUNT
     C                   EVAL      ListMaxCount = %ELEM(LST2)
     C                   CALLB(D)  'JSMX_BINDLST'
     C                   PARM                    JSMHDL
     C                   PARM                    ListDef1
     C                   PARM                    ListDefSize
     C                   PARM                    LST2
     C                   PARM                    ListEntSize
     C                   PARM                    ListCount
     C                   PARM                    ListMaxCount
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * WRITE R1C1
      *
     C                   CLEAR                   JSMCMD
     C                   EVAL      JSMCMD = 'WRITE R1C1(10,10)'
     C                   CALLB(D)  'JSMX_COMMAND'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMCMD
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * READ LIST 2
      *
     C                   CLEAR                   LST1
     C                   CLEAR                   LST2
      *
     C                   EVAL      ListDefSize  = %SIZE(ListDef1:*ALL)
     C                   EVAL      ListEntSize  = %SIZE(LST2)
     C                   EVAL      ListCount    = 0
     C                   EVAL      ListMaxCount = %ELEM(LST2)
     C                   CALLB(D)  'JSMX_BINDLST'
     C                   PARM                    JSMHDL
     C                   PARM                    ListDef1
     C                   PARM                    ListDefSize
     C                   PARM                    LST2
     C                   PARM                    ListEntSize
     C                   PARM                    ListCount
     C                   PARM                    ListMaxCount
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * READ R1C1
      *
     C                   CLEAR                   JSMCMD
     C                   EVAL      JSMCMD = 'READ R1C1(10,15) ROWCOUNT(5)'
     C                   CALLB(D)  'JSMX_COMMAND'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMCMD
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      *                  DSPLY                   ListCount
      *                  DO        LISTCOUNT     COUNT
      *                  EVAL      PRDID  = LST2(COUNT).PRDID
      *                  EVAL      PRDNME = LST2(COUNT).PRDNME
      *                  EVAL      PRDNME = %CHAR (LST2(COUNT).PRDAMT)
      *                  DSPLY                   LST2(COUNT)
      *                  DSPLY                   PRDNME
      *                  ENDDO
      *
      * SAVE FILE
      *
     C                   CLEAR                   JSMCMD
     C                   EVAL      JSMCMD = 'SAVE' +
     C                                      ' FILE(demo.xlsx)'
     C                   CALLB(D)  'JSMX_COMMAND'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMCMD
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * CLOSE
      *
     C                   CLEAR                   JSMCMD
     C                   EVAL      JSMCMD = 'CLOSE'
     C                   CALLB(D)  'JSMX_COMMAND'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMCMD
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * SERVICE_UNLOAD
      *
     C                   CLEAR                   JSMCMD
     C                   EVAL      JSMCMD = 'SERVICE_UNLOAD'
     C                   CALLB(D)  'JSMX_COMMAND'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMCMD
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * JSMX_CLOSE
      *
     C                   CALLB(D)  'JSMX_CLOSE'
     C                   PARM                    JSMHDL
     C                   PARM                    JSMSTS
     C                   PARM                    JSMMSG
     C                   CALLP     checkSTS(JSMSTS:JSMMSG)
      *
      * JSMX_END
      *
     C                   CALLB(D)  'JSMX_END'
      *
     C                   SETON                                        LR


      ********************************
      * Procedure to check JSM status
      ********************************
     P checkSTS        B
     D checkSTS        PI              N
     D  csJSMSTS                           CONST LIKE(JSMSTS)
     D  csJSMMSG                           CONST LIKE(JSMMSG)
     D  csMSGTXT       S            512A
     C                   IF        csJSMSTS <> 'OK'
     C                   EVAL      csMSGTXT = %TRIM(csJSMSTS) + ' ' +
     C                                        %TRIM(csJSMMSG)
     C                   CALLP     sendMSG(csMSGTXT)
     C                   RETURN    *OFF
     C                   ENDIF
     C                   RETURN    *ON
     P                 E


      **************************************
      * Procedure to send a program message
      **************************************
     P sendMSG         B
     D sendMSG         PI
     D smMSGTXT                     512A   VALUE
     D smMSGT          S             10A   INZ('*DIAG')
     D smMSGI          S              7A   INZ('CPF9897')
     D smMSGF          S             20A   INZ('QCPFMSG   *LIBL     ')
     D smMSGL          S             10I 0 INZ(%SIZE(smMSGTXT))
     D smSTKE          S             10A   INZ('*')
     D smSTKC          S             10I 0 INZ(1)
     D smMSGK          S              4A   INZ(*BLANK)
     D smERRC          S             10I 0 INZ(0)
     C                   CALL      'QMHSNDPM'
     C                   PARM                    smMSGI
     C                   PARM                    smMSGF
     C                   PARM                    smMSGTXT
     C                   PARM                    smMSGL
     C                   PARM                    smMSGT
     C                   PARM                    smSTKE
     C                   PARM                    smSTKC
     C                   PARM                    smMSGK
     C                   PARM                    smERRC
     P                 E


**CTDATA ListDef1
PRDID                                             A000001000
PRDNME                                            A000002000
PRDAMT                                            P000001002