/* ***************************************************************** */ /* PROGRAM: NETSERVER2 */ /* */ /* LANGUAGE: CL */ /* */ /* DESCRIPTION: List all netserver shares */ /* Method 1 is to use QZLSLSTI and a user space */ /* Method 2 is to use QZLSOLST to dump direct to pgm */ /* memory/variable. */ /* */ /* dxd 1.0 */ /* ***************************************************************** */ PGM /* PARM(&LIB &SPC) */ /* */ /* INPUT PARAMETERS */ /* */ DCL VAR(&LIB) TYPE(*CHAR) LEN(10) VALUE('QTEMP') DCL VAR(&SPC) TYPE(*CHAR) LEN(10) VALUE('QZLSLSTI') /* */ /* QZLSLSTI VARIABLES (method 1 - dump to user space */ /* */ /* USER SPACE VARIABLES */ DCL VAR(&USRSPC) TYPE(*CHAR) LEN(20) DCL VAR(&NUMITEMS) TYPE(*DEC) LEN(8 0) /* NUMBER + OF ITEMS RETURNED FROM LIST API */ DCL VAR(&BIN4) TYPE(*CHAR) LEN(4) /* NUMBER OF + LIST ENTRIES IN BINARY4 FORM */ DCL VAR(&ELEN) TYPE(*DEC) LEN(8 0) /* SIZE OF + ONE ENTRY IN DECIMAL 8,0 FORM */ DCL VAR(&ELENB) TYPE(*CHAR) LEN(4) /* SIZE of + one entry IN BINARY 4 FORM */ DCL VAR(&LEOFF8) TYPE(*DEC) LEN(8 0) /* OFFSET + TO LIST ENTRY IN DECIMAL 8,0 FORM */ DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(1188) /* One entry + for QZLS0100 */ /* */ /* QZLSOLST VARIABLES (method 2 - no user space) */ /* */ DCL VAR(&XRCVVAR) TYPE(*CHAR) LEN(4096) /* Must + be large enough to hold all the data */ DCL VAR(&LISTINFO) TYPE(*CHAR) LEN(64) /* LIST INFO structure */ DCL VAR(&XTOTALREC) TYPE(*DEC) LEN(8 0) DCL VAR(&XRECRET) TYPE(*DEC) LEN(8 0) DCL VAR(&XRECLEN) TYPE(*DEC) LEN(8 0) DCL VAR(&XTOTALRECB) TYPE(*CHAR) LEN(4) DCL VAR(&XRECRETB) TYPE(*CHAR) LEN(4) DCL VAR(&XRECLENB) TYPE(*CHAR) LEN(4) DCL VAR(&XRECLENB) TYPE(*CHAR) LEN(4) DCL VAR(&XFIRSTREC) TYPE(*CHAR) LEN(4) /* */ /* ZLSL0100 INFO */ /* */ DCL VAR(&SHARENAME) TYPE(*CHAR) LEN(12) DCL VAR(&DEVTYPEB) TYPE(*CHAR) LEN(4) DCL VAR(&DEVTYPE) TYPE(*DEC) LEN(8 0) DCL VAR(&PATHOFFB) TYPE(*CHAR) LEN(4) DCL VAR(&PATHLENB) TYPE(*CHAR) LEN(4) DCL VAR(&PATHOFF) TYPE(*DEC) LEN(8 0) DCL VAR(&PATHLEN) TYPE(*DEC) LEN(8 0) DCL VAR(&OUTQ) TYPE(*CHAR) LEN(20) DCL VAR(&SHAREDESC) TYPE(*CHAR) LEN(50) DCL VAR(&PATH) TYPE(*CHAR) LEN(1024) /* */ /* ZLSL0201 INFO */ /* */ DCL VAR(&SERVERNAME) TYPE(*CHAR) LEN(15) /*********************************************************************/ /* START OF EXECUTABLE CODE */ /*********************************************************************/ CHGVAR VAR(&USRSPC) VALUE(&SPC *CAT &LIB) /* */ /* DELETE USER SPACE IF IT ALREADY EXISTS */ /* */ CALL PGM(QUSDLTUS) PARM(&USRSPC '') MONMSG MSGID(CPF0000) /* */ /* CREATE USER SPACE */ /* */ CALL PGM(QUSCRTUS) PARM(&USRSPC 'CHGACTJOB ' + X'00040000' ' ' '*ALL ' 'QZLSLSTI + TEMP USER SPACE ') /* */ /* METHOD 1: LIST SERVER INFORMATION TO USER SPACE USING QZLSLISTI */ /* */ CALL PGM(QZLSLSTI) PARM(&USRSPC 'ZLSL0100' + '*ALL ' '') /* */ /* METHOD 2: LIST INFO DIRECT USING OPEN LIST (QZLSOLST) */ /* */ CALL PGM(QZLSOLST) PARM(&XRCVVAR X'00001000' + &LISTINFO 'ZLSL0100' '*ALL ' '' + '*ALL ') CHGVAR VAR(&XTOTALRECB) VALUE(%SST(&LISTINFO 1 4)) CHGVAR VAR(&XRECRETB) VALUE(%SST(&LISTINFO 5 4)) CHGVAR VAR(&XRECLENB) VALUE(%SST(&LISTINFO 9 4)) CHGVAR VAR(&XFIRSTREC) VALUE(%SST(&LISTINFO 37 4)) CHGVAR VAR(&XTOTALREC) VALUE(%BINARY(&XTOTALRECB)) CHGVAR VAR(&XRECRET) VALUE(%BINARY(&XRECRETB)) CHGVAR VAR(&XRECLEN) VALUE(%BINARY(&XRECLENB)) /* then parse info from rcvvar2 instead of from user space... */ /* sticking to the first method of using the user space... */ /* */ /* PARSE USER SPACE HEADER */ /* */ /* RETRIEVE NUMBER OF ENTRIES RETURNED as decimal */ CALL PGM(QUSRTVUS) PARM(&USRSPC X'00000085' + X'00000004' &BIN4) CHGVAR &NUMITEMS %BINARY(&BIN4) /* RETRIEVE LIST ENTRY LENGTH, CONVERT TO DECIMAL. */ CALL QUSRTVUS (&USRSPC X'00000089' X'00000004' + &ELENB) CHGVAR VAR(&ELEN) VALUE(%BINARY(&ELENB)) /* RETRIEVE LIST ENTRY OFFSET, CONVERT TO DECIMAL, AND ADD ONE */ /* TO SET THE POSITION. */ CALL PGM(QUSRTVUS) PARM(&USRSPC X'0000007D' + X'00000004' &BIN4) CHGVAR VAR(&LEOFF8) VALUE(%BINARY(&BIN4)) CHGVAR VAR(&LEOFF8) VALUE(&LEOFF8 + 1) STARTLOOP: IF (&NUMITEMS = 0) THEN(GOTO ALLDONE) /* GRAB DATA FROM THE ENTRY */ /* Assumes size of one entry is always x4A4 (1188) or lower */ CHGVAR VAR(%BINARY(&BIN4)) VALUE(&LEOFF8) CALL PGM(QUSRTVUS) PARM(&USRSPC &BIN4 X'000004A4' + &RCVVAR) /* parse out the share info */ CHGVAR VAR(&ELENB) VALUE(%SST(&RCVVAR 1 4)) CHGVAR VAR(&SHARENAME) VALUE(%SST(&RCVVAR 5 12)) CHGVAR VAR(&DEVTYPEB) VALUE(%SST(&RCVVAR 17 4)) CHGVAR VAR(&PATHOFFB) VALUE(%SST(&RCVVAR 37 4)) CHGVAR VAR(&PATHLENB) VALUE(%SST(&RCVVAR 41 4)) CHGVAR VAR(&SHAREDESC) VALUE(%SST(&RCVVAR 115 50)) CHGVAR VAR(&PATHOFF) VALUE(%BIN(&PATHOFFB)) CHGVAR VAR(&PATHLEN) VALUE(%BIN(&PATHLENB)) IF COND(%BIN(&DEVTYPEB) *EQ 1 ) THEN(DO) CHGVAR VAR(&OUTQ) VALUE(%SST(&RCVVAR 45 20)) SNDPGMMSG MSG('Print Share:' *CAT + &SHARENAME *CAT ' Desc:' *cat &SHAREDESC + *CAT ' OUTQ:' *CAT &OUTQ ) enddo /* if print share */ ELSE DO /* file share */ /* If disk share then parse path name */ CHGVAR VAR(&PATH) VALUE(%SST(&RCVVAR 165 + &PATHLEN)) /* ZLS0100 offset to path name is wrong in R450 but 100 is */ /* fioffset anyway so removed the offset */ /* CHGVAR VAR(&PATHOFF) VALUE(&PATHOFF + 1) */ /* CHGVAR VAR(&PATH) VALUE(%SST(&RCVVAR &PATHOFF + */ /* &PATHLEN)) */ SNDPGMMSG MSG('File Share:' *CAT + &SHARENAME *CAT ' Desc:' *cat &SHAREDESC + *CAT ' Path:' *CAT &PATH ) ENDDO /* end of if file share */ /* Bump for the next iteration */ /* API reference says: use the length of this entry field at the */ /* start of each entry to calculate the displacement to the next */ /* list enty */ CHGVAR VAR(&ELEN) VALUE(%BINARY(&ELENB)) CHGVAR VAR(&LEOFF8) VALUE(&LEOFF8 + &ELEN) CHGVAR VAR(&NUMITEMS) VALUE(&NUMITEMS - 1) GOTO CMDLBL(STARTLOOP) /* Exit */ ALLDONE: /* CALL PGM(QUSDLTUS) PARM(&USRSPC '') */ /* MONMSG MSGID(CPF0000) */ ENDPGM