In this section: |
The IWAYEVT0 sample program (iwayevt0.cobol) is a sample program that tests event handling in the iWay Transaction Adapter for IMS. It is identical to the version that is packaged with the iWay Transaction Adapter for CICS, only modified to run on IMS.
The IWAYEVT0 sample program and related program files are located in the following directory:
<iway_home>\etc\samples\ims\iwayevt0
where:
Is the location on your system where iWay Service Manager is installed.
The following subdirectories are included for the IWAYEVT0 sample program:
The cobolfd subdirectory contains the COBOL copybook (IWAYEVT0_IN.CBL) to map the data that is sent from IMS.
The src subdirectory contains the COBOL program (IWAYEVT0.COBOL).
The following is the structure of the COBOL program (IWAYEVT0.COBOL):
CBL TRUNC(BIN) ID DIVISION. PROGRAM-ID. IWAYEVT0. *************************************************************** * IWAYEVT0 - THIS SAMPLE PROGRAM DEMONSTRATES SENDING A * * RECORD TO THE IWAY IMS ADAPTER USING CICS SOCKETS. NO * * RESPONSE IS RETURNED. DATA RECORDS MAPPED BY COPYBOOKS * * MUST EACH BE PRECEDED BY A 4 BYTE BINARY LENGTH. * * * * THE IMS ADAPTER MUST BE CONFIGURED WITH AN EVENT TO * * RECEIVE THIS DATA. SELECT "IS LENGTH PREFIX", SYNCHRON- * * IZATION TYPE "REQUEST", AND USE IWAYEVT0.CBL AS THE * * PREPARSER FD. HOST AND PORT MUST MATCH THE VALUES SET * * BELOW. * * * * THE EZASOKET INTERFACE IS DOCUMENTED IN THE Z/OS * * COMMUNICATIONS SERVER IP CICS SOCKETS GUIDE. * * * * USES: IWAYEVT0_IN.CBL (INPUT RECORD) * * * *************************************************************** ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. 77 GU PIC X(04) VALUE 'GU '. 77 CHNG PIC X(04) VALUE 'CHNG'. 77 ISRT PIC X(04) VALUE 'ISRT'. 01 SOCKET-GROUP. 05 SOC-FUNCTION PIC X(16) VALUE SPACES. 05 ERRNO PIC 9(8) BINARY VALUE ZEROES. 05 RETCODE PIC S9(8) BINARY VALUE ZEROES. 05 AF PIC 9(8) BINARY VALUE 2. 05 SOCTYPE PIC 9(8) BINARY VALUE 1. 05 PROTO PIC 9(8) BINARY VALUE 0. 05 NAMELEN PIC 9(8) BINARY. 05 HOSTNAME PIC X(255). 05 HOSTENT POINTER. 05 NAME. 10 FAMILY PIC 9(4) BINARY VALUE 2. 10 PORT PIC 9(4) BINARY. 10 IP-ADDRESS PIC 9(8) BINARY. 10 IP-ADDRESS-ALPHA REDEFINES IP-ADDRESS PIC X(4). 10 RESERVED PIC X(8) VALUE LOW-VALUES. 05 FLAGS PIC 9(8) BINARY VALUE 0. 05 SOCKET PIC 9(4) BINARY.
05 NBYTE PIC 9(8) BINARY. 05 CMD PIC 9(8) BINARY. 05 REQARG PIC 9(8) BINARY. 01 WORKAREA. 05 LLEN PIC 9(8) BINARY VALUE 4. 05 ERRMSG PIC X(41) VALUE 'ERROR ENCOUNTERED DURING '. 05 TMSG PIC X(44) VALUE 'EVENTCBL: RECORD TRANSMISSION WAS SUCCESSFUL'. *************************************************************** * SAMPLE INBOUND DATA RECORD WITH VARIOUS COBOL TYPES. * *************************************************************** 01 INBOUND-RECORD. 05 ALPHA01 PIC X(8) VALUE 'ABCDEFGH'. 05 INT01 PIC S9(4) BINARY VALUE 25. 05 PACK01 PIC S9(15) PACKED-DECIMAL VALUE 50. 05 ZONE01 PIC 9(4) VALUE 75. 01 MSG-OUT. 05 IMS-LL PIC 9(4) BINARY VALUE 70. 05 IMS-ZZ PIC 9(4) BINARY. 05 MSG PIC X(70). 01 PARM-IN. 05 SLEN PIC S9(4) BINARY. 05 SCRN-IOA PIC X(255). LINKAGE SECTION. 01 HOSTENT-STRUCT. 05 HOSTNAME-PTR POINTER. 05 HOSTALIASL-PTR POINTER. 05 HOSTFAMILY PIC S9(8) BINARY. 05 HOSTADR-LEN PIC S9(8) BINARY. 05 HOSTADRL-PTR POINTER. 01 HOST-ENTRY-PTR POINTER. 01 HOST-ENTRY PIC 9(8) BINARY. ********************************************************* * I/O PCB * ********************************************************* 01 IOPCB. 05 LTERM PIC X(08). 05 FILLER PIC X(02). 05 IOPCB-STATUS PIC X(02). 05 FILLER PIC X(28). PROCEDURE DIVISION. MAINLINE. ENTRY 'DLITCBL' USING IOPCB PERFORM GETPARM *************************************************************** * CHANGE HOSTNAME AND PORT TO SITE SPECIFIC LOCATION OF THE * * CICS ADAPTER. * *************************************************************** MOVE 'YOUR.DNS.NAME' TO HOSTNAME MOVE 4772 TO PORT PERFORM GETSOCK PERFORM GETHOSTBYNAME PERFORM SETBLOCK PERFORM CONNECTTOHOST PERFORM SENDDATA PERFORM CLOSESOCK MOVE SPACE TO MSG MOVE TMSG TO MSG CALL 'CBLTDLI' USING ISRT, IOPCB, MSG-OUT GOBACK. GETPARM. CALL 'CBLTDLI' USING GU, IOPCB, SCRN-IOA IF IOPCB-STATUS NOT = SPACES PERFORM WRITERR-EXIT END-IF * DISPLAY 'INPUT PARM: ' SCRN-IOA . GETSOCK. MOVE 'SOCKET ' TO SOC-FUNCTION CALL 'EZASOKET' USING SOC-FUNCTION, AF, SOCTYPE, PROTO, ERRNO, RETCODE MOVE RETCODE TO SOCKET IF RETCODE < 0 PERFORM WRITERR-EXIT END-IF. GETHOSTBYNAME. MOVE 'GETHOSTBYNAME ' TO SOC-FUNCTION MOVE LENGTH OF HOSTNAME TO NAMELEN CALL 'EZASOKET' USING SOC-FUNCTION NAMELEN HOSTNAME HOSTENT RETCODE IF RETCODE EQUAL ZERO SET ADDRESS OF HOSTENT-STRUCT TO HOSTENT SET ADDRESS OF HOST-ENTRY-PTR TO HOSTADRL-PTR SET ADDRESS OF HOST-ENTRY TO HOST-ENTRY-PTR ELSE PERFORM WRITERR-EXIT END-IF. SETBLOCK. MOVE 'FCNTL ' TO SOC-FUNCTION MOVE 4 TO CMD MOVE 0 TO REQARG CALL 'EZASOKET' USING SOC-FUNCTION, SOCKET, CMD, REQARG, ERRNO, RETCODE. CONNECTTOHOST. MOVE HOST-ENTRY TO IP-ADDRESS MOVE 'CONNECT ' TO SOC-FUNCTION CALL 'EZASOKET' USING SOC-FUNCTION, SOCKET, NAME, ERRNO, RETCODE IF RETCODE = 0 CONTINUE ELSE PERFORM WRITERR-EXIT END-IF. SENDDATA. *************************************************************** * PRECEDE THE RECORD WITH 4 BYTE BINARY RECORD LENGTH * *************************************************************** MOVE 'SEND ' TO SOC-FUNCTION MOVE LENGTH OF INBOUND-RECORD TO NBYTE MOVE 4 TO LLEN MOVE 0 TO RETCODE CALL 'EZASOKET' USING SOC-FUNCTION, SOCKET, FLAGS, LLEN, NBYTE, ERRNO, RETCODE IF RETCODE = -1 PERFORM WRITERR-EXIT END-IF *************************************************************** * SEND THE ACTUAL RECORD * *************************************************************** CALL 'EZASOKET' USING SOC-FUNCTION, SOCKET, FLAGS, NBYTE, INBOUND-RECORD, BY REFERENCE ERRNO, RETCODE IF RETCODE = -1 PERFORM WRITERR-EXIT END-IF . CLOSESOCK. MOVE ZEROES TO RETCODE ERRNO MOVE 'CLOSE ' TO SOC-FUNCTION CALL 'EZASOKET' USING SOC-FUNCTION, SOCKET, ERRNO, RETCODE IF RETCODE < 0 PERFORM WRITERR-EXIT END-IF. WRITERR-EXIT. MOVE SOC-FUNCTION TO ERRMSG(26:15) DISPLAY 'ERROR IN PROGRAM FUNCTION: ' ERRMSG.
iWay Software |