ZipServiceの例
これは、Zipアーカイブ・ファイルを作成し、新しく作成したZipファイルに指定のディレクトリの内容をコピーする簡単なファンクションです。
* Uses Integrator Services: ZIPSERVICE
* Loads ZIPService service then zips a nominated
* directory into an archive file.
* Beginning of RDML commands **********
FUNCTION OPTIONS(*DIRECT)
DEFINE FIELD(#JSMSTS) TYPE(*CHAR) LENGTH(020)
DEFINE FIELD(#JSMCMD) TYPE(*CHAR) LENGTH(255)
DEFINE FIELD(#JSMMSG) TYPE(*CHAR) LENGTH(255)
DEFINE FIELD(#ZIPDIR) TYPE(*CHAR) LENGTH(256) LABEL('Zip directory:') COLHDG('Path to be zipped') INPUT_ATR(FE LC)
DEFINE FIELD(#ZIPFIL) TYPE(*CHAR) LENGTH(256) LABEL('Zip file path:') COLHDG('Output zip path/file') INPUT_ATR(FE LC) DEFAULT('''*.zip''')
* 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(ZIPSERVICE)') TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
MESSAGE MSGTXT('ZIPService loaded')
BEGIN_LOOP
* request name of folder to be zipped and target zip file
CHANGE FIELD(#STD_INSTR) TO('''Type zip directory and zip file name, press Enter.''')
REQUEST FIELDS((#STD_INSTR *L003 *P002 *OUTPUT *NOID) (#ZIPDIR *L005 *P002) (#ZIPFIL *L010 *P002)) DESIGN(*DOWN) IDENTIFY(*COLHDG) DOWN_SEP(001) ACROSS_SEP(001) EXIT_KEY(*NO) MENU_KEY(*YES *NEXT) PROMPT_KEY(*NO)
IF_KEY WAS(*MENU)
* Close service
EXECUTE SUBROUTINE(DISCONNECT)
MENU
ENDIF
* create the zip file
EXECUTE SUBROUTINE(MAKEZIP)
END_LOOP
* Zips the nominated directory
SUBROUTINE NAME(MAKEZIP)
* Create the specified zip file
CHANGE FIELD(#JSMCMD) TO(CREATE)
EXECUTE SUBROUTINE(KEYWRD) WITH_PARMS(FILE #ZIPFIL)
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* Add the contents of the specified folder
CHANGE FIELD(#JSMCMD) TO(ADD)
EXECUTE SUBROUTINE(KEYWRD) WITH_PARMS(PATH #ZIPDIR)
EXECUTE SUBROUTINE(KEYWRD) WITH_PARMS(BASE '*CURRENT')
USE BUILTIN(JSM_COMMAND) WITH_ARGS(#JSMCMD) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* Close the zip file
USE BUILTIN(JSM_COMMAND) WITH_ARGS(CLOSE) TO_GET(#JSMSTS #JSMMSG)
EXECUTE SUBROUTINE(CHECK) WITH_PARMS(#JSMSTS #JSMMSG)
* Confirm zip is complete
MESSAGE MSGTXT('Directory has been successfully zipped')
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
* Build JSM commands
SUBROUTINE NAME(KEYWRD) PARMS((#KEYWORD *RECEIVED) (#KEYW_VAL1 *RECEIVED))
DEFINE FIELD(#KEYWORD) REFFLD(#STD_TEXT)
DEFINE FIELD(#KEYW_VAL1) REFFLD(#STD_TEXTL)
USE BUILTIN(BCONCAT) WITH_ARGS(#JSMCMD #KEYWORD) TO_GET(#JSMCMD)
USE BUILTIN(TCONCAT) WITH_ARGS(#JSMCMD '(' #KEYW_VAL1 ')') TO_GET(#JSMCMD)
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