El proposito de la utilidad
es poder pasar varios spool a PC sin necesidad de ninguna
herramienta solo utilizando los mismos recursos del AS/400
pero primero tienes que convertir el spool a archivo PF-DTA
y asi lo podras pasar a PC via ftp (que tambien lo tiene
el AS/400).
Es importante que para obtener los datos que te pido en
el CL tienes que teclear F11 desde el SPOOL hasta la vista
3
CPYSPLCL
/*
(parametros que recibe la CL) */
PGM PARM(&ARCHIVO
&DSP &USUA &NUMERO &DESDE +
&HASTA &LONG &CA &ARCHIBD)
/* variables */
DCL VAR(&ARCHIVO)
TYPE(*CHAR) LEN(10)
DCL VAR(&ARCHIBD)
TYPE(*CHAR) LEN(10)
DCL VAR(&DSP)
TYPE(*CHAR) LEN(10)
DCL VAR(&USUA)
TYPE(*CHAR) LEN(10)
DCL VAR(&NUMERO)
TYPE(*CHAR) LEN(8)
DCL VAR(&DESDE)
TYPE(*DEC) LEN(4)
DCL VAR(&DESDE1)
TYPE(*CHAR) LEN(4)
DCL VAR(&HASTA)
TYPE(*DEC) LEN(4)
DCL VAR(&NUM1)
TYPE(*DEC) LEN(4)
DCL VAR(&NUM2)
TYPE(*CHAR) LEN(4)
DCL VAR(&NUM3)
TYPE(*DEC) LEN(4)
DCL VAR(&NUMSG)
TYPE(*CHAR) LEN(4)
DCL VAR(&LONG)
TYPE(*DEC) LEN(3)
DCL VAR(&CA)
TYPE(*CHAR) LEN(1)
DCL VAR(&RS)
TYPE(*CHAR) LEN(4)
/*
CHGVAR VAR(&ARCHIBD) VALUE('C'
*TCAT &NUMERO)
*/
IF
COND(&CA = A) THEN(GOTO CMDLBL(ADD))
/*crea archivo que contendra spool copiados y si existe
manda MSG */
CRTPF FILE(CONTA/&ARCHIBD)
RCDLEN(&LONG) +
OPTION(*NOSRC) SIZE(*NOMAX)
MONMSG MSGID(CPF7302) EXEC(GOTO
CMDLBL(DUPLICADO))
ADD: CHGVAR
VAR(&DESDE1) VALUE(&DESDE)
CHGDTAARA DTAARA(*LDA (1 4)) VALUE(&DESDE1)
CHGVAR VAR(&NUM1) VALUE(&DESDE)
/* msg que te indica que numero de spool
esta copiando */
CONTI: CHGVAR
VAR(&NUMSG) VALUE(&NUM1)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Copiando' *BCAT &ARCHIVO *BCAT +
&NUMSG *BCAT &NUMERO *BCAT '..®.®') +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
/*copia
spool a pf-dta creado */
CPYSPLF FILE(&ARCHIVO) TOFILE(CONTA/&ARCHIBD)
+
JOB(&NUMERO/&USUA/&DSP) SPLNBR(&NUM1)
+
MBROPT(*ADD)
MONMSG MSGID(CPF3344) EXEC(GOTO
CMDLBL(ERRORES))
/*rutina que suma de uno en
uno el numero del spool hasta llegar al ultimo digitado
*/
CONTI1: RTVDTAARA DTAARA(*LDA
(1 4)) RTNVAR(&NUM2)
CHGVAR VAR(&NUM3) VALUE(&NUM2)
CHGVAR VAR(&NUM1) VALUE(&num3
+ 1)
CHGVAR VAR(&NUM2) VALUE(&num1)
CHGDTAARA DTAARA(*LDA (1 4)) VALUE(&NUM2)
IF
COND(&NUM1 *LE &HASTA) THEN(GOTO CMDLBL(CONTI))
ELSE GOTO CMDLBL(FIN)
/* Msg que si copias del spool 1 al 20 y no existe
el 10 te permite
seguir copiando los demas */
ERRORES: SNDUSRMSG MSG('Algunos
de los Datos no Correctos o no +
Existe el SPOOL' *BCAT &NUMSG *BCAT 'del +
Trabajo' *BCAT &NUMERO *BCAT '...®' *BCAT +
'Si deseas Continuar Copiando solo +
Responde <SI>') VALUES(S SI N NO) +
MSGTYPE(*INQ) TOUSR(*REQUESTER) MSGRPY(&RS)
IF
COND(&RS = S *OR &RS = SI) +
THEN(GOTO CMDLBL(CONTI1))
DUPLICADO: SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG)
+
MSGDTA('El Archivo' *bcat &archibd +
*bcat 'ya existe, no se completo el +
mandato ...®:®?') MSGTYPE(*ESCAPE)
FIN: ENDPGM
CPYSPLCMD
CMD PROMPT('COPIA
SPOOL A BDS')
********************************************************
**********
NOMBRE DEL ARCHIVO DE SPOOL
PARM KWD(ARCHIVO)
TYPE(*CHAR) LEN(10) +
MIN(1) +
PROMPT('Archivo A Copiar:')
********************************************************
********************************************************
********* ESTOS PARAMETROS
SON EL NOMBRE DEL TRABAJO
PARM KWD(DSP) TYPE(*CHAR)
LEN(10) DFT(DSP01) +
PROMPT('Dispositivo:')
PARM KWD(USUA)
TYPE(*CHAR) LEN(10) DFT(HEJR3333) +
PROMPT('Usuario:')
PARM KWD(NUMERO)
TYPE(*CHAR) LEN(8) DFT(098242) +
MIN(0) PROMPT('Numero de Trabajo:')
********************************************************
************ESTOS PARAMETROS SON EL NUMERO DE SPOOL
Y CONENDRAN EL RANGO
(DESDE - HASTA)
-
PARM KWD(DESDE)
TYPE(*DEC) LEN(4) REL(*GT 0) +
MIN(1) PROMPT('Numero de Archivo Desde:')
PARM KWD(HASTA)
TYPE(*DEC) LEN(4) REL(*GE &DESDE) +
MIN(1) PROMPT('Numero de Archivo Hasta:')
*********************************************************
************ (este parametro lo obtines visualisando
el spool )
*/
PARM KWD(LONG)
TYPE(*DEC) LEN(3) DFT(190) +
PROMPT('Longitud De Archivo de spool:')
*********************************************************
*********************************************************
************
(A=solo se ocupa si ya esta creado el archivo)
*/
PARM KWD(CA) TYPE(*CHAR)
LEN(1) RSTD(*YES) +
VALUES(C A) MIN(1) CHOICE('C=Crear +
A=Adicionar') PROMPT('Crear ó Adicionar:')
**********************************************************
**********************************************************
************ NOMBRE DEL ARCHIVO
QUE CONTENDRA LOS DATOS */
PARM KWD(ARCHIBD)
TYPE(*CHAR) LEN(10) MIN(1) +
PROMPT('Archivo que Contendra Datos:')
**********************************************************
Ver truco
Ver
código fuente
Ver
mandato
|
