PGM PARM(&PROFILE &USEROR)
DCL VAR(&PROFILE) TYPE(*CHAR) LEN(10)
DCL VAR(&USEROR) TYPE(*CHAR) LEN(10)
DCL VAR(&M1HOST) TYPE(*CHAR) LEN(20)
DCL VAR(&EXIT) TYPE(*CHAR) LEN(3)
CHGVAR VAR(&EXIT) VALUE('NO ')
/* The PARM &PROFILE is provided as a key field for getting the correct +
default information for the FTP script file for the application. +
It can be any unique name. It will write a new record with the +
key being &PROFILE + User's name. */
/* The PARM &USEROR allows the CL to specify a common USER for +
the FTP application, and not be different for each independant +
user of the application. It is designed to allow a departmental +
PROFILE for a departmental application. */
/* The file FTP2P1 is a regular data file designed to hold the working +
Script file records for the RPG display screen program. +
The file FTP20P2 will be processed in QTEMP as the Password is saved +
in it, in the clear. */
CPYF FROMFILE(FTP20P2) TOFILE(QTEMP/FTP20P2) +
FROMMBR(*ALL) TOMBR(*FROMMBR) +
MBROPT(*NONE) CRTFILE(*YES)
MONMSG MSGID(CPF2817)
CLRPFM FILE(QTEMP/FTP20P2) MBR(FTPCMDS)
OVRDBF FILE(FTP20P2) TOFILE(QTEMP/FTP20P2) +
MBR(FTPCMDS)
OVRDBF FILE(INPUT) TOFILE(QTEMP/FTP20P2) MBR(FTPCMDS)
/* OVRDBF FILE(OUTPUT) TOFILE(QTEMP/FTP20P2) MBR(FTPLOG) */
/* By commenting this command the FTP process prints the +
log file to the screen. Uncommenting the command will +
print and save the log in ____/FTP20P2/FTPLOG */
CHGVAR VAR(&EXIT) VALUE('NO ')
CALL PGM(FTP20R) PARM(&PROFILE &M1HOST &EXIT &USEROR)
IF COND(&EXIT *EQ 'YES') THEN(RETURN)
IF COND(&EXIT *EQ 'LOG') THEN(OVRDBF +
FILE(OUTPUT) TOFILE(QTEMP/FTP20P2) +
MBR(FTPLOG))
IF COND(&EXIT *NE 'YES') THEN(FTP +
RMTSYS(&M1HOST))
ENDPGM
|
H Y
/****************************************************************/
/* SOURCE - FTP20R */
/* PROGRAMMER - BOOTH MARTIN */
/* DATE - 8/98 */
/* COMMENTS - A PROGRAM TO DISPLAY FTP DEFAULT VALUES, */
/* ALLOW KEYING IN NEW VALUES, AND */
/* WRITING BACK THE VALUES, PLUS */
/* WRITING OUT AN FTP SCRIPT FILE. */
/****************************************************************/
FFTP20F CF E WORKSTN
FFTP20P1 UF E K DISK A
FFTP20P2 O E DISK
* A Named Constant field - (in case user name is blank.)
I 'Anonymous' C NC01
I SDS
I 254 263 USER
* *============================================================= *
* INDICATOR USAGE:
* 31 = Name in default record, position cursor at Password field.
* 32 = NO PASSWORD, RE-DO
* 33 = UNPROTECTS FIELDS; default is "protect" use F23 UNPROTECT
* 54 = CHAIN INDICATOR
* KL = Return to calling program, script not written.
* "PROF" is used to pass in a profile for this process. It is
* PROF + USER is the key to look up a default Script Record.
* PB1 is the pushbutton field on the screen.
* *=============================================================*
C *ENTRY PLIST
C PARM PROF WHAT PROGRAM?
C PARM M1HOST HOST SITE
C PARM EXIT
C PARM USEROR USER OVERRIDE
* .. ..
C Z-ADD*ZEROS PB1
C EXFMTFTP20A
C MOVE *OFF *IN32
C SELEC
C*
C PB1 WHEQ 2
C MOVE *ON *IN34
C MOVE 'LOG' EXIT
C*
C PB1 WHEQ 3
C MOVE *OFF *IN34
C MOVE 'NO ' EXIT
C*
* .. KL? Exit/cancel; don't do process:
C *INKL WHEQ *ON
C PB1 OREQ 1
C MOVE 'YES' EXIT 3
C MOVE *ON *INLR
C*
* .. KX?
C *INKX WHEQ *ON
C PB1 OREQ 4
C PB1 OREQ 5
C *IN33 IFEQ *ON
C MOVE *OFF *IN33
C ELSE
C MOVE *ON *IN33
C END
C*
* .. Password blank?
C M1PASS WHEQ *BLANKS
C MOVE *ON *IN32
C*
C* .. Otherwise, process the screen:
C OTHER
C KEY1 CHAINFTP2P1R 54
C MOVE M1HOST M0HOST
C MOVE M1NAME M0NAME
C*** DON'T SAVE: MOVE M1PASS M0PASS
C MOVE M1LN1 M0LN1
C MOVE M1LN2 M0LN2
C MOVE M1LN3 M0LN3
C MOVE M1LN4 M0LN4
C MOVE M1LN5 M0LN5
C MOVE M1LN6 M0LN6
C MOVE M1LN7 M0LN7
C MOVE M1LN8 M0LN8
C MOVE M1LN9 M0LN9
C MOVE *DATE M0DATO
C TIME M0TIMO
C *IN54 IFEQ *ON
C MOVE PROF M0PROF
C MOVE USER M0USRO
C WRITEFTP2P1R
C ELSE *IN54 IFEQ *ON
C UPDATFTP2P1R
C END X-*IN54 IFEQ *ON
C* MAKE THE RECORDS FOR THE FTP SCRIPT FILE:
C* HEADINGS
C MOVE *BLANKS FTP2LN
C M1NAME CAT M1PASS:1 FTP2LN
C FTP2LN IFGT *BLANKS
C WRITEFT2P2R
C END
C* LINE 1:
C MOVE *BLANKS FTP2LN
C MOVELM1LN1 FTP2LN
C FTP2LN IFGT *BLANKS
C WRITEFT2P2R
C END
C* LINE 2:
C MOVE *BLANKS FTP2LN
C MOVELM1LN2 FTP2LN
C FTP2LN IFGT *BLANKS
C WRITEFT2P2R
C END
C* LINE 3:
C MOVE *BLANKS FTP2LN
C MOVELM1LN3 FTP2LN
C FTP2LN IFGT *BLANKS
C WRITEFT2P2R
C END
C* LINE 4:
C MOVE *BLANKS FTP2LN
C MOVELM1LN4 FTP2LN
C FTP2LN IFGT *BLANKS
C WRITEFT2P2R
C END
C* LINE 5:
C MOVE *BLANKS FTP2LN
C MOVELM1LN5 FTP2LN
C FTP2LN IFGT *BLANKS
C WRITEFT2P2R
C END
C* LINE 6:
C MOVE *BLANKS FTP2LN
C FTP2LN IFGT *BLANKS
C MOVELM1LN6 FTP2LN
C WRITEFT2P2R
C END
C* LINE 7:
C MOVE *BLANKS FTP2LN
C MOVELM1LN7 FTP2LN
C FTP2LN IFGT *BLANKS
C WRITEFT2P2R
C END
C* LINE 8:
C MOVE *BLANKS FTP2LN
C MOVELM1LN8 FTP2LN
C FTP2LN IFGT *BLANKS
C WRITEFT2P2R
C END
C* LINE 9:
C MOVE *BLANKS FTP2LN
C MOVELM1LN9 FTP2LN
C FTP2LN IFGT *BLANKS
C WRITEFT2P2R
C END
* Present job finished normally:
C MOVE *ON *INLR
C*
C ENDSL
C*
* *=============================================================*
* *== SUB ROUTINES ==*
* *=============================================================*
C *INZSR BEGSR
C *LIKE DEFN M0PROF PROF
C *LIKE DEFN USER USEROR
C KEY1 KLIST
C KFLD PROF
C KFLD USER
C USEROR IFGT *BLANKS
C MOVE USEROR USER
C END
C MOVE *ON *IN34
C MOVE 'LOG' EXIT
C KEY1 CHAINFTP20P1 54
C *IN54 IFEQ *OFF
* USUALLY THE PARM-IN WILL BE EMPTY, BUT IF NOT, USE IT.
C M1HOST IFEQ *BLANKS
C MOVE M0HOST M1HOST
C END
C MOVE *BLANKS M1PASS
C* If name is blank, substitute "anonymous"
C* otherwise, move in the name and set the cursor at Password field.
C M0NAME IFEQ *BLANKS
C MOVELNC01 M1NAME
C ELSE
C MOVE M0NAME M1NAME
C MOVE *ON *IN31
C END
C MOVE *BLANKS M1PASS
C MOVE M0LN1 M1LN1
C MOVE M0LN2 M1LN2
C MOVE M0LN3 M1LN3
C MOVE M0LN4 M1LN4
C MOVE M0LN5 M1LN5
C MOVE M0LN6 M1LN6
C MOVE M0LN7 M1LN7
C MOVE M0LN8 M1LN8
C MOVE M0LN9 M1LN9
C END *IN54 IFEQ *OFF
C ENDSR
|
(the saved Script Lines, for the default FTP screen set up)
A****************************************************************/
A* SOURCE - FTP20P1 */
A* PROGRAMMER - Booth Martin */
A* DATE - 8/98 */
A* COMMENTS - A Physical file holding the default */
A* values for each individual's FTP Script */
A* File processes. */
A* */
A***************************************************************/
A R FTP2P1R
A*
A M0HOST 20 TEXT('HOST SITES NAME')
A M0NAME 20 TEXT('USERS NAME AT HOST')
A M0PASS 20 TEXT('PASSWORD AT HOST')
A M0LN1 72 TEXT('LINE 1')
A M0LN2 72 TEXT('LINE 2')
A M0LN3 72 TEXT('LINE 3')
A M0LN4 72 TEXT('LINE 4')
A M0LN5 72 TEXT('LINE 5')
A M0LN6 72 TEXT('LINE 6')
A M0LN7 72 TEXT('LINE 7')
A M0LN8 72 TEXT('LINE 8')
A M0LN9 72 TEXT('LINE 9')
A**********************
A* AUDIT TRAIL FIELDS *
A M0TIMO 6S 0 TEXT('TIME')
A M0DATO 8S 0 TEXT('DATE')
A M0PROF 10 TEXT('PROFILE')
A M0USRO 10 TEXT('USER')
A**********************
A K M0PROF
A K M0USRO
|
(The new Script File to do the actual File Transfer) (normally exists but only QTEMP has any data)
A****************************************************************/
A* SOURCE - FTP20P2 */
A* PROGRAMMER - Booth Martin */
A* DATE - 8/98 */
A* COMMENTS - A Physical file holding the Script and */
A* Log for an FTP session. */
A* This file is always empty. */
A* It has member FTPCMDS and */
A* member FTPLOG */
A* */
A****************************************************************/
A R FT2P2R
A*
A FTP2LN 72 TEXT('SCRIPT')
|
A*%%TS SD 19980815 174637 BOOTH REL-V4R2M0 5769-PW1
A****************************************************************/
A* SOURCE - FTP20F */
A* PROGRAMMER - BOOTH MARTIN */
A* DATE - 8/98 */
A* COMMENTS - DISPLAY FTP DEFAULTS, COLLECT VALUES FOR */
A* BUILDING AN FTP SCRIPT. */
A* */
A* NOTE: IF THIS SCREEN DOESN'T DISPLAY CORRECTLY THE SECOND */
A* TIME IT IS DISPLAYED, COMPILE IT WITH 14, AND AN F4 PROMPT. */
A* CHOOSE F10, ADDITIONAL PARAMETERS AND RESTORE DISPLAY *YES */
A* (This display looks best if used on an enhanced display) */
A* */
A****************************************************************/
A*%%EC
A DSPSIZ(24 80 *DS3)
A REF(*LIBL/FTP20P1 FTP2P1R)
A CHGINPDFT(HI UL LC)
A MSGLOC(17)
A PRINT
A CF12(12 'CANCEL')
A CF23(23 'UNPROTECT')
A R FTP20A
A*%%TS SD 19980815 153820 BOOTH REL-V4R2M0 5769-PW1
A OVERLAY
A WINDOW(3 3 17 72)
A 1 22'FTP site (IP address or name) -
A '
A M1HOST R B 1 1REFFLD(M0HOST)
A N33 DSPATR(PR)
A 34 2 22'Login ID -
A (log to File )'
A N34 2 22'Login ID -
A (log to Screen)'
A M1NAME R B 2 1REFFLD(M0NAME)
A 3 22'Password'
A M1PASS R B 3 1REFFLD(M0PASS)
A 31 DSPATR(PC)
A DSPATR(ND)
A DSPATR(UL)
A 32 3 31'A password is required.'
A COLOR(RED)
A M1LN1 R B 5 1REFFLD(M0LN1)
A N33 DSPATR(PR)
A M1LN2 R B 6 1REFFLD(M0LN2)
A N33 DSPATR(PR)
A M1LN3 R B 7 1REFFLD(M0LN3)
A N33 DSPATR(PR)
A M1LN4 R B 8 1REFFLD(M0LN4)
A N33 DSPATR(PR)
A M1LN5 R B 9 1REFFLD(M0LN5)
A N33 DSPATR(PR)
A M1LN6 R B 10 1REFFLD(M0LN6)
A N33 DSPATR(PR)
A M1LN7 R B 11 1REFFLD(M0LN7)
A N33 DSPATR(PR)
A M1LN8 R B 12 1REFFLD(M0LN8)
A N33 DSPATR(PR)
A M1LN9 R B 13 1REFFLD(M0LN9)
A N33 DSPATR(PR)
A PB1 2Y 0B 15 1PSHBTNFLD
A CHCAVAIL((*COLOR BLU))
A PSHBTNCHC(1 'F12=Cancel' CF12)
A PSHBTNCHC(2 'Log to File')
A PSHBTNCHC(3 'Log to Screen')
A N33 PSHBTNCHC(4 'F23=Unprotect' CF23)
A 33 PSHBTNCHC(5 'F23= Protect' CF23)
A 4 1'FTP script for the session -
A -
A '
A COLOR(BLU)
A 3 56' '
A 14 1' -
A -
A '
A R DUMMY
A TEXT('PREVENTS PREVIOUS SCREEN FROM-
A BEING CLEARED')
A ASSUME
A 5 9' '
|
