ID #1120

スプールファイルの複写

スプールファイルを別のOUTQに複写します。

 
                     スプールファイル複写  (CRTDUPSPLF)                      
                                                                                
  選択項目を入力して,実行キーを押してください。                                
                                                                                
  スプールファイル  . . . . . . . > CRTDUPSPLC     名前                         
  複写先 OUTQ . . . . . . . . . . > OUTQ           名前                         
    ライブラリー  . . . . . . . . >   QGPL         名前 , *LIBL, *CURLIB        
  ジョブ名  . . . . . . . . . . .   *              名前 , *                     
    ユーザー  . . . . . . . . . .                  名前                         
    番号  . . . . . . . . . . . .                 000000-999999                 
  スプールファイル番号  . . . . . > *LAST         1-9999, *ONLY, *LAST          
  新ユーザー  . . . . . . . . . . > *SAME          名前 , *SAME                 
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                                
                                                                         終り   
 F3= 終了    F4=プロンプト   F5= 最新表示    F12= 取消し    F13= この画面の使用法  
 F24= キーの続き                                                                

--------------
CMD:CRTDUPSPLF
-------------- 
CMD        PROMPT('スプールファイル複写')

             PARM       KWD(FILE) TYPE(*SNAME) LEN(10) MIN(1) +
                          PROMPT('スプールファイル')
             PARM       KWD(TOOUTQ) TYPE(QUAL1) PROMPT('+
                          複写先OUTQ')
             PARM       KWD(JOB) TYPE(QUAL2) DFT(*) SNGVAL((*)) +
                          PROMPT('ジョブ名')
             PARM       KWD(SPLNBR) TYPE(*DEC) LEN(5) DFT(*ONLY) +
                          RANGE(1 9999) SPCVAL((*ONLY 0) (*LAST +
                          99999)) PROMPT('スプールファイル番号')
             PARM       KWD(USER) TYPE(*NAME) LEN(10) DFT(*SAME) +
                          SPCVAL((*SAME)) MIN(0) MAX(1) PROMPT('+
                          新ユーザー')
 QUAL1:      QUAL       TYPE(*NAME) MIN(1)

             QUAL       TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) +
                          (*CURLIB)) PROMPT('ライブラリー')
 QUAL2:      QUAL       TYPE(*NAME) LEN(10) MIN(1)

             QUAL       TYPE(*NAME) LEN(10) PROMPT('ユーザー')
             QUAL       TYPE(*CHAR) LEN(6) RANGE(000000 999999) +
                          PROMPT('番号')

-------------
CL:CRTDUPSPLC
-------------
PGM        PARM(&FROMSPLF   +
                  &TOOUTQ   +
                  &JOB      +
                  &SPLNBR   +
                  &TOUSER)

             DCL        VAR(&FROMSPLF) TYPE(*CHAR) LEN(10)
             DCL        VAR(&TOOUTQ)   TYPE(*CHAR) LEN(20)
             DCL        VAR(&JOB)      TYPE(*CHAR) LEN(26)
             DCL        VAR(&SPLNBR)   TYPE(*DEC)  LEN(5 0)
             DCL        VAR(&TOUSER)   TYPE(*CHAR) LEN(10)
             DCL        VAR(&OUTQ)     TYPE(*CHAR) LEN(10)
             DCL        VAR(&OUTQL)    TYPE(*CHAR) LEN(10)
             DCL        VAR(&RTNLIB)   TYPE(*CHAR) LEN(10)
             DCL        VAR(&MSGID)    TYPE(*CHAR) LEN(7)
             DCL        VAR(&MSGF)     TYPE(*CHAR) LEN(10)
             DCL        VAR(&MSGLIB)   TYPE(*CHAR) LEN(10)
             DCL        VAR(&MSGDTA)   TYPE(*CHAR) LEN(80)

             DCL        VAR(&ERRORIND) TYPE(*LGL)
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))

             CHGVAR     VAR(&OUTQ) VALUE(%SST(&TOOUTQ 1 10))
             CHGVAR     VAR(&OUTQL) VALUE(%SST(&TOOUTQ 11 10))

             CHKOBJ     OBJ(&OUTQL/&OUTQ) OBJTYPE(*OUTQ) AUT(*USE)

             IF         COND(&OUTQL *EQ '*LIBL') THEN(DO)
             RTVOBJD    OBJ(&OUTQ) OBJTYPE(*OUTQ) RTNLIB(&RTNLIB)
             CHGVAR     VAR(&TOOUTQ) VALUE(&OUTQ *CAT &RTNLIB)
             CHGVAR     VAR(&OUTQL) VALUE(&RTNLIB)
             ENDDO

             IF         COND(&OUTQL *EQ '*CURLIB') THEN(DO)
             RTVOBJD    OBJ(*CURLIB/&OUTQ) OBJTYPE(*OUTQ) +
                          RTNLIB(&RTNLIB)
             CHGVAR     VAR(&TOOUTQ) VALUE(&OUTQ *CAT &RTNLIB)
             CHGVAR     VAR(&OUTQL) VALUE(&RTNLIB)
             ENDDO

             CALL       PGM(CRTDUPSPLR) PARM(&FROMSPLF &TOOUTQ &JOB +
                          &SPLNBR &TOUSER &ERRORIND)

             IF         COND(&ERRORIND) THEN(DO)
             SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('+
                          スプールファイルは複写されませんでした。') +
                           MSGTYPE(*ESCAPE)
             ENDDO
             ELSE       CMD(DO)
             SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('+
                          スプールファイルは複写されました。') +
                           MSGTYPE(*COMP)
             ENDDO
             GOTO       CMDLBL(END)

 ERROR:
             RCVMSG     MSGTYPE(*EXCP) MSGDTA(&MSGDTA) MSGID(&MSGID) +
                          MSGF(&MSGF) MSGFLIB(&MSGLIB)

             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGLIB/&MSGF) +
                          MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE)

 END:
     ENDPGM

--------------
RPG:CRTDUPSPLR
--------------
     D FROMSPLF        S             10
     D TOOUTQ          S             20
     D JOB             S             26
     D SPLNBR          S              5  0
     D TOUSER          S             10
     D ERRORIND        S               N
      *
     D UZRSPC          S             20    INZ('CRTDUPSPLRQTEMP     ')
     D ATR             S             10
     D SIZE            S              9B 0 INZ(10000)
     D INIT            S              1
     D AUT             S             10    INZ('*ALL')
     D DESC            S             50    INZ('USER SPACE')
     D RPLXPX          S             10    INZ('*YES')
      *
     D ERROR           DS                  INZ
     D  BYTPRV                 1      4B 0
      *
     D RECLEN          S              9B 0 INZ(4000)
     D FORMATSPLA      S              8    INZ('SPLA0200')
     D INTJOB          S             16
     D INTSPOOL        S             16
     D SPOOL#          S              9B 0
     D NEWSPLFHDL      S              9B 0 INZ(3850)
     D FRMSPLFHDL      S              9B 0 INZ(3850)
     D BUFFER#         S              9B 0 INZ(-1)
     D FORMATGET       S              9    INZ('SPFR0200')
     D ENDSPOOLF       S             10    INZ('*WAIT')
      *
     D QUSA0200        DS          4000    INZ
     D  QUSOU01                      10             OVERLAY(QUSA0200:59)
     D  QUSON01                      10             OVERLAY(QUSA0200:191)
     D  QUSOL01                      10             OVERLAY(QUSA0200:201)
      *
     D QUSCRTUS        C                   'QUSCRTUS'
     D QUSRSPLA        C                   'QUSRSPLA'
     D QSPCRTSP        C                   'QSPCRTSP'
     D QSPOPNSP        C                   'QSPOPNSP'
     D QSPGETSP        C                   'QSPGETSP'
     D QSPPUTSP        C                   'QSPPUTSP'
     D QSPCLOSP        C                   'QSPCLOSP'
      *
     C     *ENTRY        PLIST
     C                   PARM                    FROMSPLF
     C                   PARM                    TOOUTQ
     C                   PARM                    JOB
     C                   PARM                    SPLNBR
     C                   PARM                    TOUSER
     C                   PARM                    ERRORIND
      *
     C                   IF        SPLNBR = 99999
     C                   EVAL      SPOOL# = -1
     C                   ELSE
     C                   EVAL      SPOOL# = SPLNBR
     C                   ENDIF
      *
     C                   CALL      QUSCRTUS
     C                   PARM                    UZRSPC
     C                   PARM                    ATR
     C                   PARM                    SIZE
     C                   PARM                    INIT
     C                   PARM                    AUT
     C                   PARM                    DESC
     C                   PARM                    RPLXPX
     C                   PARM                    ERROR
      *
     C                   CALL      QUSRSPLA
     C                   PARM                    QUSA0200
     C                   PARM                    RECLEN
     C                   PARM                    FORMATSPLA
     C                   PARM                    JOB
     C                   PARM                    INTJOB
     C                   PARM                    INTSPOOL
     C                   PARM                    FROMSPLF
     C                   PARM                    SPOOL#
     C                   PARM                    ERROR
      *
     C                   CALL      QSPOPNSP
     C                   PARM                    FRMSPLFHDL
     C                   PARM                    JOB
     C                   PARM                    INTJOB
     C                   PARM                    INTSPOOL
     C                   PARM                    FROMSPLF
     C                   PARM                    SPOOL#
     C                   PARM                    BUFFER#
     C                   PARM                    ERROR
      *
     C                   IF        TOUSER  <> '*SAME'
     C                   EVAL      QUSOU01 = TOUSER
     C                   ENDIF
     C                   EVAL      QUSON01 = %SUBST(TOOUTQ:1:10)
     C                   EVAL      QUSOL01 = %SUBST(TOOUTQ:11:10)
      *
     C                   CALL      QSPCRTSP
     C                   PARM                    NEWSPLFHDL
     C                   PARM                    QUSA0200
     C                   PARM                    ERROR
      *
     C                   CALL      QSPGETSP
     C                   PARM                    FRMSPLFHDL
     C                   PARM                    UZRSPC
     C                   PARM                    FORMATGET
     C                   PARM                    BUFFER#
     C                   PARM                    ENDSPOOLF
     C                   PARM                    ERROR
      *
     C                   CALL      QSPPUTSP
     C                   PARM                    NEWSPLFHDL
     C                   PARM                    UZRSPC
     C                   PARM                    ERROR
      *
     C                   CALL      QSPCLOSP
     C                   PARM                    FRMSPLFHDL
     C                   PARM                    ERROR
      *
     C                   CALL      QSPCLOSP
     C                   PARM                    NEWSPLFHDL
     C                   PARM                    ERROR
      *
     C                   EVAL      *INLR = *ON
     C                   RETURN
      *
     C     *PSSR         BEGSR
     C                   EVAL      ERRORIND = *ON
     C                   EVAL      *INLR = *ON
     C                   RETURN
     C                   ENDSR

タグ: SPOOL

関連エントリー: -

最終更新: 2011-10-30 09:50
製作者:
改訂: 1.1

Digg it! Share on Facebook このレコードを印刷する 友達に教える PDF ファイルで表示する
Propose a translation for Propose a translation for
この FAQ を評価してください:

評価点数: 0 (0 件の投票)

完全に役に立たない 1 2 3 4 5 最も価値がある

このエントリーにコメントできません。