HLPID(*CMD) HLPPNLGRP(FTPSNDFILE)
/**********************************************/
/* Command processing program is FTPSNDFILE */
/*--------------------------------------------*/
/* REQUIREMENTS: FTP server must be active. */
/* The FTP source file for */
/* the generated FTP script */
/* must exist, but the member */
/* is automatically added. */
/**********************************************/
IP: PARM KWD(RMTSYS) TYPE(*CHAR) LEN(128) MIN(1) +
EXPR(*YES) PROMPT('Remote IP or FTP server')
FROMFILE: PARM KWD(FILE) TYPE(QUAL1) MIN(1) PROMPT('Local +
file')
PARM KWD(MBR) TYPE(*GENERIC) LEN(10) DFT(*FIRST) +
SPCVAL((*FILE) (*FIRST) (*LAST) (*ALL)) +
EXPR(*YES) PROMPT('Local member')
QUAL1: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL)) +
EXPR(*YES) PROMPT('Library')
TOFILE: PARM KWD(TOFILE) TYPE(QUAL2) PROMPT('Remote file')
TOMBR: PARM KWD(TOMBR) TYPE(*NAME) LEN(10) DFT(*FROMMBR) +
SPCVAL((*FROMMBR) (*TOFILE)) EXPR(*YES) +
PROMPT('Remote member')
QUAL2: QUAL TYPE(*NAME) LEN(10) DFT(*FROMFILE) +
SPCVAL((*FROMFILE)) EXPR(*YES)
QUAL TYPE(*NAME) DFT(*FROMLIB) SPCVAL((*FROMLIB)) +
EXPR(*YES) PROMPT('Library')
REPLACE: PARM KWD(REPLACE) TYPE(*LGL) LEN(1) RSTD(*YES) +
DFT(*YES) SPCVAL((*YES '1') (*NO '0')) +
EXPR(*YES) PROMPT('Replace data on remote +
system')
USER: PARM KWD(USER) TYPE(*CHAR) LEN(64) DFT(*CURRENT) +
SPCVAL((*CURRENT)) EXPR(*YES) +
PROMPT('Remote FTP User ID')
PWD: PARM KWD(PWD) TYPE(*CHAR) LEN(64) DFT(*USERID) +
EXPR(*YES) DSPINPUT(*PROMPT) +
PROMPT('Remote FTP Password')
MODE: PARM KWD(MODE) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*BINARY) SPCVAL((*BINARY BINARY) +
(*TEXT ASCII) (BINARY) (ASCII) (TEXT +
ASCII)) EXPR(*YES) PROMPT('Transfer mode')
SRCFILE: PARM KWD(SRCFILE) TYPE(QUAL3) PROMPT('Src file +
to receive FTP script')
PARM KWD(SRCMBR) TYPE(*NAME) LEN(10) +
DFT(*FROMMBR) SPCVAL((*FROMMBR) (*GEN)) +
EXPR(*YES) PROMPT('Script source member')
QUAL3: QUAL TYPE(*NAME) LEN(10) DFT(QFTPSRC) EXPR(*YES)
QUAL TYPE(*NAME) DFT(QTEMP) SPCVAL((*LIBL)) +
EXPR(*YES) PROMPT('Library')
/*************************************************************/
/** The LOG member can be a source file or database file. */
/** A record length of 79 greater is required. */
/** If the log file does not exist, it is created for you. */
/*************************************************************/
LOG: PARM KWD(LOG) TYPE(QUAL4) DFT(*STDOUT) +
SNGVAL((*STDOUT) (*STDIO *STDOUT) +
(*SRCFILE) (*NONE)) PROMPT('FTP log file')
PARM KWD(LOGMBR) TYPE(*NAME) LEN(10) +
DFT(*FROMMBR) SPCVAL((*FROMMBR) (*SRCMBR +
*SCRIPT) (*SCRIPT)) EXPR(*YES) +
PROMPT('Log member')
QUAL4: QUAL TYPE(*NAME) LEN(10) SPCVAL((QFTPLOG)) +
EXPR(*YES)
QUAL TYPE(*NAME) DFT(QTEMP) SPCVAL((*LIBL)) +
EXPR(*YES) PROMPT('Library')
/* The follow parameter is ignored when LOG(*STDIO) is specified. */
DSPFTPLOG: PARM KWD(DSPLOG) TYPE(*LGL) RSTD(*YES) DFT(*YES) +
SPCVAL((*YES '1') (*NO '0')) EXPR(*YES) +
PROMPT('Display FTP transfer log')
The FTPSNDFILE command can be compiled with the following CL command:
CRTCMD CMD(FTPSNDFILE) PGM(FTPSNDFILE) HLPPNLGRP(FTPSNDFILE) HLPID(*CMD)
FTPSNDFILE RPG IV Command Processing Program
The source code for FTPSNDFILE.RPGLE is listed below. It can be cut/pasted into WDSc or RDi. It's a bit lengthy to cut/paste into SEU, however. Note the original copyright date is 2005 (the year I wrote this command). But I have updated it recently to enable the REPLACE parameter (it now uses APPEND instead of PUT if REPLACE(*NO) is specified) and to convert the entire source member to free format; although, I have to admit, I just used WDSc's "Right-click-Convert Selection to Free-Form" option to do that.
Unlike the Command Definition, the RPG IV source can be compiled directly with PDM option 14, no prompting necessary, although you may want to prompt to add the DBGVIEW(*SOURCE) parameter. (I still don't understand why DBGVIEW isn't allowed on the Header spec.)
Other recent updates include the removal of all pre-V5R1 code. Previously, I had used compiler directives /IF DEFINE(*V5R1M0) to verify that you were compiling at V5R1 or later and, if so, I used qualified data structures, and the EXTFILE keyword. If not, I used pre-V5 syntax. Removing this does two things: (1) makes the code easier to read and feels less cluttered, and (2) restricts it to i5/OS version 5 release 1 and later. So if you're a Version 4 shop, you can't use this. Here's the full source code.
H BNDDIR('QC2LE') OPTION(*NODEBUGIO:*SRCSTMT)
H DFTACTGRP(*NO) ACTGRP(*NEW)
H Copyright('(c) 2005 - Robert Cozzi, Jr.')
**************************************************************
** FTPSNDFILE - (c) 2005-2008 Robert Cozzi, Jr.
** All rights reserved. Used by permission.
** Software is provided "as is" for illustrative/example
** purposes only. No warranty is expressed or implied and
** none is given.
** Permission to reference in other software is granted
** with the following conditions:
** (1) No money is charged or exchanged for this component.
** (2) This notice along with the copyright notification is
** remains in any distribution of this software.
** (3) The right to reproduce this software for publication
** purposes is expressly denied. Instead, please reference
** the original source code via a URL link.
**************************************************************
** **
**************************************************************
** This source is set up to run on OS/400 V5R1 and later.
**
** To Compile this source member, you must first create
** a source file name QFTPSRC with a record length
** of at least 150 bytes, as follows:
**
** CRTSRCPF QGPL/QFTPSRC RCDLEN(150)
**
** USAGE NOTES: This source file receives the FTP scripts
** that are generated by the program.
**************************************************************
FQFTPSRC UF A E DISK USROPN RENAME(QFTPSRC:FTPSRCREC)
F EXTFILE(szFTPSRC) EXTMBR(script.Mbr)
** Input parameter list.
** Although not strictly required, this program is
** normally called as the CPP of a command definition.
** These parameters are set up for such a call.
D FtpSndFile PR
D RemoteIP 128A
D LocalFile LikeDS(QualObj)
D LocalMbr 10A
D RemoteFile LikeDS(QualObj)
D RemoteMbr 10A
D bReplace 1N
D RemoteUser 64A
D RemotePWD 64A
D TransferMode 10A
D ftpSrcFile LikeDS(QualObj)
D ftpSrcMbr 10A
D ftplogFile LikeDS(QualObj)
D ftplogMbr 10A
D bFtpDspLog 1N
D FtpSndFile PI
D RemoteIP 128A
D LocalFile LikeDS(QualObj)
D LocalMbr 10A
D RemoteFile LikeDS(QualObj)
D RemoteMbr 10A
D bReplace 1N
D RemoteUser 64A
D RemotePWD 64A
D TransferMode 10A
D ftpSrcFile LikeDS(QualObj)
D ftpSrcMbr 10A
D ftplogFile LikeDS(QualObj)
D ftplogMbr 10A
D bFtpDspLog 1N
** This /INCLUDEs (or /COPYs) are required.
** If you do not have QSYSINC library installed
** on your system, the program will not compile.
** QSYSINC is a free library from IBM included
** with your OS/400 installation.
** Also, even though SEU does not recognize /INCLUDE
** directives, they will compile on OS/400 V4.5 and later.
/INCLUDE QSYSINC/QRPGLESRC,QUSRMBRD
/INCLUDE QSYSINC/QRPGLESRC,QUSROBJD
/INCLUDE QSYSINC/QRPGLESRC,QUSEC
** Normally, you would call the RPG xTools
** http://www.rpgxtools.com/
** to remove an unwanted info/diag message.
** To keep this routine independent of 3rd-party
** software, I call the QMHRMVPM API.
**********************************************************
** Remove Message from Program Queue API
**********************************************************
D QmhRmvPM PR ExtPgm('QMHRMVPM')
D CallStackEntry 64A Const OPTIONS(*VARSIZE)
D CallStackCount 10I 0 Const
D MsgKey 4A Const
D MsgToRemove 10A Const
D ApiErrorDS LikeDS(QUSEC)
** Retrieve member description
D QRtvMbrD PR ExtPgm('QUSRMBRD')
D szRecvBuffer 32766A Options(*VARSIZE)
D nLenRecvBuf 10I 0 Const
D Format 8A Const
D FileName 20A Const
D MbrName 10A Const
D bOvrProc 1A Const
D apierror LikeDS(QUSEC) OPTIONS(*NOPASS)
D bFindMbr 1A Const OPTIONS(*NOPASS)
** The OS/400 QUSROBJD API is used to get the library
** name for an unqualified object. For example:
** *LIBL/MYOBJ could be returned with QGPL as the
** name of the library containing the object.
D QRtvObjD PR ExtPgm('QUSROBJD')
D rtnData 32766A OPTIONS(*VARSIZE)
D nRtnDataLen 10I 0 Const
D Format 8A Const
D QualObj 20A Const
D ObjType 10A Const
D apierror LikeDS(QUSEC)
** The C runtime function is used to run CL commands.
** We use it in this program to run FTP "commands".
D system PR 10I 0 extProc('system')
D szCmd * Value OPTIONS(*STRING)
** Normally, the RPG xTools WrtJobLog()
** subprocedure is used to write to the joblog.
** But we call the OS/400 Unix-API Qp0zLprintF()
** to accomplish similar results.
D Qp0zLprintf PR 10I 0 extProc('Qp0zLprintf')
D szOutputString...
D * Value OPTIONS(*STRING)
D * Value OPTIONS(*STRING:*NOPASS)
D * Value OPTIONS(*STRING:*NOPASS)
** JobLog() is a wrapper for the Qp0zLprintf() Unix-API.
D JobLog PR
D szMsg 1024A Const VARYING
** If we're using V5.1 or later, then declare the
** data structures used by the APIs as Qualified
** data structures based on data structure templates.
** Otherwise, use the LIKE keyword to create
** large field names that are moved back and forth
** between the QSYSINC DS and the fields.
D MbrDesc DS LikeDS(QUSM0100)
D ObjDesc DS LikeDS(QUSD0100)
D APIError DS LikeDS(QUSEC)
D PSDS SDS
D JobName 10A Overlay(PSDS:244)
D USRPRF 10A Overlay(PSDS:254)
D JobNbr 6A Overlay(PSDS:264)
** Defaults and Constants
D DFTFTPSrc C Const('QTEMP/QFTPSRC')
D DFTFTPSrcMbr C Const('*')
D APPEND C Const('APPEND')
D REPLACE C Const('(Replace')
D GENERICMBR C Const('GENERIC')
D szFTPSrc S 21A Inz(dftFTPSRC)
D szFTPLog S 21A Inz('QTEMP/QFTPLOG')
D bNoLog S 1N Inz(*OFF)
D bDspLog S 1N Inz(*OFF)
D bAppend S 1N Inz(*OFF)
D szReplace S 10A Varying
D bGeneric S 1N Inz(*OFF)
D QualObj DS Based(null_T) Qualified
D obj 10A
D lib 10A
D object 10A Overlay(obj)
D file 10A Overlay(obj)
D name 10A Overlay(obj)
D program 10A Overlay(obj)
D library 10A Overlay(lib)
D QualFLM DS Based(null_T) Qualified
D file 10A
D lib 10A
D mbr 10A
D name 10A Overlay(file)
D library 10A Overlay(lib)
D member 10A Overlay(mbr)
** Local OS/400 library/file/member name
D Lcl DS LikeDS(qualFLM)
** Remote OS/400 library/file/member name
D Rmt DS LikeDS(QualFLM)
** Remote IP or domain name, user ID and password
** (remote_Location)
D RmtLoc DS Qualified
D IP 128A
D User 64A
D PWD 64A
** FTP Script Source file, library and member name.
D script DS LikeDS(qualFLM)
** FTP logging source file, library and member name.
D Log DS LikeDS(qualFLM)
** Transfer mode BINARY | ASCII
D TFRMode S 10A Inz('BINARY')
** Long variables to hold CL and FTP command strings.
D szScriptFile S 128A Varying
D szLogFile S 128A Varying
D szSndFile S 128A Varying
D szRmtFile S 128A Varying
D ovrFTPSrc S 128A Varying
D ovrFTPLog S 128A Varying
D szOvrdbf S 128A Varying
** ADDPFM is used to add/clear source file
** members in the FTP script source file.
D ADDPFM S 256A Varying
D ftpCmd S 256A Varying
** 8 "digit" date in character format
D YYMD S 8A
** RPGIV-version of "UDATE"; a true date data-type
** initialized to "today" (the system date).
D today S D Inz(*SYS) DATFMT(*ISO)
** Remove "Buffer Overflow" msg when opening Source files
** These can be annoying to the end-user.
D CallStkE s 32A
D CallStkCnt s 10I 0
D MsgKey s 4A
D MsgToRmv s 10A
D MsgAPIErr s Inz(*ALLX'00') LIKE(QUSEC)
** End Reove "Buffer Overflow" msg
C eval *INLR = *ON
//* NOTE: Parms are expected to be passed in through a
//* CL command interface. They are declared on the
//* "procedure" interface statements.
/FREE
if %Parms >= 1;
RmtLoc.IP = RemoteIP;
endif;
if %Parms >= 2;
Lcl.File = LocalFile.File;
Lcl.Lib = LocalFile.Lib;
endif;
if %Parms >= 3;
lcl.Mbr = LocalMbr;
endif;
if %Parms >= 4;
Rmt.File = RemoteFile.File;
Rmt.Lib = RemoteFile.Lib;
endif;
if %Parms >= 5;
Rmt.Mbr = RemoteMbr;
endif;
//* Replace(*YES|*NO)
if %Parms >= 6;
bAppend = NOT bReplace;
endif;
if %Parms >= 7;
RmtLoc.User = RemoteUser;
endif;
if %Parms >= 8;
if %subst(RemotePWD:1:3) = '*US';
RmtLoc.PWD = RmtLoc.User;
else;
RmtLoc.PWD = RemotePwd;
endif;
endif;
if %Parms >= 9;
tfrMode = TransferMode;
endif;
//* Build qualified FTP Script source file and library name
if %Parms >= 10;
script.name = ftpsrcfile.name;
script.lib = ftpSrcfile.lib;
szScriptFile = %TrimR(script.Lib)
+ '/' +
%TrimR(script.file);
endif;
if %Parms >= 11;
script.Mbr = ftpSrcMbr;
endif;
//* FTP log file and library name
if %Parms >= 12;
if ftpLogFile.name = *BLANKS
or ftpLogFile.name = '*NONE'
or ftpLogFile.name = '*STDIO';
bNoLog = *ON;
else;
bNoLog = *OFF;
endif;
//* If FTPLOG(*SRCFILE | *SCRIPT) is specified, then use the same
//* file and library name as the script file, otherwise
//* use the specific FTPLOGFILE value
if %subst(ftpLogFile:1:4) = '*SRC' or
%subst(ftpLogFile:1:4) = '*SCR';
Log.name = Script.name;
Log.lib = Script.lib;
else;
Log.name = ftpLogFile.name;
Log.Lib = ftplogFile.Lib;
endif;
szFTPLog = %TrimR(Log.lib)
+ '/' +
%TrimR(Log.file);
endif;
if %Parms >= 13 and bNoLog = *OFF;
Log.Mbr = ftpLogMbr;
endif;
//* Display FTP log after FTP Send finishes?
//* NOTE: DSPLOG(*STDIO) causes the internal FTP
//* standard output log to be displayed.
if %Parms >= 14;
if bFtpDspLog = *OFF
or ftpLogFile.name = '*NONE'
or ftpLogFile.name = *BLANKS
or ftpLogFile.name = '*STDIO';
bDspLog = *OFF;
else;
bDspLog = *ON;
endif;
endif;
//* If no send file member name is specified, use the
//* send file's name as the member name.
if lcl.Mbr = *Blanks or lcl.Mbr = '*FILE';
lcl.Mbr = lcl.File;
endif;
//* If the member name is *ALL, *FIRST or *LAST, then
//* translate that value to the real member name.
//* This is done by calling the QUSRMBRD API.
if lcl.Mbr = '*ALL';
lcl.Mbr = '*';
endif;
if lcl.Mbr = '*FIRST'
or lcl.Mbr = '*LAST';
clear MbrDesc;
clear ApiError;
ApiError.QUSBPRV = %size(ApiError);
//* Get the member description, and hence, the real member name.
//* (i.e., convert *LAST or *FIRST into a real member name).
QRtvMbrD(MbrDesc:%size(mbrDesc):
'MBRD0100': lcl : lcl.mbr :
'0': ApiError);
//* Everything go okay?
//* then extract the real member name.
if ApiError.QUSBAVL = 0;
lcl.Mbr = MbrDesc.QUSMN02;
else;
//* If the RTVMBRD failed, use the file name as the member name.
lcl.Mbr = lcl.File;
endif;
endif;
//* If *LIBL or blanks is used for the library name,
//* on the Local File, then use QUSROBJD to find the real
//* library name.
if Lcl.Lib = *Blanks or
%subst(Lcl.Lib:1:1) = '*';
clear ObjDesc;
clear ApiError;
ApiError.QUSBPRV = %size(ApiError);
//* Call QUSROBJD to get the library name of the file being sent.
QRtvObjD(ObjDesc : %size(ObjDesc) :
'OBJD0100': lcl : '*FILE':
apiError);
if ApiError.QUSBAVL = 0;
if ObjDesc.QUSRL01 <> *BLANKS;
lcl.Lib = %TrimR(ObjDesc.QUSRL01);
endif;
endif;
endif;
//* FIX: Moved RMTFILE(*FROMFILE) logic to after *LIBL translation.
//* If TOFILE(*FROMFILE) is specified, copy the file name.
//* If the TOFILE's library is blank or *LIBL (expected)
//* then also copy the FROMFILE's library name to the
//* TOFILE's library name.
if %subst(Rmt.File:1:5) = '*FROM';
Rmt.File = Lcl.File;
endif;
//* NOTE: Can't use *LIBL or *CURLIB for the
//* target/remote file's library name.
if Rmt.Lib = *BLANKS
or %subst(Rmt.Lib:1:1) = '*';
Rmt.Lib = Lcl.Lib;
endif;
//* If no remote member name is specified, use the file name.
//* NOTE: We can't use *FIRST or *LAST for the remote
//* file since we can't run QUSRMBRD over that file.
if Rmt.Mbr = *Blanks
or Rmt.Mbr = '*FILE'
or Rmt.Mbr = '*RMTFILE';
Rmt.Mbr = Rmt.File;
else;
if Rmt.Mbr = '*FROMMBR';
Rmt.Mbr = Lcl.Mbr;
else;
if Rmt.Mbr = '*FROMFILE';
Rmt.Mbr = Lcl.File;
endif;
endif;
endif;
//* FIX: End-Fix
//* Build the FTP string containing the lib/file/mbr to send.
szSndFile = '/qsys.lib' +
'/' + %TrimR(lcl.Lib) + '.lib' +
'/' + %TrimR(lcl.File) + '.file' +
'/' + %TrimR(lcl.Mbr) + '.mbr';
//* Build the remote file name
//* If a generic name, such as AP* or *ALL, such as * is
//* passed in, use the generic member name as the local name.
//* Then we also have to do a CD (change directory) on the
//* remote system to send the generic members.
if %scan('*':lcl.Mbr) > 0;
lcl.Mbr = GENERICMBR;
bGeneric = *ON;
else;
bGeneric = *OFF;
endif;
if NOT bGeneric;
//* Regular member name?
szRmtFile = '/qsys.lib' +
'/' + %TrimR(Rmt.Lib) + '.lib' +
'/' + %TrimR(Rmt.File) + '.file' +
'/' + %TrimR(Rmt.Mbr) + '.mbr';
else;
//* When sending a generic member name, then we use szRmtFile
//* as the "current directory" not as the target file/member name.
//* Since no member name is needed, only lib/file is specified.
szRmtFile = '/qsys.lib' +
'/' + %TrimR(Rmt.Lib) + '.lib' +
'/' + %TrimR(Rmt.File) + '.file';
endif;
//* Translate special member identifiers to the actual mbr name.
//* Script source member
if script.mbr = '*FROMMBR';
script.mbr = Lcl.Mbr;
endif;
//* Log member
if Log.Mbr = '*FROMMBR';
Log.Mbr = Lcl.Mbr;
endif;
//* If the caller specified SRCMBR(*GEN) then create
//* a source member name based on today's date.
if script.mbr = '*GEN' or script.mbr = *BLANKS;
//* The member named is: FSyyyymmdd
script.mbr = 'FS' + %char(%date():*ISO0);
endif;
//* If the caller specified LOGMBR(*GEN) then create
//* a source member name based on today's date.
if Log.mbr = '*GEN' or Log.mbr = *BLANKS;
//* The member named is: FSyyyymmdd
log.mbr = 'FL' + %char(%date():*ISO0);
endif;
//* Attempt to create the source file for the FTP Script.
//* If its already there, there's no problem with trying
//* to create it again... the (e) on the CALLP will swallow
//* the "already exists" error.
if szFTPSrc = dftFTPSRC;
callp(e) system('CRTSRCPF ' + szFTPSrc +
' RCDLEN(152)');
endif;
//* Add, then clear the FTP Script source member
addPFM = 'ADDPFM FILE(' +
%TrimR(szFTPSRC) + ') ' +
'MBR(' + %TrimR(script.mbr) + ') ' +
'SRCTYPE(FTPSCRIPT)';
callp(e) system(AddPFM);
addPFm = 'CLRPFM FILE(' +
%TrimR(szFTPSRC) + ') ' +
'MBR(' + %TrimR(script.mbr) + ') ';
callp(e) system(addPFM);
//* Add and/or clear the FTP Log source member, if requested.
if %subst(log.File:1:1) <> '*'
and log.File <> *BLANKS;
addPFm = 'ADDPFM FILE(' +
%TrimR(szFtpLog) + ') ' +
'MBR(' + %TrimR(log.mbr) + ') ' +
'SRCTYPE(FTPLOG)';
callp(e) system(addPFM);
addPFm = 'CLRPFM FILE(' +
%TrimR(szFTPLog) + ') ' +
'MBR(' + %TrimR(log.mbr) + ')';
callp(e) system(addPFM);
endif;
//* Open and build the FTP INPUT Script
Open QFTPSrc;
if NOT %OPEN(QFTPSRC);
Joblog('Source file for FTP script +
failed to open. FTP cancelled.');
return;
endif;
//* Remove the "Buffer overflow" message
clear apiError;
apiError.QUSBPRV = %size(ApiError);
QMHRMVPM('*':0:' ':'*NEW':ApiError);
//* User ID & PWD
if RmtLoc.User = '*CURRENT'
or %subst(RmtLoc.User:1:3) = '*US';
RmtLoc.User = USRPRF;
endif;
//* If PWD(*USER) is specified, make the PWD
//* the same as the user profile.
if %Subst(RmtLoc.PWD:1:3) = '*US';
RmtLoc.PWD = RmtLoc.User;
endif;
//* Send the FTP user ID and password to the remote FTP server.
srcdta = %Trim(RmtLoc.User) + ' ' +
%Trim(RmtLoc.PWD);
Write FTPSrcRec;
//* Change the transfer mode to BINARY or ASCII.
srcdta = %Trim(TFRMode);
Write FtpSrcRec;
//* Change the Name Format to 1.
//* NOTE: This may cause the remote location to send a 501 error,
//* but that's okay.
srcdta = 'NAMEFMT 1';
Write FtpSrcRec;
//* If sending a bunch of members (generic or *ALL) then
//* issue the CD (change directory) command on the remote server.
if bGeneric;
srcDta = 'CD ' + %TrimR(szRmtFile);
Write FtpSrcRec;
//* Generic/Multi-member MPUT
srcdta = 'MPUT ' + %TrimR(szSndFile);
Write FtpSrcRec;
//* Sending a Single member? Use the PUT or APPEND command.
else;
if bAppend;
srcdta = 'APPEND ' + %TrimR(szSndFile) +
' ' +
%TrimR(szRmtFile);
else;
srcdta = 'PUT ' + %TrimR(szSndFile) +
' ' +
%TrimR(szRmtFile);
endif;
Write FtpSrcRec;
endif;
//* Say goodbye to the FTP server.
srcdta = 'QUIT';
Write FtpSrcRec;
Close QFTPSrc;
//*************************************************************
//* At this point, the FTP script has been created and should be
//* stored in the source file, library and member specified.
//* If debugging, use Debug Shift+F9 to open a command-line
//* and then use SEU or DSPPFM to view/review the FTP script.
//*************************************************************
//*************************************************************
//* Prepare the FTP CL command by overriding the FTP input
//* to the script that we just created.
//*************************************************************
szOvrdbf = 'OVRDBF FILE(INPUT) ' +
' TOFILE(' + %TrimR(szFtpSrc) + ')' +
' MBR(' + %TrimR(script.mbr) + ')' +
' OVRSCOPE(*JOB) ';
callp(e) system(szOvrdbf);
//*************************************************************
//* If an FTP log is requested, override the output to
//* the FTP log file, library and member.
//* NOTE: If LOG(*NONE) is specified, the log is overridden
//* to a dummy file in QTEMP that is not displayed.
//* This is done so that the STDIO log that is
//* normally generated by FTP is not displayed.
//*************************************************************
if log.File = '*NONE' or bNoLog = *ON;
szOvrdbf = 'OVRDBF FILE(OUTPUT) ' +
'TOFILE(QTEMP/QFTPNULL) ' +
'MBR(NONE) ' +
'OVRSCOPE(*JOB) ';
callp(e) system(szOvrdbf);
else;
if %subst(log.File:1:1) <> '*'
and log.File <> *BLANK
and bNoLog = *OFF;
szOvrdbf = 'OVRDBF FILE(OUTPUT) ' +
'TOFILE(' + %TrimR(szFtpLog) + ') ' +
'MBR(' + %TrimR(log.mbr) + ') ' +
'OVRSCOPE(*JOB) ';
callp(e) system(szOvrdbf);
endif;
endif;
//* Evoke FTP to send the file to the remote
//* location using the FTP script we just created.
FtpCmd = 'FTP ' +
' + %TRIM(RmtLoc.IP) + ';
//* Run the FTP command.
callp(e) system(FtpCmd);
//* Now go back and obscure the remote user's password
open(e) QFTPSRC;
if %OPEN(QFTPSRC);
//* Remove the "Buffer overflow" message
clear ApiError;
apiError.QUSBPRV = %size(ApiError);
QMHRMVPM('*':0:' ':'*NEW':ApiError);
//* Obscure the remote user's password in the FTP script source member
if NOT %Error();
read FTPSRCREC;
srcdta = %Trim(RmtLoc.User) + ' ' + '*****';
update FTPSRCREC;
endif;
endif;
//* Delete the FTP I/O overrides
callp(e) system(' DLTOVR FILE(INPUT) LVL(*JOB) ');
callp(e) system(' DLTOVR FILE(OUTPUT) LVL(*JOB) ');
//* If the end-user requested that the FTP log be displayed,
//* and an FTP log outfile was specified, then display it
//* using DSPPFM. You could change this to the IFS-style DSPF command.
if %subst(log.File:1:1) <> '*'
and log.File <> *BLANK;
if NOT bNoLog;
callp(e) system(' DSPPFM FILE(' + szFtpLog + ')' +
' MBR(' + %trimR(log.mbr) + ')' +
' FROMRCD(*END) ' );
endif;
endif;
return;
/END-FREE
//*****************************************************
//* Write an impromptu message to the joblog **
//*****************************************************
P JobLog B
D JobLog PI
D szMsg 1024A Const VARYING
/FREE
Qp0zLprintf(szMsg + X'25');
/END-FREE
P JobLog E
Help Text via Panel Group
A few weeks after I wrote this command, user Tom Zamara of DIS Ltd. sent me the following Panel Group and stated that I could use/publish it with FTPSNDFILE. He basically took my parameter descriptions and formatted it with Panel Group tags. These tags are sort of a precursor to HTML but, boy, HTML is sure easier to read. Anyway, the panel group must be compiled and provides cursor-sensitive help when the FTPSNDFILE command is prompted; just like IBM commands! Pretty cool.
To compile the panel group, use the CRTPNLGRP command or PDM option 14 and take the defaults. Here's the panel group source code (oh, and place it into QPNLSRC after creating it just like any other source file):
.****************************************************************** .* .* Panel Group: FTPSNDFILE .* (c) 2005 by R. Cozzi, Jr. .* All rights reserved. .* .* Panel Group formatting and Formatting Codes provided by: .* Tom Zamara of DIS Ltd. .* .* Function: .* Used as the help text for command FTPSNDFILE .* .****************************************************************** :PNLGRP. .****************************************************************** .* .* Primary help text for the command. .* .****************************************************************** :HELP NAME='FTPSNDFILE'. Send File Using FTP - Help :P. The Send File Using FTP (FTPSNDFILE) command allows you to send a single database member, a generic set of members, or all members to a remote OS/400 file. Using this command avoids interactive FTP so users can submit their transfers to batch or run them interactively with less complexity. :P. Internally, FTPSNDFILE dynamically generates an FTP script and saves the FTP results log in source file members in QTEMP or a user-specified location. :P. Only the IP address, file name, user profile, and password are required. :EHELP. .******************************************************************* .* .* Help text for the command parameters. .* .****************************************************************** :HELP NAME='FTPSNDFILE/RMTSYS'. Remote IP or FTP server (RMTSYS) - Help :XH3.Remote IP or FTP server (RMTSYS) :P. Specify the IP address or domain name of the system that will receive the file you are sending. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/FILE'. Local file (FILE) - Help :XH3.Local file (FILE) :P. Specify the qualified name of the file that you want to send using FTP. A value of *LIBL may be specified for the file's library. However, the FTPSNDFILE command's processing program will convert *LIBL into the actual library name at runtime. It uses the QUSROBJD (Retrieve Object Description) API to accomplish this. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/MBR'. Local member (MBR) - Help :XH3.Local member (MBR) :P. Specify the name (generic*, full, or *ALL) of the member(s) you want to transfer. :P. The following special values are also supported: :DL. :dt.*FIRST :dd.The first member in the local file is transferred. This value must be specified when a generic local member name or when *ALL is specified for the local member name (MBR) parameter. :dt.*LAST :dd.The last member in the local file is transferred. :dt.*FILE :dd.The member whose name is the same as the local file name is transferred. :dt.*ALL :dd.All members in the local file are transferred. When *ALL is specified, the FTP command MPUT (multiple-PUT) is used instead of PUT. When *ALL is specified, the REPLACE parameter is ignored. Any existing members in the remote file whose names match that of a member in the local file are replaced with the new data, (i.e., REPLACE(*YES) is implied.) :dt.Mmmm* :dd.All members beginning with the Mmmm pattern are transferred. At least one character followed by an asterisk (*) must be specified to be considered a valid generic member name. Example: AP* All members beginning with the letters 'AP' are transferred. :edl. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/TOFILE'. Remote file (TOFILE) - Help :XH3.Remote file (TOFILE) :P. Specify the name of the file that receives the data from the local file. The file should already exist on the remote system so that the external definition is preserved. If the file does not exist, the FTP server will create the file for you, but you won't like the results as it will be a so called "flat file" (i.e., no external description will be associated with the new file). If it already exists, this issue does not apply. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/TOMBR'. Remote member (TOMBR) - Help :XH3.Remote member (TOMBR) :P. Specify the name of the member into which the data is stored. You may specify either a member name or one of the following special values: :DL. :dt.*FROMMBR :dd.Use this when the remote member name should be the same as the local member name as specified on the MBR parameter. *FROMMBR must be specified when a generic name or *ALL is specified on the local member name (MBR) parameter. :dt.*TOFILE :dd.The member name is the same as the remote file name specified on the TOFILE parameter. :edl. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/REPLACE'. Replace data on remote system (REPLACE) - Help :XH3.Replace data on remote system (REPLACE) :P. Replace remote member's data. This parameter controls whether data is added or replaced in the remote member. :DL. :dt.*YES :dd.The data in the remote member is replaced with the FTP'd data. If the remote member does not exist, it is added to the remote file. If FROMMBR(*ALL) is specified, this parameter is ignored and REPLACE(*YES) is "forced". Internally, the FTP PUT command is used to send the member when REPLACE(*YES) is specified, unless FROMMBR(*ALL) is also specified, in which case MPUT is used to send the member(s). :dt.*NO :dd.The data is added to any existing remote file member. If the member does not exist, it is added to the file. Internally, the FTP APPEND command is used to send the member. If FROMMBR(*ALL) is specified, REPLACE(*NO) is ignored and REPLACE(*YES) is "forced". :edl. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/USER'. Remote FTP User ID (USER) - Help :XH3.Remote FTP User ID (USER) :P. Specify the user profile name for the remote system. This user profile is used to sign on to the remote FTP server. You must also specify a password for this user program on the PWD parameter. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/PWD'. Remote FTP Password (PWD) - Help :XH3.Remote FTP Password (PWD) :P. Specify the password for the remote user. Note that this parameter's value is not recorded in the joblog and must be entered each time you run the FTPSNDFILE command from Command Entry. :P. From within a CL program, the password may be stored in a CL variable and passed on this parameter. :P. The following special value may also be specified: :DL. :dt.*USER :dd.The user profile specified on the USER parameter is also the password. This is only useful when the user ID and password are identical. Some installations create special FTP User IDs with the User Profile and passwords being the same, but this is not recommended. :edl. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/MODE'. Transfer mode (MODE) - Help :XH3.Transfer mode (MODE) :P. Specify the kind of transfer to be performed. The valid choices are as follows: :DL. :dt.*BINARY :dd.The transfer mode is IMAGE/BINARY. This is recommended for iSeries objects such as database files. :DT.*ASCII :dd.The transfer mode is plain ASCII text. This transfer mode is valid for non-database files, such as source file members, but typically doesn't add value for iSeries to iSeries transfers. :edl. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/SRCFILE'. Source file that receives FTP script (SRCFILE) - Help :XH3.Source file that receives generated FTP script (SRCFILE) :P. The name of the source file that receives the generated FTP script. This source file should be as long as possible but at least 152 bytes in length (140 bytes for the source line and the usual 12 bytes for the source sequence and change-date area). :P.If this source file does not exist, it will be created with a record length of 152 bytes. The default source file name is as follows: :DL. :dt.QFTPSRC :dd.The file QFTPSRC in QTEMP is used as the FTP script source file. :P.The default library name is QTEMP. :edl. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/SRCMBR'. Script source member (SRCMBR) - Help :XH3.Script source member (SRCMBR) :P.The FTP script source member name. This is the name of the member into which the FTP script is generated. Specify any valid source member name, *FROMMBR, or *GEN. If the member exists, it is cleared; if it does not exist, it is added. The two special values for this parameter are as follows: :DL. :DT.*FROMMBR :DD.The name specified on the MBR parameter is used as the member name for the FTP script. This member is added to the source file specified on the SRCFILE parameter. :dt.*GEN :dd.A member name using the following pattern is automatically generated: FSyyyymmdd, where FS is a constant, and YYYYMMDD is today's system date in YMD format. :edl. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/LOG'. FTP log file (LOG) - Help :XH3.FTP log file (LOG) :P.FTP run log file. Specify the name of a source file that will receive the log from the FTP session. Optionally, specify that the messages are to be delivered as they normally are, via the STDOUT (standard output) device. :P. Unlike the SRCFILE parameter, the file specified on the LOG parameter must exist because the FTPSNDFILE command will not create it. You may, however, use the same file name as the SRCFILE parameter, in which case the file is created due to its being specified on the SRCFILE parameter. :P. This parameter has the following special values: :dl. :dt.*STDOUT :dd.Indicates that the FTP log is written to the standard output device, which scrolls up the 5250 screen, similar to an old teletype interface. :dt.*STDIO :dd.Same as *STDOUT. :dt.*SRCFILE :dd.The source file and library name specified on the SRCFILE parameter are used as FTP LOG file. :dt.*NONE :dd.No FTP log is maintained. :edl. :p. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/LOGMBR'. Log member (LOGMBR) - Help :XH3.Log member (LOGMBR) :P. The member name where the FTP log is saved. The following special value is also supported: :dl. :dt.*FROMMBR :dd.The name of the member specified on the MBR parameter is used as the FTP log file member name. :dt.*SCRIPT :dd.The name of the member specified on the SRCMBR parameter is used as the FTP log file member name. *SRCMBR may also be specified. :edl. :EHELP. .****************************************************************** :HELP NAME='FTPSNDFILE/DSPLOG'. Display FTP transfer log (DSPLOG) - Help :XH3.Display FTP transfer log (DSPLOG) :P. Display the FTP log. If *YES is specified, the FTP log is displayed when the FTP transfer completes; if *NO, the FTP log is not displayed. :EHELP. .****************************************************************** :EPNLGRP.