FTPService

This function connects to a remote FTP server and allows a file to be PUT onto the remote server.  The current directory on the remote server can be set as required.

Modify the default values to be displayed to suit your site.

* Uses Integrator Services: FTPSERVICE

* Loads FTPService service then connects

* to a host using FTP and puts a file in binary mode.

 

* Beginning of RDML commands **********

 

FUNCTION OPTIONS(*DIRECT)

 

DEFINE FIELD(#JSMSTS) TYPE(*CHAR) LENGTH(020)

DEFINE FIELD(#JSMMSG) TYPE(*CHAR) LENGTH(255)

DEFINE FIELD(#JSMCMD) TYPE(*CHAR) LENGTH(255)

 

DEFINE FIELD(#JSMSERVER) TYPE(*char) LENGTH(20)

DEFINE FIELD(#JSMUSER) TYPE(*CHAR) LENGTH(010) LABEL('User')

DEFINE FIELD(#JSMPSSWRD) TYPE(*char) LENGTH(10)

DEFINE FIELD(#JSMDIR) TYPE(*CHAR) LENGTH(78) COLHDG('Change target dir')

DEFINE FIELD(#JSMFROM) TYPE(*CHAR) LENGTH(78) COLHDG('From file')

DEFINE FIELD(#JSMTO) TYPE(*CHAR) LENGTH(78) COLHDG('To file')

 

* set default values for screen

CHANGE FIELD(#STD_INSTR) TO('''Set your appropriate values then press ENTER to put file on remote server. ''')

CHANGE FIELD(#JSMSERVER) TO(ISERIES01)

CHANGE FIELD(#JSMUSER) TO(USER)

CHANGE FIELD(#JSMPSSWRD) TO(PASSWORD)

 

* Open service

USE BUILTIN(JSM_OPEN) TO_GET(#JSMSTS #JSMMSG)

EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

 

 

* Load service

USE BUILTIN(JSM_COMMAND) WITH_ARGS('SERVICE_LOAD SERVICE(FTPSERVICE)') TO_GET(#JSMSTS #JSMMSG)

EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

MESSAGE MSGTXT('FTPService loaded')

 

BEGIN_LOOP

 

* Format and Process JSM commands

REQUEST FIELDS((#STD_INSTR *L004 *P002 *OUTPUT *NOID) (#JSMSERVER *L006 *P024) (#JSMUSER *L008 *P024) (#JSMPSSWRD *L010 *P024) (#JSMFROM *L012 *P002 *COLHDG) (#JSMTO *L015 *P002 *COLHDG) (#JSMDIR *L018 *P002 *COLHDG)) IDENTIFY(*LABEL) EXIT_KEY(*NO) MENU_KEY(*YES *NEXT) PROMPT_KEY(*NO) USER_KEYS((05 'Get Dir'))

 

IF_KEY WAS(*USERKEY1)

 

EXECUTE SUBROUTINE(CONNECT)

 

* get the current directory

USE BUILTIN(JSM_COMMAND) WITH_ARGS('GETDIR') TO_GET(#JSMSTS #JSMMSG)

EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

CHANGE FIELD(#JSMDIR) TO(#jsmmsg)

 

* Quit FTP Session

EXECUTE SUBROUTINE(FTPQUIT)

CONTINUE

ENDIF

 

IF_KEY WAS(*MENU)

 

* Close service

EXECUTE SUBROUTINE(DISCONNECT)

MENU

 

ENDIF

 

* Connect to remote FTP server

EXECUTE SUBROUTINE(CONNECT)

 

* Transfer file

EXECUTE SUBROUTINE(TRANSFER)

 

END_LOOP

 

SUBROUTINE NAME(CONNECT)

 

* Connect to host

USE BUILTIN(TCONCAT) WITH_ARGS('CONNECT HOST(' #JSMSERVER ')') TO_GET(#JSMCMD)

USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)

EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

 

 

* Login

USE BUILTIN(TCONCAT) WITH_ARGS('LOGIN USER(' #JSMUSER ') PASSWORD(' #JSMPSSWRD ')') TO_GET(#JSMCMD)

USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)

EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

MESSAGE MSGTXT('Connection to remote server established')

 

ENDROUTINE

 

SUBROUTINE NAME(TRANSFER)

 

* Change directory

IF COND('#JSMDIR *NE *BLANK')

 

USE BUILTIN(TCONCAT) WITH_ARGS('CHGDIR PATH(' #JSMDIR ')') TO_GET(#JSMCMD)

USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)

EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

MESSAGE MSGTXT('Current directory has been changed on remote server')

 

ENDIF

 

* Binary mode

USE BUILTIN(JSM_COMMAND) WITH_ARGS('BINARY') TO_GET(#JSMSTS #JSMMSG)

EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

 

 

* Put file

USE BUILTIN(TCONCAT) WITH_ARGS('PUT FROM(' #JSMFROM ') TO(' #JSMTO ')') TO_GET(#JSMCMD)

USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)

EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

MESSAGE MSGTXT('File has been put on remote server')

 

* Quit after each file send

EXECUTE SUBROUTINE(FTPQUIT)

 

ENDROUTINE

 

SUBROUTINE NAME(FTPQUIT)

 

* Quit after each file send

USE BUILTIN(JSM_COMMAND) WITH_ARGS('QUIT') TO_GET(#JSMSTS #JSMMSG)

EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

MESSAGE MSGTXT('FTP connection closed')

 

ENDROUTINE

 

SUBROUTINE NAME(DISCONNECT)

 

* Unload service

USE BUILTIN(JSM_COMMAND) WITH_ARGS('SERVICE_UNLOAD') TO_GET(#JSMSTS #JSMMSG)

USE BUILTIN(JSM_CLOSE) TO_GET(#JSMSTS #JSMMSG)

 

* Close service

USE BUILTIN(JSM_CLOSE) TO_GET(#JSMSTS #JSMMSG)

EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)

 

ENDROUTINE

 

* Check the JSM return status

SUBROUTINE NAME(CHECK) PARMS((#JSMSTS *RECEIVED) (#JSMMSG *RECEIVED))

 

IF COND('#JSMSTS *NE OK')

USE BUILTIN(TCONCAT) WITH_ARGS(#JSMSTS ' : ' #JSMMSG) TO_GET(#STD_TEXTL)

MENU MSGID(DCM9899) MSGF(DC@M01) MSGDTA(#STD_TEXTL)

ENDIF

 

ENDROUTINE

 

* End of RDML commands **********