|
midrange.com
Chuck,
Attached is the source to two commands and the CL behind them. These
use the system supplied File Transfer Subroutine (Hence the names SNDFTS
and RCVFTS) If you put these on both AS/400's you can send or recieve
(Push or Pull) file members between systems. If you create a PDM user
option to fill in the parameters for you, it is simple to move one or
more members. This may not be the best way for Mass moves (Use a *SAVF)
it is THE best way to update a small number of members.
Requirements:
Systems connected via APPC.
User profile of the user entering the command must exist on the
target AS/400.
The files must have the same record length on both source and target
systems.
The commands only need to exist on the system where they are being
executed but I recommend putting them on both sides for ease of use.
You promise to say nice things about me when you use the command!
In case anyone still cares, these commands also work to System/36s!
You'll see the parameters on the command to support S/36.
Larry Bolhuis
Arbor Solutions, Inc
lbolhui@ibm.net
Chuck Lewis wrote:
>
> Hi Folks,
>
> As I've mentioned here previously, we acquired a 2nd AS/400 (and thanks
> for the info on sharing a 3590, I'm getting pricing info "as we
> speak"... need a 6501 for the 500 plus cable...).
>
> In the mean time I REALLY need to get a complete library of source from
> our 530 to the 500. They are both on our T/R LAN so you can SNDNETF but
> WHAT a pain to do for, for instance 300 members in QCLSRC !!!
>
> Is there some way I'm missing, a command or something to do this -
> short of writung my own procedure, which I have a pretty good idea how
> to, just don't want to "reinvent the wheel" ?
>
> Thanks !
>
> Chuck
>
> +---
> | This is the Midrange System Mailing List!
> | To submit a new message, send your mail to MIDRANGE-L@midrange.com.
> | To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
> | To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
> | Questions should be directed to the list owner/operator:
david@midrange.com
> +---
CMD PROMPT('RECEIVE FILE VIA FTS')
/* Program Called is RCVFTSP,XD100STRUN */
PARM KWD(FROMLIB) TYPE(*NAME) LEN(10) RSTD(*NO) +
SPCVAL((*LIBL)) MIN(0) MAX(1) +
ALWUNPRT(*YES) ALWVAR(*YES) EXPR(*NO) +
PASSVAL(*DFT) PROMPT('From: Lib (Blank if +
S/36 File)')
PARM KWD(FROMFILE) TYPE(*NAME) LEN(10) RSTD(*NO) +
MIN(1) MAX(1) ALWUNPRT(*YES) ALWVAR(*NO) +
EXPR(*NO) PASSVAL(*DFT) PROMPT(' File')
PARM KWD(FROMMBR) TYPE(*NAME) LEN(10) RSTD(*NO) +
MIN(1) MAX(1) ALWUNPRT(*YES) ALWVAR(*NO) +
EXPR(*NO) PASSVAL(*DFT) PROMPT(' +
Member')
PARM KWD(TYPE) TYPE(*CHAR) LEN(6) RSTD(*YES) +
VALUES(SOURCE PROC LOAD SUBR) MIN(1) MAX(1) +
ALWUNPRT(*YES) ALWVAR(*NO) EXPR(*NO) +
PASSVAL(*DFT) PROMPT(' Member Type +
(S/36 Only)')
PARM KWD(TOLIB) TYPE(*NAME) LEN(10) RSTD(*NO) +
DFT(*FROMLIB) SPCVAL((*FROMLIB)) MIN(0) +
MAX(1) ALWUNPRT(*YES) ALWVAR(*YES) +
EXPR(*NO) PASSVAL(*DFT) PROMPT('To: +
Library')
PARM KWD(TOFILE) TYPE(*NAME) LEN(10) RSTD(*NO) +
DFT(*FROMFILE) SPCVAL((*FROMFILE)) MIN(0) +
MAX(1) ALWUNPRT(*YES) ALWVAR(*NO) EXPR(*NO) +
PASSVAL(*DFT) PROMPT(' File')
PARM KWD(TOMBR) TYPE(*NAME) LEN(10) RSTD(*NO) +
DFT(*FROMMBR) SPCVAL((*FROMMBR)) MIN(0) +
MAX(1) ALWUNPRT(*YES) ALWVAR(*NO) EXPR(*NO) +
PASSVAL(*DFT) PROMPT(' Member')
PARM KWD(REPLACE) TYPE(*CHAR) LEN(1) RSTD(*YES) +
DFT(Y) VALUES(Y N) MIN(0) MAX(1) +
ALWUNPRT(*YES) ALWVAR(*NO) EXPR(*NO) +
PASSVAL(*DFT) PROMPT('Replace Member (Y/N)')
PARM KWD(RMTLOCNAM) TYPE(*CNAME) LEN(8) RSTD(*NO) +
DFT(SYSTEM36) MIN(0) MAX(1) ALWUNPRT(*YES) +
ALWVAR(*NO) EXPR(*NO) PASSVAL(*DFT) +
PROMPT('Remote Location Name')
PARM KWD(PASSWORD) TYPE(*CHAR) LEN(10) RSTD(*NO) +
MIN(0) MAX(1) ALWUNPRT(*YES) ALWVAR(*NO) +
EXPR(*NO) PASSVAL(*DFT) PROMPT('Remote +
Location Password')
PGM (&FROMLIB &FROMFILE &FROMMBR &TYPE &TOLIB &TOFILE &TOMBR +
&REPLACE &RMTLOCNM &PASSWORD)
DCL &OPT *CHAR 1 'R' /* OPTION (S/R) */
DCL &FROMLIB *CHAR 10 /* FROM LIBRARY */
DCL &FROMFILE *CHAR 10 /* FROM FILE */
DCL &FROMMBR *CHAR 10 /* FROM MEMBER */
DCL &TYPE *CHAR 6 /* TYPE (S/36 ONLY) */
DCL &TOLIB *CHAR 10 /* TO LIBRARY */
DCL &TOFILE *CHAR 10 /* TO FILE */
DCL &TOMBR *CHAR 10 /* TO MEMBER */
DCL &TODATE *CHAR 6 ' ' /* TO DATE (DUMMY PARM) */
DCL &REPLACE *CHAR 1 /* REPLACE OPTION (Y/N) */
DCL &RMTLOCNM *CHAR 8 /* REMOTE LOCATION */
DCL &PASSWORD *CHAR 10 /* PASSWORD FOR REMOTE LOCATION */
DCL &RTNCODE *CHAR 1 /* RETURN CODE FROM ATTEMPT */
DCL &MSGID *CHAR 8 /* MESSAGE ID FROM ATTEMPT */
IF (&TOLIB = '*FROMLIB') CHGVAR &TOLIB &FROMLIB
IF (&TOFILE = '*FROMFILE') CHGVAR &TOFILE &FROMFILE
IF (&TOMBR = '*FROMMBR') CHGVAR &TOMBR &FROMMBR
CALL QY2FTML (&OPT &FROMLIB &FROMFILE &FROMMBR &TYPE +
&TOLIB &TOFILE &TOMBR &TODATE +
&REPLACE &RMTLOCNM &PASSWORD +
&RTNCODE &MSGID)
IF (&RTNCODE = '0') THEN(DO)
SNDMSG MSG('Member ' || &FROMMBR || ' In File ' || +
&FROMLIB |< '/' |< &FROMFILE || ' Retrieved +
From ' || &RMTLOCNM || ' -- Remote Name ' +
|| &TOMBR || ' In File ' || &TOLIB |< '/' +
|< &TOFILE) TOUSR(*REQUESTER)
RETURN
ENDDO
IF (&RTNCODE = '2') THEN(DO)
SNDMSG MSG('Error ' || &MSGID || ' Occurred At +
Remote System ' || &RMTLOCNM) +
TOUSR(*REQUESTER)
RETURN
ENDDO
IF (&RTNCODE = '1') THEN(DO)
SNDMSG MSG('Error ' || &MSGID || ' Occurred At +
Local System') TOUSR(*REQUESTER)
RETURN
ENDDO
ENDPGM
CMD PROMPT('SEND FILE VIA FTS')
/* Program Called is SNDFTSP,XD100STRUN */
PARM KWD(FROMLIB) TYPE(*NAME) LEN(10) RSTD(*NO) +
DFT(*LIBL) SPCVAL((*LIBL)) MIN(0) MAX(1) +
ALWUNPRT(*YES) ALWVAR(*YES) EXPR(*NO) +
PASSVAL(*DFT) PROMPT('From: Library')
PARM KWD(FROMFILE) TYPE(*NAME) LEN(10) RSTD(*NO) +
MIN(1) MAX(1) ALWUNPRT(*YES) ALWVAR(*NO) +
EXPR(*NO) PASSVAL(*DFT) PROMPT(' File')
PARM KWD(FROMMBR) TYPE(*NAME) LEN(10) RSTD(*NO) +
MIN(1) MAX(1) ALWUNPRT(*YES) ALWVAR(*NO) +
EXPR(*NO) PASSVAL(*DFT) PROMPT(' +
Member')
PARM KWD(TYPE) TYPE(*CHAR) LEN(6) RSTD(*YES) +
VALUES(SOURCE PROC LOAD SUBR) MIN(1) MAX(1) +
ALWUNPRT(*YES) ALWVAR(*NO) EXPR(*NO) +
PASSVAL(*DFT) PROMPT('To: Member Type +
(S/36 Only)')
PARM KWD(TOLIB) TYPE(*NAME) LEN(10) RSTD(*NO) +
DFT(*FROMLIB) SPCVAL((*FROMLIB)) MIN(0) +
MAX(1) ALWUNPRT(*YES) ALWVAR(*YES) +
EXPR(*NO) PASSVAL(*DFT) PROMPT(' Lib +
(Blank If S/36 File)')
PARM KWD(TOFILE) TYPE(*NAME) LEN(10) RSTD(*NO) +
DFT(*FROMFILE) SPCVAL((*FROMFILE)) MIN(0) +
MAX(1) ALWUNPRT(*YES) ALWVAR(*NO) EXPR(*NO) +
PASSVAL(*DFT) PROMPT(' File')
PARM KWD(TOMBR) TYPE(*NAME) LEN(10) RSTD(*NO) +
DFT(*FROMMBR) SPCVAL((*FROMMBR)) MIN(0) +
MAX(1) ALWUNPRT(*YES) ALWVAR(*NO) EXPR(*NO) +
PASSVAL(*DFT) PROMPT(' Member')
PARM KWD(REPLACE) TYPE(*CHAR) LEN(1) RSTD(*YES) +
DFT(Y) VALUES(Y N) MIN(0) MAX(1) +
ALWUNPRT(*YES) ALWVAR(*NO) EXPR(*NO) +
PASSVAL(*DFT) PROMPT('Replace Member (Y/N)')
PARM KWD(RMTLOCNAM) TYPE(*CNAME) LEN(8) RSTD(*NO) +
DFT(SYSTEM36) MIN(0) MAX(1) ALWUNPRT(*YES) +
ALWVAR(*NO) EXPR(*NO) PASSVAL(*DFT) +
PROMPT('Remote Location Name')
PARM KWD(PASSWORD) TYPE(*CHAR) LEN(10) RSTD(*NO) +
MIN(0) MAX(1) ALWUNPRT(*YES) ALWVAR(*NO) +
EXPR(*NO) PASSVAL(*DFT) PROMPT('Remote +
Location Password')
PGM (&FROMLIB &FROMFILE &FROMMBR &TYPE &TOLIB &TOFILE &TOMBR +
&REPLACE &RMTLOCNM &PASSWORD)
DCL &OPT *CHAR 1 'S' /* OPTION (S/R) */
DCL &FROMLIB *CHAR 10 /* FROM LIBRARY */
DCL &FROMFILE *CHAR 10 /* FROM FILE */
DCL &FROMMBR *CHAR 10 /* FROM MEMBER */
DCL &TYPE *CHAR 6 /* TYPE (S/36 ONLY) */
DCL &TOLIB *CHAR 10 /* TO LIBRARY */
DCL &TOFILE *CHAR 10 /* TO FILE */
DCL &TOMBR *CHAR 10 /* TO MEMBER */
DCL &TODATE *CHAR 6 ' ' /* TO DATE (DUMMY PARM) */
DCL &REPLACE *CHAR 1 /* REPLACE OPTION (Y/N) */
DCL &RMTLOCNM *CHAR 8 /* REMOTE LOCATION */
DCL &PASSWORD *CHAR 10 /* PASSWORD FOR REMOTE LOCATION */
DCL &RTNCODE *CHAR 1 /* RETURN CODE FROM ATTEMPT */
DCL &MSGID *CHAR 8 /* MESSAGE ID FROM ATTEMPT */
IF (&TOLIB = '*FROMLIB') CHGVAR &TOLIB &FROMLIB
IF (&TOFILE = '*FROMFILE') CHGVAR &TOFILE &FROMFILE
IF (&TOMBR = '*FROMMBR') CHGVAR &TOMBR &FROMMBR
CALL QY2FTML (&OPT &FROMLIB &FROMFILE &FROMMBR &TYPE +
&TOLIB &TOFILE &TOMBR &TODATE +
&REPLACE &RMTLOCNM &PASSWORD +
&RTNCODE &MSGID)
IF (&RTNCODE = '0') THEN(DO)
SNDMSG MSG('Member ' || &FROMMBR || ' In File ' || +
&FROMLIB |< '/' |< &FROMFILE || ' Sent To ' +
|| &RMTLOCNM || ' -- Remote Name ' || +
&TOMBR || ' In File ' || &TOLIB |< '/' |< +
&TOFILE) TOUSR(*REQUESTER)
RETURN
ENDDO
IF (&RTNCODE = '2') THEN(DO)
SNDMSG MSG('Error ' || &MSGID || ' Occurred At +
Remote System ' || &RMTLOCNM) +
TOUSR(*REQUESTER)
RETURN
ENDDO
IF (&RTNCODE = '1') THEN(DO)
SNDMSG MSG('Error ' || &MSGID || ' Occurred At +
Local System') TOUSR(*REQUESTER)
RETURN
ENDDO
ENDPGM
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
