CL Program for FTP
CL can manage an FTP session.
Scripted FTP operation
The example below shows a scripted FTP process. Since FTP operates with a standard input file and standard output file, the CL program is used to override (OVRDBF) to a pre-defined script file. In this case the file is a source physical file. The output is also overridden to generate a log file of the FTP output. This can serve as a diagnostic print of the session. Recording the transmission allows a review of the bytes transmitted and wheter there were any errors noted.
/*********************************************************************/
/* Program Name - FTP810CL */
/* */
/* Function - This program was designed to push invoice data to */
/* the FTP server. */
/* */
/* Programmer - Steve Croy xx/xx/xxxx */
/*********************************************************************/
/*********************************************************************/
/* Modification log */
/* */
/* Date Programmer Description */
/*********************************************************************/
PGM PARM(&INT &COMP &DATE &INTYP)
DCL VAR(&JOBTYPE) TYPE(*CHAR) LEN(1)
DCL VAR(&INT) TYPE(*CHAR) LEN(1)
DCL VAR(&PRE) TYPE(*CHAR) LEN(12)
DCL VAR(&ARCSTMF) TYPE(*CHAR) LEN(50)
DCL VAR(&TOSTMF) TYPE(*CHAR) LEN(50)
DCL VAR(&ARCFOLDER) TYPE(*CHAR) LEN(50)
DCL VAR(&EXPFOLDER) TYPE(*CHAR) LEN(50)
DCL VAR(&RCD) TYPE(*DEC) LEN(10 0)
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&PGMNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&PROGRAM) TYPE(*CHAR) LEN(10)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)
DCL VAR(&RETURN) TYPE(*CHAR) LEN(128)
DCL VAR(&CLIENT) TYPE(*CHAR) LEN(10)
DCL VAR(&SCRIPT) TYPE(*CHAR) LEN(10)
DCL VAR(&CLCODE) TYPE(*CHAR) LEN(4)
DCL VAR(&COMP) TYPE(*CHAR) LEN(2)
DCL VAR(&DATE) TYPE(*DEC) LEN(8 0)
DCL VAR(&FILE) TYPE(*CHAR) LEN(12)
DCL VAR(&ARCDATA) TYPE(*CHAR) LEN(10)
DCL VAR(&ARCSEQ) TYPE(*DEC) LEN(8 0)
DCL VAR(&ARCSEQA) TYPE(*CHAR) LEN(8)
DCL VAR(&ARCCODE) TYPE(*CHAR) LEN(2)
DCL VAR(&ARCDOC) TYPE(*CHAR) LEN(14)
DCL VAR(&INTYP) TYPE(*CHAR) LEN(1)
/*-------------------------------------------------------------------*/
/* If the job is NOT to operate interactively make sure it is a */
/* submitted job and does not run interactively. If the job is not */
/* to be submitted it may execute interactively. */
/*-------------------------------------------------------------------*/
GETJOB:
RTVJOBA TYPE(&JOBTYPE)
IF COND(&JOBTYPE *EQ '1' *AND &INT *EQ '0') +
THEN(DO)
SBMJOB CMD(CALL PGM(FTP810CL) PARM(&INT &COMP &DATE +
&INTYP)) JOB(FTP_INVOIC)
GOTO CMDLBL(EXIT)
ENDDO
/*-------------------------------------------------------------------*/
/* Get the program name--used to retrieve variables */
/*-------------------------------------------------------------------*/
GETPGM:
SNDPGMMSG MSG(' ') TOPGMQ(*SAME) MSGTYPE(*INFO) +
KEYVAR(&MSGKEY)
RCVMSG PGMQ(*SAME) MSGTYPE(*INFO) RMV(*YES) +
SENDER(&SENDER)
CHGVAR VAR(&PGMNAME) VALUE(%SST(&SENDER 56 10))
/*-------------------------------------------------------------------*/
/* Get the client code--the client code associated with the company */
/* being processed. */
/*-------------------------------------------------------------------*/
CLIENT:
CHGVAR VAR(&CLIENT) VALUE('CLC' *TCAT &COMP)
CALL PGM(ADM005RP) PARM(&PGMNAME &CLIENT +
&RETURN)
CHGVAR VAR(&CLCODE) VALUE(%SST(&RETURN 1 4))
/*-------------------------------------------------------------------*/
/* Create work files in QTEMP */
/*-------------------------------------------------------------------*/
BUILD:
DLTF FILE(QTEMP/FTP256PF)
MONMSG MSGID(CPF0000)
CPYF FROMFILE(FTP256PF) TOFILE(QTEMP/FTP256PF) +
MBROPT(*REPLACE) CRTFILE(*YES)
INVWORK:
DLTF FILE(QTEMP/FTP810WF)
MONMSG MSGID(CPF0000)
CPYF FROMFILE(FTP810WF) TOFILE(QTEMP/FTP810WF) +
MBROPT(*REPLACE) CRTFILE(*YES)
CLRPFM FILE(QTEMP/FTP256PF)
CLRPFM FILE(QTEMP/FTP810WF)
/*-------------------------------------------------------------------*/
/* Override program files to files in QTEMP. If customer invoices */
/* were requested (C) call FTP810RP to build invoice files. If parts */
/* invoices were requested (R) call FTP811RP to build the files. */
/*-------------------------------------------------------------------*/
CALLPGM:
OVRDBF FILE(FTP256PF) TOFILE(QTEMP/FTP256PF)
OVRDBF FILE(FTP810WF) TOFILE(QTEMP/FTP810WF)
CLRPFM EDP915
CLRPFM FTP256PF
CLRPFM FILE(INVCOMPF)
IF COND(&INTYP *EQ 'C') THEN(CALL PGM(FTP810RP) +
PARM(&DATE &COMP))
IF COND(&INTYP *EQ 'R') THEN(CALL PGM(FTP811RP) +
PARM(&DATE &COMP))
/*-------------------------------------------------------------------*/
/* Check to see if any credit order were created to send to server */
/* If a file was created, archive the file, FTP the file to remote: */
/* send the work file (FTP810WF) */
/*-------------------------------------------------------------------*/
SENDFILE:
RTVMBRD FILE(FTP256PF) NBRCURRCD(&RCD)
/*-------------------------------------------------------------------*/
/* Get the export folder name, then create the transmission file */
/* name from the prefix, client code, and the file extension. */
/*-------------------------------------------------------------------*/
EXPORT:
IF COND(&RCD *GT 2) THEN(DO)
CALL PGM(ADM005RP) PARM(&PGMNAME 'EXPORT' +
&EXPFOLDER)
CHGVAR VAR(&FILE) VALUE('in' *TCAT &CLCODE *TCAT +
'.txt')
CHGVAR VAR(&TOSTMF) VALUE(&EXPFOLDER *TCAT '/' +
*TCAT &FILE)
/*-------------------------------------------------------------------*/
/* Get the archive folder name, then retreive the credit request */
/* data area to create a unique name for the text file in archive. */
/*-------------------------------------------------------------------*/
ARCHIVE:
CALL PGM(ADM005RP) PARM(&PGMNAME 'ARCHIVE' +
&ARCFOLDER)
RTVDTAARA DTAARA(FTPINVDA) RTNVAR(&ARCDATA)
CHGVAR VAR(&ARCCODE) VALUE(%SST(&ARCDATA 1 2))
CHGVAR VAR(&ARCSEQA) VALUE(%SST(&ARCDATA 3 8))
CHGVAR VAR(&ARCSEQ) VALUE(&ARCSEQA)
CHGVAR VAR(&ARCSEQ) VALUE(&ARCSEQ + 1)
CHGVAR VAR(&ARCSEQA) VALUE(&ARCSEQ)
CHGDTAARA DTAARA(FTPINVDA (3 8)) VALUE(&ARCSEQA)
CHGVAR VAR(&ARCDOC) VALUE(&ARCCODE *TCAT &ARCSEQA +
*TCAT '.txt')
CPYTOSTMF +
FROMMBR('/qsys.lib/qtemp.lib/ftp256pf.file/+
ftp256pf.mbr') TOSTMF(&TOSTMF) +
STMFOPT(*REPLACE) STMFCODPAG(*PCASCII)
CHGVAR VAR(&SCRIPT) VALUE('FTP810' *TCAT &COMP)
OVRDBF FILE(INPUT) TOFILE(QFTPSRC) MBR(&SCRIPT)
OVRDBF FILE(OUTPUT) TOFILE(QFTPSRC) MBR(FTP810LG)
FTPFILE: FTP RMTSYS(LOOPBACK)
COPY OBJ(&TOSTMF) TOOBJ(&ARCDOC)
MOV OBJ(&ARCDOC) TODIR(&ARCFOLDER)
DEL OBJLNK(&TOSTMF)
/*-------------------------------------------------------------------*/
/* Send the work file from the Credit Request build program. */
/*-------------------------------------------------------------------*/
EMAIL:
CALL PGM(UT003R) PARM(&PGMNAME)
ENDDO
DLTOVR FILE(*ALL)
EXIT:
RETURN
ENDPGM