Sign in

docs Examples

zipclp

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