Successful FTP Code

["Terry Glass" <tglass@xxxxxxxxxxx>]

For those who requested the code to check for a successful FTP-here it is. 
I can't take credit, Carl Galgano and Cathy Wilbur supplied most of the
bits and pieces.   This code runs on 3 different systems, and I trap the
output log so it can be referred to if necessary.  In this case, we're
going from an AS400 to a PC-based imaging system.

Part 1-FTP TEXT
ID PASWORD
ASCII
PUT LIB/FILE1 '''PC FILE'''
QUIT

Part 2-CL program
             PGM

             DCL        VAR(&SYSNAM) TYPE(*CHAR) LEN(8)
             DCL        VAR(&MEMBER) TYPE(*CHAR) LEN(10)

             DCLF       FILE(QTEMP/FTPLOG)

/* Create temp file to capture FTP log                              */
             CRTPF      FILE(QTEMP/FTPLOG) RCDLEN(132)
             MONMSG     MSGID(CPF0000) EXEC(CLRPFM FILE(QTEMP/FTPLOG))

/* Get system name & determine which FTP source to use              */
             RTVNETA    SYSNAME(&SYSNAM)

             IF         COND(&SYSNAM *EQ 'SYSTEM 1') THEN(DO)
             CHGVAR     VAR(&MEMBER) VALUE('IMGSYS1')
             ENDDO
             IF         COND(&SYSNAM *EQ 'SYSTEM 2') THEN(DO)
             CHGVAR     VAR(&MEMBER) VALUE('IMGSYS2')
             ENDDO
             IF         COND(&SYSNAM *EQ 'SYSTEM 3') THEN(DO)
             CHGVAR     VAR(&MEMBER) VALUE('IMGSYS3')
             ENDDO


/* Override files, then perform FTP                                 */
             OVRDBF     FILE(INPUT) TOFILE(LIB/FTPSRC) MBR(&MEMBER)
             OVRDBF     FILE(OUTPUT) TOFILE(QTEMP/FTPLOG)

             STRTCPFTP  RMTSYS(PCIMGSRVR)

/* Trap FTP log in case it may be needed                            */
             CPYF       FROMFILE(QTEMP/FTPLOG) TOFILE(LIB/FTPLOG) +
                          MBROPT(*REPLACE) CRTFILE(*NO) FMTOPT(*NOCHK)

/* Scan FTPLOG, if SUCCESSFUL TRANSFER (226) found, clear FILE1;    */
/* else send operator message to check FTP status                   */
 RCVF:       RCVF
             MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
             IF         COND(%SST(&FTPLOG 1 3) *EQ '226') THEN(DO)
             CLRPFM     FILE(LIB/FILE1)
             SNDPGMMSG  MSG('FTP transfer of BL data to Imaging +
                          completed successfully') TOUSR(*SYSOPR)
             GOTO       CMDLBL(DONE)
             ENDDO
             ELSE       CMD(DO)
             GOTO       CMDLBL(RCVF)
             ENDDO

 ERROR:      SNDPGMMSG  MSG('FTP transfer of BL data to Imaging did +
                          NOT complete successfully.  Please verify +
                          that FTP is working both at this location +
                          and at the corporate Imaging system +
                          before retrying.  Please reply with your +
                          User ID now.') TOUSR(*SYSOPR) MSGTYPE(*INQ)

 DONE:       DLTOVR     FILE(INPUT)
                  DLTOVR     FILE(OUTPUT)

             ENDPGM

The code could probably be shorter, but it works.


Terry L. Glass               tglass@netpath.net
Graham, NC
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* This is the Midrange System Mailing List!  To submit a new message,   *
* send your mail to "MIDRANGE-L@midrange.com".  To unsubscribe from     *
* this list send email to MAJORDOMO@midrange.com and specify            *
* 'unsubscribe MIDRANGE-L' in the body of your message.  Questions      *
* should be directed to the list owner / operator: david@midrange.com   *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *