/*____________________________________________________________________________*/
/* */
/* Description: FTP Prompt - Send 1 File */
/* */
/* */
/* History: */
/* STRSRC MDFLST - Modification point for history */
/* KH - July 09, 2001 */
/* ENDSRC MDFLST */
/* */
/*____________________________________________________________________________*/
CMD PROMPT('START A FTP BATCH TRANSFER')
PARM KWD(RMTSYS) TYPE(*CHAR) LEN(50) MIN(1) +
PROMPT('REMOTE SYSTEM FOR FTP TRANSFER')
PARM KWD(LCLFIL) TYPE(*CHAR) LEN(50) MIN(1) +
PROMPT('LOCAL FILE''S NAME')
PARM KWD(RMTFIL) TYPE(*CHAR) LEN(50) MIN(1) +
PROMPT('REMOTE FILE''S NAME')
PARM KWD(FUNCTION) TYPE(*CHAR) LEN(1) RSTD(*YES) +
VALUES(P G) SPCVAL((P P) (G G)) MIN(1) +
PROMPT('FUNCTION (PUT/GET)')
PARM KWD(USR) TYPE(*CHAR) LEN(10) MIN(1) +
PROMPT('USER PROFILE IN REMOTE SYSTEM')
PARM KWD(PWD) TYPE(*CHAR) LEN(30) MIN(1) +
PROMPT('PASSWORD TO REMOTE SYSTEM')
PARM KWD(OPT1) TYPE(*CHAR) LEN(20) +
PROMPT('COMMAND 1')
PARM KWD(OPT2) TYPE(*CHAR) LEN(20) +
PROMPT('COMMAND 2')
PARM KWD(OPT3) TYPE(*CHAR) LEN(20) +
PROMPT('COMMAND 3')
/*==================================================================*/
/* */
/* crtit - MKH - FTP PUT/GET Files */
/* */
/*==================================================================*/
/* */
/* PROGRAM FUNCTION */
/* */
/* This is the CPP for command FTPBATCH. */
/* */
/* It performs a batch FTP transfer of one file with a TCP/IP */
/* network connected FTP server. */
/* */
/* Program parameters: */
/* */
/* &TGTSYS (in ) - Target system */
/* &LCLFIL (in ) - Local file name */
/* &RMTFIL (in ) - Remote file name */
/* &FUNCTION (in ) - Function to be executed */
/* values: 'P' = Put */
/* 'G' = Get */
/* &USR (in ) - User ID in remote system */
/* &PWD (in ) - Password in remote system */
/* &CMD1 (in ) - Optional FTP subcommand */
/* (Executed before transfer) */
/* &CMD2 (in ) - Optional FTP subcommand */
/* (Executed before transfer) */
/* &CMD3 (in ) - Optional FTP subcommand */
/* (Executed before transfer) */
/* &SUCCES (out) - Success indicator */
/* values: '0' = Transfer failed */
/* '1' = Transfer successful */
/* All work files are created into library QTEMP. */
/* */
/* Programs called: */
/* */
/* 1 FTPFILER (ILE RPG) - Creates the FTP script */
/* for transfer */
/* FTPCHECKR(ILE RPG) - Checks the success of transfer */
/* by reading the FTP transfer log */
/* */
/********************************************************************/
/* */
/********************************************************************/
PGM PARM(&TGTSYS &LCLFIL &RMTFIL &FUNCTION &USR +
&PWD &CMD1 &CMD2 &CMD3)
/********************************************************************/
/* Parameters */
/********************************************************************/
DCL VAR(&TGTSYS) TYPE(*CHAR) LEN(50)
DCL VAR(&LCLFIL) TYPE(*CHAR) LEN(50)
DCL VAR(&RMTFIL) TYPE(*CHAR) LEN(50)
DCL VAR(&FUNCTION) TYPE(*CHAR) LEN(1)
DCL VAR(&USR) TYPE(*CHAR) LEN(10)
DCL VAR(&PWD) TYPE(*CHAR) LEN(30)
DCL VAR(&CMD1) TYPE(*CHAR) LEN(20)
DCL VAR(&CMD2) TYPE(*CHAR) LEN(20)
DCL VAR(&CMD3) TYPE(*CHAR) LEN(20)
DCL VAR(&MSG) TYPE(*CHAR) LEN(256)
DCL VAR(&JOB) TYPE(*CHAR) LEN(10)
DCL VAR(&SUCCES) TYPE(*CHAR) LEN(1)
/********************************************************************/
/* Local variables */
/********************************************************************/
DCL VAR(&OKCODE) TYPE(*CHAR) LEN(3)
DCL VAR(&ON) TYPE(*CHAR) LEN(1) VALUE('1')
DCL VAR(&OFF) TYPE(*CHAR) LEN(1) VALUE('0')
/********************************************************************/
/* Retrieve Job Attributes for message */
/********************************************************************/
RTVJOBA JOB(&JOB)
/********************************************************************/
/* Delete/Create the FTP script file */
/********************************************************************/
DLTF FILE(QTEMP/FTPCMD)
MONMSG MSGID(CPF0000)
CRTSRCPF FILE(QTEMP/FTPCMD) MBR(FTP)
/********************************************************************/
/* Build the FTP script */
/********************************************************************/
OVRDBF FILE(FTPCMD) TOFILE(QTEMP/FTPCMD) MBR(FTP)
CALL PGM(FTPFILER) PARM(&USR &PWD &FUNCTION +
&LCLFIL &RMTFIL &CMD1 &CMD2 &CMD3)
/********************************************************************/
/* Delete/Create the FTP transfer log file */
/********************************************************************/
DLTF FILE(QTEMP/FTPLOG)
MONMSG MSGID(CPF0000)
CRTPF FILE(QTEMP/FTPLOG) RCDLEN(132) MBR(FTPLOG)
/********************************************************************/
/* Execute FTP transfer */
/********************************************************************/
OVRDBF FILE(INPUT) TOFILE(QTEMP/FTPCMD) MBR(FTP)
OVRDBF FILE(OUTPUT) TOFILE(QTEMP/FTPLOG) MBR(FTPLOG)
STRTCPFTP RMTSYS(&TGTSYS)
DLTOVR FILE(*ALL)
/********************************************************************/
/* Check FTP transfer log file to find out if the transfer was */
/* successful */
/********************************************************************/
CALL PGM(FTPCHECKR) PARM(&OKCODE)
IF COND(&OKCODE *EQ 'YES') THEN(CHGVAR +
VAR(&SUCCES) VALUE(&ON))
ELSE
CHGVAR VAR(&MSG) VALUE('ORS Job did not complete ' +
*CAT &JOB *CAT ' Warning - Next file run +
will replace existing file, check with +
vendor to confirm file status.')
SNDPGMMSG MSG(&MSG) TOUSR(QSYSOPR) MSGTYPE(*INFO)
MONMSG MSGID(CPF0000)
ENDPGM
END: ENDPGM
F/SPACE 3
F*****************************************************************
* * X ANDNEF
* INDICATOR USAGE *
* *
* IND. DESCRIPTION *
* *
* LR - CLOSE FILES ON EXIT *
* *
F*****************************************************************
F/EJECT
F*****************************************************************
*FILES USED BY THIS PROGRAM
F*****************************************************************
FFTPLOG IF F 132 DISK
D/EJECT
*****************************************************************
* DATA STRUCTURES USED BY THIS PROGRAM
*****************************************************************
**
**
*
EURD FileXfer C Const('File Transfer')
*
** Define input record format
EURD LogRec DS 132
EURD ReplyCode 1 3
EURD ExtraInfo 5 17
C/EJECT
******************************************************************
* VARIABLE DEFINITIONS AND LISTS USED BY THIS PROGRAM *
*****************************************************************
*
* DEFINE PARAMETER LIST
*
C *ENTRY PLIST
C PARM OK 3 REMOTE USER ID
********************************************************************
* THE MAIN PROGRAM
********************************************************************
C MOVE 'NOT' OK LOCAL FILE NAME
C *IN99 DOWEQ *OFF REMOTE FILE NAM
C READ FTPLOG LOGREC 99
C *IN99 IFEQ *OFF OPT CMD 2
C SELECT
* *
** * Remote system was something else than an AS/400 or any other that
** * uses 250 as a response
* *
C ReplyCode WHENEQ '226' OPT CMD 2
C MOVE 'YES' OK
C LEAVE
* * Remote system was an AS/400 or any other that uses 250 as a resp
C ReplyCode WHENEQ '250'
C ExtraInfo ANDEQ FileXfer
C MOVE 'YES' OK
C LEAVE
* *
C ENDSL
C ENDIF
C ENDDO
* *
C EVAL *INLR = *ON
C RETURN
C/EJECT
*
C EVAL *INLR =*ON
*
C/EJECT
F/SPACE 3
F*****************************************************************
* * X ANDNEF
* INDICATOR USAGE *
* *
* IND. DESCRIPTION *
* *
* LR - CLOSE FILES ON EXIT *
* *
F*****************************************************************
F/EJECT
F*****************************************************************
*FILES USED BY THIS PROGRAM
F*****************************************************************
FFTPCMD O F 92 DISK
D/EJECT
*****************************************************************
* DATA STRUCTURES USED BY THIS PROGRAM
*****************************************************************
D/SPACE 2
*
* SOURCE FILE RECORD FORMAT
*
EURD CMDREC DS
EURD SRCSEQ 1 6 2
EURD SRCDAT 7 12 0
EURD SRCDTA 13 92
C/EJECT
******************************************************************
* VARIABLE DEFINITIONS AND LISTS USED BY THIS PROGRAM *
*****************************************************************
*
* DEFINE PARAMETER LIST
*
C *ENTRY PLIST
C PARM RMTUSR 10 REMOTE USER ID
C PARM RMTPWD 30 OTE PASSWORD
C PARM FUNCTION 1 FUNCTION TO EXC
* POSSIBLE VALUES: P = PUT
* G = GET
C PARM LCLFIL 50 LOCAL FILE NAME
* (FULLY QUALIFIED)
C PARM RMTFIL 50 REMOTE FILE NAM
* (FULLY QUALIFIED)
C PARM CMD1 20 OPT CMD 1
C PARM CMD2 20 OPT CMD 2
C PARM CMD3 20 OPT CMD 3
C/EJECT
*
*
********************************************************************
* THE MAIN PROGRAM
********************************************************************
C EXSR CF001
*
C EVAL *INLR =*ON
*
C/EJECT
********************************************************************
* S U B R O U T I N E S *
********************************************************************
* MAIN PROCESSING *
********************************************************************
C CF001 BEGSR
C Z-ADD *ZERO SEQ 6 2
C EXSR CF002
C EXSR CF003
*
C EXSR CF004
C EXSR CF005
*
C ENDSR
C/EJECT
******************************************************************
* BUILD AND WRITE USER ID AND PASSWORD RECORD *
******************************************************************
C CF002 BEGSR
*
C Z-ADD *ZERO SRCDAT
C ADD 1 SEQ
C Z-ADD SEQ SRCSEQ
C RMTUSR CAT(P) RMTPWD:1 SRCDTA
C WRITE FTPCMD CMDREC
*
C ENDSR
C/EJECT
******************************************************************
* WRITE OPTIONAL FTP COMMAND RECORDS *
******************************************************************
C CF003 BEGSR
*
C CMD1 IFNE *BLANK
C Z-ADD *ZERO SRCDAT
C ADD 1 SEQ
C Z-ADD SEQ SRCSEQ
C MOVEL(P) CMD1 SRCDTA
C WRITE FTPCMD CMDREC
C ENDIF
*
C CMD2 IFNE *BLANK
C Z-ADD *ZERO SRCDAT
C ADD 1 SEQ
C Z-ADD SEQ SRCSEQ
C MOVEL(P) CMD2 SRCDTA
C WRITE FTPCMD CMDREC
C ENDIF
*
*
C CMD3 IFNE *BLANK
C Z-ADD *ZERO SRCDAT
C ADD 1 SEQ
C Z-ADD SEQ SRCSEQ
C MOVEL(P) CMD3 SRCDTA
C WRITE FTPCMD CMDREC
C ENDIF
*
C ENDSR
C/EJECT
******************************************************************
* BUILD AND WRITE PUT/GET COMMAND RECORD *
******************************************************************
C CF004 BEGSR
*
C Z-ADD *ZERO SRCDAT
C ADD 1 SEQ
C Z-ADD SEQ SRCSEQ
*
C SELECT
C FUNCTION WHENEQ 'P' PUT FUNCTION
C 'PUT' CAT(P) LCLFIL:1 SRCDTA
C SRCDTA CAT(P) RMTFIL:1 SRCDTA
C WRITE FTPCMD CMDREC
*
*
C FUNCTION WHENEQ 'G'
C 'GET' CAT(P) RMTFIL:1 SRCDTA
C SRCDTA CAT(P) LCLFIL:1 SRCDTA
C SRCDTA CAT(P) '(REPLACE':1 SRCDTA
*
C WRITE FTPCMD CMDREC
C ENDSL
*
C ENDSR
C/EJECT
*
******************************************************************
* BUILD AND WRITE Quit RECORD *
******************************************************************
C CF005 BEGSR
*
C Z-ADD *ZERO SRCDAT
C ADD 1 SEQ
C Z-ADD SEQ SRCSEQ
C MOVEL(P) 'QUIT' SRCDTA
C WRITE FTPCMD CMDREC
*
C ENDSR