FTPServiceの例
このファンクションは、リモートFTPサーバーに接続し、リモート・サーバーにファイルを入れることができます。リモート・サーバー上の現在のディレクトリを必要に応じて設定できます。
使用するサイトに合うように、表示される省略値を修正します。
* 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 **********