ZipService

This is a simple function to create a zip archive file and copy the contents of a nominated directory into the newly created zip file.

* 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