©
unbekannterkünstler@newsgroup
Dieses Programm ermittelt für alle geöffneten Screens folgende Informationen
/* REXX */ /*THIS VERSION DOES NOT USE MODEL*/
/*--------------------------------------------------------------------*
BROWSE THROUGH ALL TCBS AND GET ID, SCRNAME, PANELID, APPLICATION
*--------------------------------------------------------------------*/
/* REXX */
ADDRESS ISPEXEC "CONTROL ERRORS RETURN"
SIGNAL ON ERROR
SIGNAL ON SYNTAX
/* GET ISPMAIN PARENT TASK TCB --------------------------- */
PSATOLD = PTR(X2D('21C')) /* GET CURRENT LEVEL REXX TCB */
TCBCURR = PTR(PSATOLD + X2D('84')) /* GO UP ONE LEVEL */
TCBOTC = PTR(TCBCURR + X2D('84')) /* GO UP ANOTHER LEVEL */
TCBLTC = PTR(TCBOTC + X2D('88')) /* GET THE FIRST CHILD TASK...
...ATTACHED BY THIS TASK */
/* LOOP FOR ALL ISPF TCBS AND GET SCREEN INFO ------------ */
TCB = TCBLTC
I = 0
DO WHILE (TCB /= 0)
SAY D2X(TCB)
I = I + 1
CALL GETSCREENINFO(TCB)
TCB = PTR(TCB + X2D('80')) /* READ SAME LEVEL NEXT TCB */
END
TCB = TCBLTC
I = 0
DO WHILE (TCB /= 0)
SAY D2X(TCB)
I = I + 1
CALL GETSCREENINFO(TCB)
TCB = PTR(TCB + X2D('80')) /* READ SAME LEVEL NEXT TCB */
END
/* CREATE THE * AND - BEFORE TLDID ----------------------- */
IF DATATYPE(CURRALTID,'N') THEN DO /* DO ALT FIRST AS FOR ONLY 1 */
I = SAVE.CURRALTID /* TLDID, CURRENT = ALT */
J = CURRALTID !! "-"
INTERPRET "ZTLDID"I " = J"
END
IF DATATYPE(CURRTLDID,'N') THEN DO
I = SAVE.CURRTLDID
J = CURRTLDID !! "*"
INTERPRET "ZTLDID"I " = J"
END
/* DISPLAY SWAP SCREEN ----------------------------------- */
ADDRESS ISPEXEC "ADDPOP"
ADDRESS ISPEXEC "DISPLAY PANEL(HSPSLIST)"
ADDRESS ISPEXEC "REMPOP"
/* PROCESS COMMAND ENTERED ------------------------------- */
SELECT
WHEN (RSEL>0)&(RSEL<9) THEN DO
TEMPSTR = " NUM = ZTLDID" !! SUBSTR(RSEL,2,1)
INTERPRET TEMPSTR
CMD = "SWAP " !! SUBSTR(NUM,1,1)
ADDRESS ISPEXEC "DISPLAY COMMAND(CMD)"
END
WHEN (RSEL="NA") THEN DO
ADDRESS ISPEXEC "SELECT PGM(ISPSTRT) PARM("ZNEWP")"
END
WHEN (RSEL="NS") THEN DO
ADDRESS ISPEXEC "SELECT PGM(ISPSTRT)"
END
OTHERWISE
END
/* EXIT -------------------------------------------------- */
EXIT:
SIGNAL OFF ERROR
EXIT 0
/* SUBROUTINES ------------------------------------------- */
ERROR:
CALL EXIT
SAY "SORRY MATE. ERROR="RC" CMD="CMD
CALL EXIT
PTR: RETURN C2D(STORAGE(D2X(ARG(1)),4))
STG: RETURN STORAGE(D2X(ARG(1)),ARG(2))
GETSCREENINFO:
TEMP = PTR(ARG(1) + X2D('70'))
TEMP = PTR(TEMP + X2D('18'))
TLD = PTR(TEMP + 0)
TLDID = STG(TLD + 3, 1) /* OUTPUT */
ALTID = STG(PTR(TLD + 4) + 3 , 1) /* OUTPUT */
APPID = STG(PTR(TLD + X2D('78')) + X2D('70'), 8) /* OUTPUT */
TRACE I
PANELID = STG(TLD + X2D('158'), 8) /* OUTPUT */
TRACE O
SCRNAME = STG(TLD + X2D('354'), 8) /* OUTPUT */
SCREENAREA = STG(PTR(TLD + X2D('60')), 80*5)
DSNAME = ""
/* SAVE INFO TO SHOW * AND - */
SAVE.TLDID = I
IF ARG(1) = TCBCURR THEN
DO
CURRTLDID = TLDID
CURRALTID = ALTID
END
/* IN EDIT/VIEW/BROSWSE SCREEN OR MEMBER LIST SCREEN */
IF (PANELID="ISREDDE2")!(PANELID="ISRUDSM")
THEN DO
POS1 = POS("COMMAND ===>",TRANSLATE(SCREENAREA)) - 80 + 10
DSNAME = SUBSTR(SCREENAREA,POS1,50)
PARSE VAR DSNAME DSNAME .
DSNAME = SUBSTR(DSNAME,2)
END
/* IN 3.4 LIST */
IF PANELID="ISRUDSL0"
THEN DO
POS1 = POS("DATA SETS MATCHING ",TRANSLATE(SCREENAREA)) + 18
DSNAME = SUBSTR(SCREENAREA,POS1,50)
PARSE VAR DSNAME DSNAME .
END
/* PUT INTO VARIABLES NOW .. USE THE TLDID TO PUSH INTO VARAIBLES*/
INTERPRET "ZTLDID"I " = TLDID "
INTERPRET "ZSCRNM"I " = SCRNAME "
INTERPRET "ZPANID"I " = PANELID "
INTERPRET "ZAPPID"I " = APPID "
INTERPRET "ZSESTZ"I " = LEFT(DSNAME,LENGTH(DSNAME)) "
RETURN 0 ;
SYNTAX:
SAY RC ERRORTEXT(RC)
SAY SIGL "-" SOURCELINE(SIGL)
TRACE ?R
NOP
EXIT
zurück zu The Power of REXX