• Subject: Re: Moving Source between AS/400 without tape...
  • From: Larry Bolhuis <lbolhui@xxxxxxx>
  • Date: Sat, 30 May 1998 13:55:07 -0400
  • Organization: Arbor Solutions, Inc

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

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2019 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 here. If you have questions about this, please contact [javascript protected email address].