|
S027:
PROCEDURE OPTIONS (MAIN);
DCL
1 RECEIVE_AREA,
2 KEY CHAR(9) INIT((9)' '),
2 NAME CHAR(21) INIT((21)' ');
DCL
1 SEND_AREA,
2 KEY CHAR(9) INIT((9)' '),
2 NAME CHAR(21) INIT((21)' '),
2 DATA CHAR(50) INIT((50)' ');
/*** error codes ***/
DCL NOT_FOUND CHAR(4) INIT('0001');
DCL INVALID_NAME CHAR(4) INIT('0002');
DCL MISC_ERROR CHAR(4) INIT('0003');
DCL ADDR BUILTIN;
DCL CSTG BUILTIN;
DCL HIGH BUILTIN;
DCL LOW BUILTIN;
DCL SUBSTR BUILTIN;
DCL STG BUILTIN;
DCL VERIFY BUILTIN;
DCL CONV_GONE BIT(1) INIT('0'B);
DCL CONFIRM_REQ BIT(1) INIT('0'B);
DCL DATA_COMPLETE BIT(1) INIT('0'B);
DCL INLEN FIXED BIN(31) INIT(30);
DCL RSC CHAR(6) INIT('TPFILE');
DCL SYNC FIXED BIN(15) INIT(0);
/*** Begin MAIN ***/
EXEC CICS HANDLE CONDITION NOTFND(L_NFD)
ERROR(L_ERR);
/* Receive attach from HP 3000. Equivalent to MCGetAllocate. */
EXEC CICS EXTRACT PROCESS SYNCLEVEL(SYNC);
RCV_LOOP:
DO WHILE ((CONV_GONE = '0'B) &
(CONFIRM_REQ = '0'B));
/* Until the partner TP deallocates the conversation or */
/* the partner TP issues MCConfirm to request confirmation, */
/* receive another 30-byte record with 9-digit key and 21-character name. */
EXEC CICS RECEIVE INTO(RECEIVE_AREA) LENGTH(INLEN);
/* If the partner TP deallocated, exit the receive loop. */
IF DFHEIBLK.EIBFREE = HIGH(1) THEN
DO;
CONV_GONE = '1'B;
LEAVE RCV_LOOP;
END;
/* If the partner TP called MCConfirm, exit the receive loop. */
IF DFHEIBLK.EIBCONF = HIGH(1) THEN
DO;
CONFIRM_REQ = '1'B;
LEAVE RCV_LOOP;
END;
/* If End-Of-Chain & DATA_COMPLETE & partner TP called MCPrepToRcv */
IF ( (DFHEIBLK.EIBEOC = HIGH(1)) &
(DFHEIBLK.EIBCOMPL = HIGH(1)) &
(DFHEIBLK.EIBRECV = LOW(1)) ) THEN
DO;
IF VERIFY(RECEIVE_AREA.KEY,'0123456789') = 0 THEN
DO;
/* Query the database for the key received from the remote TP. */
EXEC CICS ENQ RESOURCE(RSC) LENGTH(6);
EXEC CICS READ DATASET('TPFILE') INTO(SEND_AREA)
RIDFLD(RECEIVE_AREA.KEY);
EXEC CICS DEQ RESOURCE(RSC) LENGTH(6);
IF RECEIVE_AREA.NAME ¬ = SEND_AREA.NAME THEN
/* The above line contains a logicalnot or (NOT EQUAL) sign. */
/* If the name in the database doesn't match the name from the remote TP, */
/* issue an error code and call McPrepToRcv (INVITE WAIT). */
DO;
EXEC CICS SEND FROM(INVALID_NAME) INVITE WAIT;
END;
/* If names match, send the data record and call MCPrepToRcv (INVITE WAIT). */
ELSE DO;
EXEC CICS SEND FROM(SEND_AREA) INVITE WAIT;
END;
END;
/* Otherwise, report a misc. error and call MCPrepToRcv (INVITE WAIT). */
ELSE DO;
EXEC CICS DEQ RESOURCE(RSC) LENGTH(6);
L_ERR: EXEC CICS SEND FROM(MISC_ERROR) INVITE WAIT;
END;
END;
END RCV_LOOP;
/* If the partner TP called MCConfirm, */
/* respond with MCConfirmed (EXEC CICS ISSUE CONFIRMATION). */
L_BYE:
IF ((SYNC = 1) & (CONFIRM_REQ = '1'B)) THEN
DO;
EXEC CICS ISSUE CONFIRMATION;
CONFIRM_REQ = '0'B;
END;
/* If the remote TP deallocated, deallocate the local conversation. */
IF DFHEIBLK.EIBFREE = HIGH(1) THEN
DO;
EXEC CICS RETURN;
END;
/* If the key sent by the remote TP is not in the database, */
/* report an error, call MCPrepToRcv (INVITE WAIT), and */
/* return to the receive loop to receive another record. */
L_NFD:
DO;
EXEC CICS DEQ RESOURCE(RSC) LENGTH(6);
EXEC CICS SEND FROM(NOT_FOUND) INVITE WAIT;
GOTO RCV_LOOP;
END;
END S027;
¤ Dauer der Verarbeitung: 0.0 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
