ZipService

This form allows the creation of zip archive files and for existing zip archive files to be opened, reviewed and modified.  Zip file contents can also be extracted to a specified directory.

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

* Uses Integrator Services: ZIPSERVICE

*

* This form is a very simple Windows Zip file processor.

* It allows you to:

* - create zip files

* - open existing zip files and list their contents

* - add files or folders to the open zip file

* - extract the contents of a zip file to a specified folder

*

* NOTE:  This program is provided only to demonstrate usage of

* the ZipService.  To keep it simple, it has rudimentary error

* handling and does not necessarily demonstrate recommended or

* efficient programming technique or user interface design.

*

* The following field must be defined in your repository:

* filepath   string 512

* jsmsts     alpha  20

* jsmmsg     alpha  255

* jsmhdle    char   500

* jsmcmd     alpha  4

*

function options(*DIRECT)

begin_com role(*EXTENDS #PRIM_FORM) bordericons(SystemMenu) caption('LANSA Integrator ZipService RDMLX Sample') clientheight(435) clientwidth(738) formposition(ScreenCenter) framestyle(Dialog) height(469) left(439) top(115) width(746)

 

define_com class(#PRIM_APPL.ICommonDialogFileOpen) name(#openFileDlg) reference(*DYNAMIC)

define_com class(#PRIM_APPL.ICommonDialogFileSave) name(#saveFileDlg) reference(*DYNAMIC)

 

define_com class(#PRIM_LTVW) name(#LVContent) componentversion(2) displayposition(1) fullrowselect(True) height(366) left(9) parent(#COM_OWNER) showsortarrow(True) tabposition(1) top(35) width(416)

define_com class(#PRIM_LVCL) name(#LVCL_1) displayposition(1) parent(#LVContent) source(#FILEPATH) widthtype(Remainder)

 

define_com class(#PRIM_LABL) name(#LABL_1) caption('Zip contents:') displayposition(2) height(14) left(8) parent(#COM_OWNER) tabposition(2) tabstop(False) top(8) width(125)

define_com class(#PRIM_GPBX) name(#GPBX_1) caption('File:') displayposition(3) height(66) left(434) parent(#COM_OWNER) tabposition(3) tabstop(False) top(23) width(289)

define_com class(#PRIM_PHBN) name(#btnNew) caption('&New...') displayposition(1) left(20) parent(#GPBX_1) tabposition(1) top(21) width(100)

define_com class(#PRIM_PHBN) name(#btnOpen) caption('&Open...') displayposition(2) left(164) parent(#GPBX_1) tabposition(2) top(21) width(100)

 

 

define_com class(#PRIM_GPBX) name(#grpAdd) caption('Add:') displayposition(4) enablechildren(True) height(169) left(434) parent(#COM_OWNER) tabposition(4) tabstop(False) top(96) width(289)

define_com class(#PRIM_PHBN) name(#btnAddFile) caption('Add File...') displayposition(1) enabled(False) left(20) parent(#grpAdd) tabposition(1) top(22) width(100)

define_com class(#PRIM_PHBN) name(#btnAddFolder) caption('Add Folder:') displayposition(2) enabled(False) left(20) parent(#grpAdd) tabposition(2) top(71) width(100)

define_com class(#PRIM_LABL) name(#LABL_4) caption('Folder:') displayposition(7) height(18) left(140) parent(#grpAdd) tabposition(7) tabstop(False) top(76) width(125)

define_com class(#PRIM_EDIT) name(#edtAddFolder) displayposition(3) height(18) hint('Specifies the folder to add') left(139) parent(#grpAdd) showselection(False) showselectionhilight(False) tabposition(3) top(95) width(128)

define_com class(#PRIM_LABL) name(#lblAddBas) caption('Base:') displayposition(6) height(17) left(138) parent(#grpAdd) tabposition(6) tabstop(False) top(120) width(127)

define_com class(#PRIM_CMBX) name(#cboAddBas) comboboxstyle(DropDownList) componentversion(1) displayposition(5) height(18) left(138) parent(#grpAdd) showselection(False) showselectionhilight(False) tabposition(5) top(138) width(127)

define_com class(#PRIM_CBCL) name(#CBCL_1) displayposition(1) parent(#cboAddBas) source(#STD_INSTR)

 

define_com class(#PRIM_GPBX) name(#grpExtract) caption('Extract:') displayposition(5) enablechildren(True) height(129) left(434) parent(#COM_OWNER) tabposition(5) tabstop(False) top(272) width(289)

define_com class(#PRIM_PHBN) name(#btnExtractFile) caption('Extract to:') displayposition(1) left(20) parent(#grpExtract) tabposition(1) top(34) width(100)

define_com class(#PRIM_LABL) name(#LABL_3) caption('Folder:') displayposition(5) height(17) left(136) parent(#grpExtract) tabposition(5) tabstop(False) top(40) width(129)

define_com class(#PRIM_EDIT) name(#edtExtractFolder) displayposition(2) height(18) left(136) parent(#grpExtract) showselection(False) showselectionhilight(False) tabposition(2) top(56) width(128)

define_com class(#PRIM_STTC) name(#STTC_1) displayposition(4) height(3) left(20) parent(#grpAdd) tabposition(4) top(60) width(245)

define_com class(#PRIM_LABL) name(#lblExtBas) caption('Base:') displayposition(3) height(17) left(135) parent(#grpExtract) tabposition(3) tabstop(False) top(80) width(127)

define_com class(#PRIM_CMBX) name(#cboExtBas) comboboxstyle(DropDownList) componentversion(1) displayposition(4) height(18) left(136) parent(#grpExtract) showselection(False) showselectionhilight(False) tabposition(4) top(97) width(128)

define_com class(#PRIM_CBCL) name(#CBCL_2) displayposition(1) parent(#cboExtBas) source(#STD_INST2)

 

define_com class(#PRIM_STBR) name(#STBR_1) displayposition(6) height(24) left(0) messageposition(1) parent(#COM_OWNER) tabposition(6) tabstop(False) top(411) width(738)

 

define field(#bResult) type(*boolean)

define field(#bIgnore) type(*boolean)

define field(#zippath) type(*string)

define field(#ziptitle) type(*string)

define field(#caption) type(*string)

 

def_list name(#ziplist) fields(#filepath) type(*Working) entrys(*MAX)

def_list name(#cmdlist) fields(#std_num #std_name #std_textl #std_text) counter(#std_count) type(*Working) entrys(*MAX)

 

evtroutine handling(#com_owner.Initialize)

 

set com(#com_owner) caption(*component_desc)

 

* start local JSM server and load the ZipService

use builtin(jsmx_open) to_get(#jsmsts #jsmmsg #jsmhandle)

#com_owner.check( #jsmsts #jsmmsg )

 

#jsmcmd := 'service_load service(zipservice)'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

endroutine

 

evtroutine handling(#com_owner.Closing)

 

use builtin(jsmx_command) with_args(#jsmhandle 'service_unload') to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

use builtin(jsmx_close) with_args(#jsmhandle) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

endroutine

 

evtroutine handling(#com_owner.CreateInstance) options(*NOCLEARMESSAGES *NOCLEARERRORS)

 

* initial state

#com_owner.OnOpenArchive( false )

 

* load combo boxes

#std_instr #std_inst2 := '*NONE'

add_entry to_list(#cboAddBas)

add_entry to_list(#cboExtBas)

 

#std_instr #std_inst2 := '*CURRENT'

add_entry to_list(#cboAddBas)

add_entry to_list(#cboExtBas)

 

#cboAddBas.CurrentItem.Selected := True

#cboExtBas.CurrentItem.Selected := True

#std_instr #std_inst2 := '*PARENT'

add_entry to_list(#cboAddBas)

 

* put a hint in the folder edit boxes

#edtAddFolder.Value := '<type folder path>'

#edtExtractFolder.Value := '<type folder path>'

 

endroutine

 

* Create an archive file

evtroutine handling(#btnNew.Click)

 

#sys_appln.CreateFileSaveDialog result(#saveFileDLG)

#saveFileDlg.AddFilter( 'Zip files (*.zip)' '*.zip' )

#saveFileDlg.AddFilter( 'All files (*.*)' '*.*' )

#saveFileDlg.Title := 'New'

 

#saveFileDlg.Show okpressed(#bResult) formowner(#com_self)

 

if (#bResult)

 

* close existing file

#com_owner.Closefile

 

* create a zip file

#jsmcmd := 'create file(' + #saveFileDlg.file + ')'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

* save details

#zippath := #saveFileDlg.file

#ziptitle := #saveFileDlg.file

 

#com_owner.OnOpenArchive( true )

 

#com_owner.caption := #saveFileDlg.file

 

endif

 

endroutine

 

* Select an archive file to open

evtroutine handling(#btnOpen.Click)

 

#sys_appln.CreateFileOpenDialog result(#OpenFileDLG)

 

#openFileDlg.AddFilter( 'Zip files (*.zip)' '*.zip' )

#openFileDlg.AddFilter( 'All files (*.*)' '*.*' )

 

#openFileDlg.Show okpressed(#bResult) formowner(#com_self)

 

if (#bResult)

 

* open the file

#com_owner.OpenFile( #openFileDlg.file #openFileDlg.filetitle )

 

#com_owner.caption := #openFileDlg.file

 

endif

 

endroutine

 

* select a file to add to the current archive

evtroutine handling(#btnAddFile.Click)

 

#sys_appln.CreateFileOpenDialog result(#OpenFileDLG)

#openFileDlg.AddFilter( 'All files (*.*)' '*.*' )

 

#openFileDlg.Show okpressed(#bResult) formowner(#com_self)

 

if (#bResult)

 

* open the current archive file

#jsmcmd := 'open file(' + #zippath + ') mode(*write) reaplce(*no)'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

* add the specified file to the current archive

#jsmcmd := 'add file(' + #openFileDlg.file + ')'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

* close the current archive file

#jsmcmd := 'close'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

* reload archive contents

#com_owner.OpenFile( #zippath #ziptitle )

 

endif

 

endroutine

 

evtroutine handling(#btnAddFolder.Click)

 

* open the current archive file through the ZipService

#jsmcmd := 'open file(' + #zippath + ') mode(*write) replace(*no)'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

* add the specified folder to the current archive

#jsmcmd := 'add path(' + #edtAddFolder.Value + ') base(' + #cboAddBas.Value + ')'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

* close the current archive through the ZipService

use builtin(jsmx_command) with_args(#jsmhandle 'close') to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

* reload archive contents

#com_owner.OpenFile( #zippath #ziptitle )

 

endroutine

 

evtroutine handling(#btnExtractFile.Click)

 

* open the current archive file through the ZipService

#jsmcmd := 'open file(' + #zippath + ') mode(*read)'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

* extract archive contents to the specified folder

#jsmcmd := 'get entry(*read) to(' + #edtExtractFolder.Value + ') base(' + #cboExtBas.Value + ')'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

* close the file

#jsmcmd := 'close'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

endroutine

 

* open or create a zip archive, or refresh the displayed contents of the current archive

mthroutine name(OpenFile)

define_map for(*input) class(#prim_alph) name(#iZipPath)

define_map for(*input) class(#prim_alph) name(#iZipTitle)

 

* close existing file

#com_owner.Closefile

 

* open the file through the ZipService

#jsmcmd := 'open file(' + #iZipPath + ') mode(*read)'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg)

#com_owner.check( #jsmsts #jsmmsg )

 

* read the contents into the list box

clr_list named(#ziplist)

 

#jsmcmd := 'get entry(*list)'

use builtin(jsmx_command) with_args(#jsmhandle #jsmcmd) to_get(#jsmsts #jsmmsg #ziplist)

#com_owner.check( #jsmsts #jsmmsg )

 

selectlist named(#ziplist)

 

add_entry to_list(#LVContent)

 

endselect

 

* save details

#zippath := #iZipPath.Value

#ziptitle := #iZipTitle.Value

 

#com_owner.OnOpenArchive( true )

 

endroutine

 

* Close the current archive

mthroutine name(CloseFile)

 

clr_list named(#LVContent)

 

#zippath := *null

#com_owner.OnOpenArchive( false )

 

endroutine

 

* Set controls on open or close of archive

mthroutine name(OnOpenArchive)

define_map for(*input) class(#prim_boln) name(#iOpen)

 

#grpAdd.Enabled := #iOpen

#grpExtract.Enabled := #iOpen

 

endroutine

 

* check the JSM return status

mthroutine name(check)

define_map for(*input) class(#jsmsts) name(#i_status)

define_map for(*input) class(#jsmmsg) name(#i_message)

 

message msgtxt(#i_status + ' : ' + #i_message)

 

endroutine

 

end_com