zipclp
PGM PARM(&ZIPFILE &FILES &REPLACE &COMPLVL +
&PASSWORD)
DCL VAR(&ZIPFILE) TYPE(*CHAR) LEN(128)
/* 2 + 128 * 20 */
DCL VAR(&FILES) TYPE(*CHAR) LEN(2562)
DCL VAR(&REPLACE) TYPE(*CHAR) LEN(8)
DCL VAR(&COMPLVL) TYPE(*CHAR) LEN(1)
DCL VAR(&PASSWORD) TYPE(*CHAR) LEN(32)
DCL VAR(&FILE) TYPE(*CHAR) LEN(128)
/* (128 + 2) * 20 + 127 */
DCL VAR(&FILE_STR) TYPE(*CHAR) LEN(2727)
DCL VAR(&FILE_NUM) TYPE(*DEC) LEN(3 0)
DCL VAR(&I) TYPE(*DEC) LEN(3 0) VALUE(0)
DCL VAR(&POS) TYPE(*DEC) LEN(5 0)
DCL VAR(&CMDSTR) TYPE(*CHAR) LEN(3000) +
VALUE('CALL PGM(MINIZIP400) PARM(')
DCL VAR(&Q) TYPE(*CHAR) LEN(1) VALUE('''')
DCL VAR(&ERR) TYPE(*CHAR) LEN(7)
DCL VAR(&ERR_DEC) TYPE(*DEC) LEN(10)
/* QtmhGetEnv parameters */
DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(100) /* output */
DCL VAR(&RCVLEN_B) TYPE(*CHAR) LEN(4) +
VALUE(X'00000064') /* input */
DCL VAR(&RSPLEN_B) TYPE(*CHAR) LEN(4) /* output */
DCL VAR(&RSPLEN) TYPE(*DEC) LEN(3)
DCL VAR(&REQVAR) TYPE(*CHAR) LEN(20) +
VALUE(MINIZIP_RTNCDE) /* input */
DCL VAR(&REQLEN_B) TYPE(*CHAR) LEN(4) +
VALUE(X'0000000E') /* input */
DCL VAR(&QUSEC) TYPE(*CHAR) LEN(16) +
VALUE(X'00100000000000000000000000000000') +
/* input/output */
/* QUSEC structure */
DCL VAR(&QUSBAVL_B) TYPE(*CHAR) LEN(4) /* output */
DCL VAR(&QUSBAVL) TYPE(*DEC) LEN(3)
/* Concat ZIPed files to a variable */
CHGVAR VAR(&FILE_NUM) VALUE(%BINARY(&FILES 1 2))
LOOP: CHGVAR VAR(&POS) VALUE(&I * 128 + 3)
CHGVAR VAR(&FILE_STR) VALUE(&FILE_STR |< ' ' || &Q +
|| %SST(&FILES &POS 128) |< &Q || ' ')
CHGVAR VAR(&I) VALUE(&I + 1)
IF COND(&I = &FILE_NUM) THEN(GOTO +
CMDLBL(NEXT))
GOTO CMDLBL(LOOP)
/* Construct command string to pass QCMDEXC */
NEXT: IF COND(&REPLACE = '*REPLACE') THEN(CHGVAR +
VAR(&CMDSTR) VALUE(&CMDSTR |< &Q || '-o' +
|| &Q))
IF COND(&REPLACE = '*APPEND') THEN(CHGVAR +
VAR(&CMDSTR) VALUE(&CMDSTR |< &Q || '-a' +
|| &Q))
CHGVAR VAR(&CMDSTR) VALUE(&CMDSTR |> &Q || '-' |< +
&COMPLVL |< &Q)
IF COND(&PASSWORD *NE ' ') THEN(CHGVAR +
VAR(&CMDSTR) VALUE(&CMDSTR |> &Q || '-p' +
|| &Q || ' ' || &Q |< &PASSWORD |< &Q))
CHGVAR VAR(&CMDSTR) VALUE(&CMDSTR |> &Q |< &ZIPFILE +
|< &Q || ' ' |< &FILE_STR |< ')')
/* Call minizip via QCMDEXC */
/* SNDPGMMSG MSG(&CMDSTR) */
CALL PGM(QCMDEXC) PARM(&CMDSTR 300)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('Command +
failed. QCMDEXC returned unexpected +
error.') MSGTYPE(*ESCAPE)
GOTO CMDLBL(EXIT)
ENDDO
/* Get environment variable */
CALLPRC PRC('QtmhGetEnv') PARM(&RCVVAR &RCVLEN_B +
&RSPLEN_B &REQVAR &REQLEN_B &QUSEC)
CHGVAR VAR(&QUSBAVL_B) VALUE(%SST(&QUSEC 5 4))
CHGVAR VAR(&QUSBAVL) VALUE(%BIN(&QUSBAVL_B))
IF COND(&QUSBAVL > 0) THEN(DO)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA('QtmhGetEnv returned ' || +
%SST(&QUSEC 9 7) |< '.') MSGTYPE(*ESCAPE)
GOTO CMDLBL(EXIT)
ENDDO
CHGVAR VAR(&RSPLEN) VALUE(%BIN(&RSPLEN_B))
IF COND(&RSPLEN < 1) THEN(DO)
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA('QtmhGetEnv returned invalid +
length (smaller than 1).') MSGTYPE(*ESCAPE)
GOTO CMDLBL(EXIT)
ENDDO
/* Examine environment variable (exit status of mnizip) */
CHGVAR VAR(&ERR) VALUE(%SST(&RCVVAR 1 &RSPLEN))
CHGVAR VAR(&ERR_DEC) VALUE(&ERR)
IF COND(&ERR_DEC = 0) THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('Command completed'))
ELSE CMD(SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) +
MSGDTA('Command failed. See low-level +
message for detail.') MSGTYPE(*ESCAPE))
EXIT: ENDPGM