Copy contents of Spool files from one computer to another
Here is a small utility to copy the entire contents of an outq on one AS/400 to an outq on another AS/400. I wrote it to facilitate transfer of files between production machine and backup machines. It was used when we did a live switch test between live and test machines as part of our disaster-recovery excercise to move production spool files (reports, RMA's, purchase orders) back and forth between machines.
A few modification of the SNDTCPSPLF parameters and this utility can be modified to move the contents of an outq to a printer or other TCPIP device.
If your needs are less ad hoc, better solution may be to use the CRTOUTQ command with option RMTSYS.
Here is what the user sees when the CL CS03110 is called,
From System: SYS1 To System From OutQueue To OutQueu
F3=Exit F10=Run
|
Here are the objects to create
AS03111
DSPF Copy Entire Outq - get system & outq
DS03111 PF Copy Entire Outq -
Unformatted spool file
DS03112 PF Copy Entire Outq -
formatted spool file
CS03110 CLP Copy Entire Outq -
Unformatted spool file
CS03111 CLP Copy Entire Outq -
Unformatted spool file
RS03111 RPGLE Copy Entire Outq - get system &
outq
RS03112 RPGLE Copy Entire Outq - flip to formatted
A* DISPLAY FILE: AS03111
A*-------------------------------------------------------------
A DSPSIZ(24 80 *DS3)
A R DSP1
A CF03(03)
A CF10(10)
A 8 14'System Name(to)'
A 10 14'From OutQ'
A #SYSNAME 10A B 8 31
A #FROM_OUTQ 10A B 10 31
A 22 3'F3=Exit F10=Run '
A MESSAGE 20A B 22 52DSPATR(BL)
A 8 43'(SOURCE,BUNKER)'
A COLOR(BLU)
A 10 43'(eg: RMA10, RMA50) '
A COLOR(BLU)
A 12 14'To OutQ'
A #TO_OUTQ 10A B 12 31
A 12 43'(eg: RMA10, RMA50, GIP)'
A COLOR(BLU)
A USERID 10A O 1 3
A 1 26'Send Contents of OutQ'
A DSPATR(UL)
A COLOR(WHT)
A 1 68TIME
A 2 68DATE
A EDTCDE(Y)
A 17 5'Will not erase source or estinati-
A on files.'
A COLOR(BLU)
A 2 27'to Another Machine'
A DSPATR(UL)
A COLOR(WHT)
A 18 5'Requires Security officer authorit-
A y to run this utility.'
A COLOR(BLU)
/********************************************************************/
/* PROGRAM OBJECT:... CS03110 */
/* PROGRAM:.......... SNDTCPSPLF - SEND ENTIRE OUTQUEUE */
/* AUTHOR:........... MMC */
/* DATE:............. */
/* FUNCTION:......... */
/* */
/* COMPILE NOTES:.... NONE */
/* MODS:............. */
/********************************************************************/
PGM
DCL VAR(&#SYSNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&#FROM_OUTQ) TYPE(*CHAR) LEN(10)
DCL VAR(&#TO_OUTQ) TYPE(*CHAR) LEN(10)
DCL VAR(&#LIBQ) TYPE(*CHAR) LEN(10)
DCL VAR(&#ABORT) TYPE(*CHAR) LEN(3)
DCLF FILE(DS03112)
CHGJOB LOG(4 00 *SECLVL) LOGCLPGM(*YES)
/* GET USER PARAMETERS */
CALL PGM(RS03111) PARM(&#SYSNAME &#FROM_OUTQ +
&#TO_OUTQ &#ABORT)
END:
ENDPGM
A* ----------------------------------------------------------
A* PHYSICAL FILE - DS03111
A* COPY SPOOL FILE UTILITY
A* DUMP OUTQ TO UNDEFINED FILE
A* -------------------------------------------------------------
A R DS031R1
A DATA 132A COLHDG('DATA')
A* -------------------------------------------------------------
A* PHYSICAL FILE - DS03112
A* COPY SPOOL FILE UTILITY
A* CREATE STRUCTURED FILE OUTQ DATA
A* -------------------------------------------------------------
A R DS031R2
A FILE 10 TEXT('FILENAME')
A JOBNAM 11 TEXT('JOBNAME')
A USER 10 TEXT('USER')
A NUMBER 6 TEXT('NUMB')
A FNBR 4 TEXT('FILE NBR')
/********************************************************************/
/* PROGRAM OBJECT:... CS03111 */
/* PROGRAM:.......... SNDTCPSPLF - ENTIRE OUTQUEUE */
/* AUTHOR:........... MMC */
/* DATE:............. */
/* FUNCTION:......... */
/* */
/* COMPILE NOTES:.... NONE */
/* MODS:............. */
/********************************************************************/
PGM PARM(&#SYSNAME &#FROM_OUTQ &#TO_OUTQ &#ABORT)
DCL VAR(&#SYSNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&#FROM_OUTQ) TYPE(*CHAR) LEN(10)
DCL VAR(&#TO_OUTQ) TYPE(*CHAR) LEN(10)
DCL VAR(&#LIBQ) TYPE(*CHAR) LEN(10)
DCL VAR(&#ABORT) TYPE(*CHAR) LEN(3)
DCLF FILE(DS03112)
IF COND(&#ABORT *EQ 'YES') THEN(DO)
GOTO END
ENDDO
/* TEMP VERSION OF FLAT FILE USED FOR SPOOL FILE INFO*/
RTVOBJD OBJ(DS03111) OBJTYPE(*FILE) RTNLIB(&#LIBQ)
DLTF FILE(QTEMP/DS03111)
MONMSG MSGID(CPF0000)
CRTDUPOBJ OBJ(DS03111) FROMLIB(&#LIBQ) OBJTYPE(*FILE) +
TOLIB(QTEMP)
OVRDBF FILE(DS03111) TOFILE(QTEMP/DS03111)
/* CREATE TEMP VERSION OF DDS DEFINED FILE */
RTVOBJD OBJ(DS03112) OBJTYPE(*FILE) RTNLIB(&#LIBQ)
DLTF FILE(QTEMP/DS03112)
MONMSG MSGID(CPF0000)
CRTDUPOBJ OBJ(DS03112) FROMLIB(&#LIBQ) OBJTYPE(*FILE) +
TOLIB(QTEMP)
OVRDBF FILE(DS03112) TOFILE(QTEMP/DS03112)
/* LIST SPOOL FILES TO SPOOL FILE */
WRKOUTQ OUTQ(&#FROM_OUTQ) OUTPUT(*PRINT)
/* COPY LIST TO PHYSICAL FILE */
CPYSPLF FILE(QPRTSPLQ) TOFILE(QTEMP/DS03111) +
SPLNBR(*LAST)
/* DELETE LAST SPOOL FILE CREATED */
DLTSPLF FILE(QPRTSPLQ) SPLNBR(*LAST)
/* FLIP TO DDS DEFINED FILE */
CALL PGM(RS03112)
/* CYCLE THROUGH AND FLIP SPOOL FILES */
READ: RCVF
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(EOF))
SNDTCPSPLF RMTSYS(&#SYSNAME) PRTQ(&#TO_OUTQ) +
FILE(&FILE) JOB(&NUMBER/&USER/&JOBNAM) +
SPLNBR(&FNBR) DESTTYP(*AS400) TRANSFORM(*NO)
GOTO CMDLBL(READ)
EOF:
END:
ENDPGM
*-------------------------------------------------------------------
* Program Name: RS03111
* Description.: AS/400 Utility
* COPY ENTIRE OUTQUEUE TO ANOTHER MACHINE
* Author......: MMC
* Date........: 2003-02-27
* Application.:
* Compile Inst:
* Mods........: Date Initial Modification
*-------------------------------------------------------------------
H DATFMT(*ISO)
H TIMFMT(*ISO)
*-------------------------------------------------------------------
fAS03111 CF E WORKSTN
*-------------------------------------------------------------------
D PSDS SDS
D ROUTINE *ROUTINE
D STATUS *STATUS
D PARAMETERS *PARMS
D PROCEDURE *PROC
D USERID 254 263
*-------------------------------------------------------------------
c DOW *IN03 = *OFF and *IN10 = *OFF
c EXFMT DSP1
c EXSR VALIDATION
c ENDDO
c 03 EVAL #ABORT = 'YES'
c EVAL MESSAGE = 'PROCESSING'
c call 'CS03111'
c PARM #SYSNAME
c PARM #FROM_OUTQ
c PARM #TO_OUTQ
c PARM #ABORT
c* RETURN
c SETON LR
*-------------------------------------------------------------------
c Validation BEGSR
c IF #SYSNAME = *blanks or
c #FROM_OUTQ = *blanks or
c #TO_OUTQ = *blanks
c EVAL *IN50 = *ON
c EVAL MESSAGE = 'Missing Parameters'
c ELSE
c EVAL *IN50 = *OFF
c EVAL MESSAGE = ' '
c ENDIF
c ENDSR
*-------------------------------------------------------------------
c *INZSR BEGSR
c *ENTRY PLIST
c PARM #SYSNAME #SYSNAME
c PARM #FROM_OUTQ #FROM_OUTQ
c PARM #TO_OUTQ #TO_OUTQ
c PARM #ABORT #ABORT 3
c
c SETOFF 31050
C EVAL #ABORT = 'NO '
c
c ENDSR
HDEBUG(*YES)
*-------------------------------------------------------------------
* Program Name: RS03112
* Description.: AS/400 Utility
* COPY ENTIRE OUT QUEUE TO ANOTHER MACHINE
* Author......: MMC
* Date........: 2003-02-27
* Application.:
* Compile Inst:
* Mods........: Date Initial Modification
*-------------------------------------------------------------------
fDS03111 IF E DISK
fDS03112 O E DISK
f*QPRINT O F 160 PRINTER
*-------------------------------------------------------------------
D DS INZ
D DATA 1 132
D ALLDATA 1 132
D FILE 2 11
D USER 13 22
D JOBNAM 84 94
D NUMBER 95 100
D FNBR 75 78
D QUEUE 119 128
D*-------------------------------------------------------------------
C READ DS031R1 99
C *IN99 DOWEQ *OFF
C IF FILE <> 'File'
C IF %SUBST(QUEUE:1:3) <> 'Pag'
C IF JOBNAM <> *blanks
c EXSR FixNumber
c WRITE DS031R2
c ENDIF
c ENDIF
c ENDIF
c READ DS031R1 99
c ENDDO
c SETON LR
c*-------------------------------------------------------------------
c FixNumber BEGSR
c IF %SUBST(FNBR:1:1) = ' '
c EVAL %SUBST(FNBR:1:1) = '0'
c ENDIF
c IF %SUBST(FNBR:2:1) = ' '
c EVAL %SUBST(FNBR:2:1) = '0'
c ENDIF
c IF %SUBST(FNBR:3:1) = ' '
c EVAL %SUBST(FNBR:3:1) = '0'
c ENDIF
c IF %SUBST(FNBR:4:1) = ' '
c EVAL %SUBST(FNBR:4:1) = '0'
c ENDIF
c ENDSR
c*-------------------------------------------------------------------
