* REGISTER CONVENTIONS = *
* R0 free *
* R1 free *
* R2 Base for Input parameters *
* R3 Base for code addressability *
* R4 Base for model name list *
* R5 Base for output parameter list *
* R6 Work register *
* R7 -----"------- *
* R8 -----"------- *
* R9 free *
* R10 Internal subroutine linkage return *
* R11 Base for EIB *
* R12 free *
* R13 Base for dynamic storage *
* R14 free *
* R15 free *
*
* SELECT MODEL
*
LH R6,TABLEN Number of valid netnames
LA R7,TABLE Address the table
*
LOOP1 CLC NETNAME(4),0(R7) Is this netname in table?
BE VALIDT
*
LA R7,16(R7) Next table entry
BCT R6,LOOP1
*
* Now we know its not a valid netname
* return and the logon is rejected
*
B RETURN
*
图 2。 如何定制 DFHZATDX 样本程序的示例 (部件 2)
* R7 now points to model name
VALIDT CLI SELECTED_MODELNAME,C' ' MTS model name supplied?
BNE VALIDM1 Yes
LH R6,MODELNAME_COUNT Count of models
LTR R6,R6 Were any presented?
BZ RETURN No
LA R8,MODELNAME First model name
*
LOOP2 CLC 8(8,R7),0(R8) Is this model name here?
BE VALIDM
*
LA R8,L'MODELNAME(R8) Next model name
BCT R6,LOOP2
*
* Now we know the required model name was not presented
* to this exit by CICS, a return rejects the logon
*
B RETURN
*
* At this point the model name was found in those presented
* It is given to CICS and the new termid is
* the netname
*
VALIDM MVC SELECTED_MODELNAME,0(R8) R8 was left pointing at
* model name
VALIDM1 DS 0H
MVC SELECTED_TERM_ID,NETNAME Use netname for termid
* (4 chars)
*
*
* SELECTIONS COMPLETE, RETURN
*
MVI SELECTED_RETURN_CODE,X'00' Indicate all OK
B RETURN Exit program
*
* Table of netnames allowed to log on and the model name
* necessary for the logon to be successful
*
* Format of table :
* Bytes 1 to 8 Netname allowed to log on
* 9 to 16 Model required for netname
*
DS 0D
TABLE DC CL8'L77A',CL8'3270064'
DC CL8'L77B',CL8'3270065'
TABLEN DC Y((*-TABLE)/16)
*
.
*
* Redefine the netname so that the last 4 characters (of 7)
* can be used to select the autoinstall model to be used.
*
* The netnames to be supplied are known to be of the form:
*
* HVMXNNN
*
* HVM is the prefix
* X is the system name
* NNN is the address of the terminal
*
01 NETNAME-BITS.
02 FIRST-CHRS PIC X(3).
02 NEXT-CHRS.
03 NODE-LETTER PIC X(1).
03 NODE-ADDRESS PIC X(3).
02 LAST-CHR PIC X(1).
.
.
PROCEDURE DIVISION.
.
.
*
* Select the autoinstall model to be used according to the
* node letter (see above). The models to be used are user
* defined.
*
* (It is assumed that the netname supplied in the commarea by CICS
* has been moved to NETNAME-BITS).
*
* If the node letter is C then use model AUTO2
* If the terminal netname is HVMC289 (a special case) then use
* model AUTO1.
* Otherwise (node letters A,B,D...) use model AUTO3.
*
IF NODE-LETTER = 'C' THEN MOVE 'AUTO2' TO SELECTED-MODELNAME.
IF NEXT-CHRS = 'C289' THEN MOVE 'AUTO1' TO SELECTED-MODELNAME.
IF NODE-LETTER = 'A' THEN MOVE 'AUTO3' TO SELECTED-MODELNAME.
IF NODE-LETTER = 'B' THEN MOVE 'AUTO3' TO SELECTED-MODELNAME.
IF NODE-LETTER = 'D' THEN MOVE 'AUTO3' TO SELECTED-MODELNAME.
.
.
DCL 1 CINIT BASED(INSTALL_CINIT_PTR),
2 CINIT_LENG FIXED BIN(15),
2 CINIT_RU CHAR(256);
DCL SAVE_CINIT CHAR(256);
/* Temp save area for CINIT RU */
DCL 1 SCRNSZ BASED(ADDR(SAVE_CINIT)),
2 SPARE CHAR(31),
/* Bypass first part of CINIT and reach */
/* into BIND image carried in CINIT */
2 DHGT BIT(8),
/* Screen default height in BIND PS area */
2 DWID BIT(8),
/* Screen default width in BIND PS area */
2 AHGT BIT(8),
/* Screen alternate height in BIND PS area */
2 AWID BIT(8);
/* Screen alternate width in BIND PS area */
DCL NAME CHAR(2);
/* Used to work up a screen model type */
DCL TERMID PIC'9999' INIT(1) STATIC;
/* Used to work up a unique termid */
DCL ENQ CHAR(8) INIT('AUTOPRG');
/* Used to prevent multiple access to termid */
/* If model name supplied by MTS, bypass model name selection */
IF SELECTED_MODELNAME ¬= ' '
THEN GO TO MODEL_EXIT;
/* Clear the CINIT save area and move in the */
/* z/OS Communications Server CINIT RU.*/
/* This is useful if you fail to recognize the model */
/* of terminal; provide a dump and analyze this data */
SAVE_CINIT = LOW(256);
SUBSTR(SAVE_CINIT,1,CINIT_LEN) = SUBSTR(CINIT_RU,1,CINIT_LEN);
图 5。 如何定制 DFHZPTDX 样本程序的示例 (部件 2)
/* Now access the screen PS area in the portion of the BIND
image presented in the CINIT RU */
/* using the screen alternate height as a guide to the model
of terminal attempting logon. If this cannot be determined
then default to the first model in the table */
SELECT (AHGT); /* NOW GET SCRN ALTERNATE HEIGHT */
WHEN (12) NAME = 'M1'; /* MODEL 1 */
WHEN (32) NAME = 'M3'; /* 3 */
WHEN (43) NAME = 'M4'; /* 4 */
WHEN (27) NAME = 'M5'; /* 5 */
OTHERWISE NAME = 'M2'; /* 2 */
END;
/* Search the model entries for a matching entry. */
/* The criterion here is that a model definition should*/
/* contain the chars M2 for a model 2, and so on. */
/* For example, L3270M2, L3270M5 */
/* TERMM2, TERMM5 */
IF MODELNAME_COUNT = 0
THEN GO TO EXIT;
DO I = 1 TO MODELNAME_COUNT;
IF INDEX(MODELNAME(I),NAME)
THEN GO TO FOUND_MODEL;
END;
NO_MODEL: /* Matching entry was not found, default to first model*/
SELECTED_MODELNAME = MODELNAME(1);
GO TO MODEL_EXIT;
FOUND_MODEL: /* Move the selected model name to the return area */
SELECTED_MODELNAME = MODELNAME(I);
MODEL_EXIT: /* ENQ to stop multiple updates of counter. */
/* A simple counter is used to generate unique */
/* terminal identities, so concurrent access to */
/* this counter is denied to ensure no two get */
/* the same identifier or update the counter. */
/* To use this method the program must be defined as resident.*/
EXEC CICS ENQ RESOURCE(ENQ);
SELECTED_TERMID = TERMID; /* Set SELECTED_TERMID to
count value */
TERMID = TERMID + 1; /* Increase the count value by 1 */
IF TERMID = 9999 THEN TERMID = 1; /* Reset if too large*/
EXEC CICS DEQ RESOURCE(ENQ);
NAME_EXIT:
INSTALL_RETURN_CODE = LOW(1);
/* Set stat field to X'00' to allow
logon to be processed */
GO TO EXIT;
END INSTALL;