©
markzelden@newsgroup
Das Programm zeigt mögliche Fehler in der APF-Liste im Speicher wie nicht existierende Dateien oder Volumes,
die nicht mehr existieren oder OFFLINE sind.
/* REXX *******************************************************/
/* AUTHOR: MARK ZELDEN */
/* */
/* APF AUTHORIZED LIBRARIES CHECKER REXX EXEC. */
/* */
/* THIS PROGRAM WILL REPORT ON VARIOUS ERRORS IN THE */
/* IN-STORAGE APF LIST, SUCH AS NON-EXISTENT DATA SETS OR */
/* VOLUMES THAT NO LONGER EXIST OR ARE NOT ONLINE. */
/* */
/* NOTE: THE DYNAMIC APF CODE IN THIS EXEC USES UNDOCUMENTED */
/* IBM CONTROL BLOCKS AND MAY BREAK AT ANY TIME! */
/* TESTED ON MVS ESA 4.3 UP TO OS/390 V2R6 */
/**************************************************************/
/* EXECUTION SYNTAX: */
/* */
/* TSO %APFVER */
/* */
/* ANY ERRORS ENCOUNTERED ARE DISPLAYED ON THE TERMINAL. */
/* */
/**************************************************************/
LASTUPD = '01/17/2001' /* DATE OF LAST UPDATE */
IF SYSVAR(SYSISPF)='ACTIVE' THEN ADDRESS ISREDIT "MACRO"
/*
TRACE ?R
TRACE ?I
TRACE ERR
*/
NUMERIC DIGITS 10
CVT = C2D(STORAGE(10,4)) /* POINT TO CVT */
CVTAUTHL = C2D(STORAGE(D2X(CVT + 484),4)) /* POINT TO AUTH LIB TBL*/
IF CVTAUTHL <> C2D('7FFFF001'X) THEN DO /* STATIC LIST ? */
NUMAPF = C2D(STORAGE(D2X(CVTAUTHL),2)) /* # APF LIBS IN TABLE */
APFOFF = 2 /* FIRST ENT IN APF TBL */
DO I = 1 TO NUMAPF
LEN = C2D(STORAGE(D2X(CVTAUTHL+APFOFF),1)) /* LENGTH OF ENTRY */
VOL.I = STORAGE(D2X(CVTAUTHL+APFOFF+1),6) /* VOLSER OF APF LIB */
DSN.I = STORAGE(D2X(CVTAUTHL+APFOFF+1+6),LEN-6) /*DSN OF APF LIB*/
APFOFF = APFOFF + LEN +1
END
END
ELSE DO /* DYNAMIC APF LIST VIA PROGXX */
ECVT = C2D(STORAGE(D2X(CVT + 140),4)) /* POINT TO CVTECVT */
ECVTCSVT = C2D(STORAGE(D2X(ECVT + 228),4)) /* POINT TO CSV TABLE */
APFA = C2D(STORAGE(D2X(ECVTCSVT + 12),4)) /* APFA */
AFIRST = C2D(STORAGE(D2X(APFA + 8),4)) /* FIRST ENTRY */
ALAST = C2D(STORAGE(D2X(APFA + 12),4)) /* LAST ENTRY */
LASTONE = 0 /* FLAG FOR END OF LIST */
NUMAPF = 1 /* TOT # OF ENTRIES IN LIST */
DO FOREVER
DSN.NUMAPF = STORAGE(D2X(AFIRST+24),44) /* DSN OF APF LIBRARY */
DSN.NUMAPF = STRIP(DSN.NUMAPF,T) /* REMOVE BLANKS */
CKSMS = STORAGE(D2X(AFIRST+4),1) /* DSN OF APF LIBRARY */
IF BITAND(CKSMS,'80'X) = '80'X THEN /* SMS DATA SET? */
VOL.NUMAPF = '*SMS* ' /* SMS CONTROL DSN */
ELSE VOL.NUMAPF = STORAGE(D2X(AFIRST+68),6) /* VOLSER OF APF LIB*/
IF SUBSTR(DSN.NUMAPF,1,1) <> X2C('00') , /* CHECK FOR DELETED */
THEN NUMAPF = NUMAPF + 1 /* APF ENTRY */
AFIRST = C2D(STORAGE(D2X(AFIRST + 8),4)) /* NEXT ENTRY */
IF LASTONE = 1 THEN LEAVE
IF AFIRST = ALAST THEN LASTONE = 1
END
NUMAPF = NUMAPF-1
END
/* WE NOW HAVE ALL OF THE APF ENTRIES */
SAY 'BEGINNING VERIFICATION OF IN-STORAGE APF LIST - PLEASE WAIT...'
QUEUE 'BEGINNING VERIFICATION OF IN-STORAGE APF LIST - PLEASE WAIT...'
SAY ' '
QUEUE ' '
ERRCNT = 0 /* ERROR COUNT */
DO I = 1 TO NUMAPF
IF VOL.I = '*SMS*' THEN ,
RETCODE = LISTDSI(''''DSN.I'''' NORECALL)
ELSE ,
RETCODE = LISTDSI(''''DSN.I'''' 'VOLUME('VOL.I')' NORECALL)
IF RETCODE <> 0 THEN DO
SAY 'ERROR ENCOUNTERED WHILE VERIFYING THE FOLLOWING DATASET:'
QUEUE 'ERROR ENCOUNTERED WHILE VERIFYING THE FOLLOWING DATASET:'
SAY DSN.I
QUEUE DSN.I
IF SYSREASON = 24 THEN DO
SAY DSN.I 'DOES NOT EXIST ON VOLUME 'VOL.I
QUEUE DSN.I 'DOES NOT EXIST ON VOLUME 'VOL.I
SAY ' '
QUEUE ' '
ERRCNT = ERRCNT + 1
END
ELSE DO
SAY SYSMSGLVL2
QUEUE SYSMSGLVL2
/* SAY 'REASON CODE IN SYSREASON = 'SYSREASON */
SAY ' '
QUEUE ' '
ERRCNT = ERRCNT + 1
END
ITERATE /* GET NEXT RECORD */
END /* IF RETCODE */
END /* DO I = 1 TO NUMAPF */
IF ERRCNT = 0 THEN DO
SAY 'THE IN-STORAGE APF LIST HAD NO ERRORS'
QUEUE 'THE IN-STORAGE APF LIST HAD NO ERRORS'
END
ELSE DO
SAY 'THE IN-STORAGE APF LIST HAD 'ERRCNT' ERROR(S)'
QUEUE 'THE IN-STORAGE APF LIST HAD 'ERRCNT' ERROR(S)'
END
/*********************************************************************/
/* IF ISPF IS ACTIVE, BROWSE OUTPUT - OTHERWISE END */
/*********************************************************************/
QUEUE '' /* NULL QUEUE TO END STACK */
IF SYSVAR(SYSISPF)='ACTIVE' THEN DO
ADDRESS ISPEXEC "CONTROL ERRORS RETURN"
ADDRESS ISPEXEC "VGET ZENVIR"
ADDRESS TSO
PREFIX = SYSVAR('SYSPREF') /* TSO PROFILE PREFIX */
UID = SYSVAR('SYSUID') /* TSO USERID */
IF PREFIX = '' THEN PREFIX = UID /* USE UID IF NULL PREFIX */
IF PREFIX <> '' & PREFIX <> UID THEN /* DIFFERENT PREFIX THAN UID */
PREFIX = PREFIX !! '.' !! UID /* USE PREFIX.UID */
DDNM1 = 'DD'!!RANDOM(1,99999) /* CHOOSE RANDOM DDNAME */
DDNM2 = 'DD'!!RANDOM(1,99999) /* CHOOSE RANDOM DDNAME */
JUNK = MSG(OFF)
"ALLOC FI("!!DDNM1!!") UNIT(SYSALLDA) NEW TRACKS SPACE(2,1) DELETE",
" REUSE LRECL(80) RECFM(F B) BLKSIZE(3120)"
"ALLOC FI("!!DDNM2!!") UNIT(SYSALLDA) NEW TRACKS SPACE(1,1) DELETE",
" REUSE LRECL(80) RECFM(F B) BLKSIZE(3120) DIR(1)",
" DA('"!!PREFIX!!".APFVER." !!DDNM2!! ".ISPPLIB')"
JUNK = MSG(ON)
NEWSTACK
/*************************/
/* APFVERP PANEL SOURCE */
/*************************/
IF SUBSTR(ZENVIR,6,1) >= 4 THEN
QUEUE ")PANEL KEYLIST(ISRSPBC,ISR)"
QUEUE ")ATTR"
QUEUE " _ TYPE(INPUT) INTENS(HIGH) COLOR(TURQ) CAPS(OFF)" ,
"FORMAT(&MIXED)"
QUEUE " ! AREA(DYNAMIC) EXTEND(ON) SCROLL(ON)"
QUEUE " + TYPE(TEXT) INTENS(LOW) COLOR(BLUE)"
QUEUE " @ TYPE(TEXT) INTENS(LOW) COLOR(TURQ)"
QUEUE " % TYPE(TEXT) INTENS(HIGH) COLOR(GREEN)"
QUEUE " ! TYPE(OUTPUT) INTENS(HIGH) COLOR(TURQ) PAD(-)"
QUEUE " 01 TYPE(DATAOUT) INTENS(LOW)"
QUEUE " 02 TYPE(DATAOUT) INTENS(HIGH)"
QUEUE " 0B TYPE(DATAOUT) INTENS(HIGH) FORMAT(DBCS)"
QUEUE " 0C TYPE(DATAOUT) INTENS(HIGH) FORMAT(EBCDIC)"
QUEUE " 0D TYPE(DATAOUT) INTENS(HIGH) FORMAT(&MIXED)"
QUEUE " 10 TYPE(DATAOUT) INTENS(LOW) FORMAT(DBCS)"
QUEUE " 11 TYPE(DATAOUT) INTENS(LOW) FORMAT(EBCDIC)"
QUEUE " 12 TYPE(DATAOUT) INTENS(LOW) FORMAT(&MIXED)"
QUEUE ")BODY EXPAND(//)"
QUEUE "%BROWSE @&ZTITLE / / %LINE!ZLINES %COL!ZCOLUMS+"
QUEUE "%COMMAND ===>_ZCMD / / %SCROLL ===>_Z +"
QUEUE "!ZDATA ---------------/ /-------------------------!"
QUEUE "! / / !"
QUEUE "! --------------------/-/-------------------------!"
QUEUE ")INIT"
QUEUE " .HELP = ISR10000"
QUEUE " .ZVARS = 'ZSCBR'"
QUEUE " &ZTITLE = 'MARK''S MVS UTILITIES - APFVER'"
QUEUE " &MIXED = MIX"
QUEUE " IF (&ZPDMIX = N)"
QUEUE " &MIXED = EBCDIC"
QUEUE " VGET (ZSCBR) PROFILE"
QUEUE " IF (&ZSCBR = ' ')"
QUEUE " &ZSCBR = 'CSR'"
QUEUE ")REINIT"
QUEUE " REFRESH(ZCMD,ZSCBR,ZDATA,ZLINES,ZCOLUMS)"
QUEUE ")PROC"
QUEUE " &ZCURSOR = .CURSOR"
QUEUE " &ZCSROFF = .CSRPOS"
QUEUE " &ZLVLINE = LVLINE(ZDATA)"
QUEUE " VPUT (ZSCBR) PROFILE"
QUEUE ")END"
QUEUE ""
"ALLOC FILE(APFVERP) SHR REUSE",
" DA('"!!PREFIX!!".APFVER." !!DDNM2!! ".ISPPLIB(APFVERP)')"
"EXECIO * DISKW APFVERP (FINIS"
"FREE FI(APFVERP)"
DELSTACK
"EXECIO * DISKW" DDNM1 "(FINIS"
IF ERRCNT = 0 THEN ZEDSMSG = 'NO ERRORS'
ELSE ZEDSMSG = ERRCNT 'ERROR(S)'
ZEDLMSG = 'APFVER - LAST UPDATED ON' ,
LASTUPD !!'. WRITTEN BY' ,
'MARK ZELDEN. MARK''S MVS UTILITIES -' ,
'HTTP://HOME.FLASH.NET/~MZELDEN/MVSUTIL.HTML'
ADDRESS ISPEXEC "LIBDEF ISPPLIB LIBRARY ID("!!DDNM2!!") STACK"
ADDRESS ISPEXEC "SETMSG MSG(ISRZ000)" /* MSG - NO ALARM */
ADDRESS ISPEXEC "LMINIT DATAID(TEMP) DDNAME("!!DDNM1!!")"
ADDRESS ISPEXEC "BROWSE DATAID("!!TEMP") PANEL(APFVERP)"
ADDRESS ISPEXEC "LMFREE DATAID("!!TEMP")"
ADDRESS ISPEXEC "LIBDEF ISPPLIB"
JUNK = MSG(OFF)
"FREE FI("!!DDNM1!!")"
"FREE FI("!!DDNM2!!")"
END
ELSE DELSTACK /* EMPTY STACK FOR NON-ISPF INVOCATION */
EXIT
zurück zu The Power of REXX