FTPService Example
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 **********