TCP/IP Programming Examples › COBOL Examples › COBOL TCP/IP Client Program
COBOL TCP/IP Client Program
RETRIEVAL
NO-ACTIVITY-LOG
DMLIST
*****************************************************************
The following program is an example of a TCP/IP client *
program written in COBOL. *
The processing is the following: *
- Create a socket for the client program. *
- Convert the known dotted string format IPA to binary. *
- Find host information for connection. *
- Establish a connection to the host listener. *
- Send message 1 to the listener (first 4 bytes = data length)*
- Read message 1 from listener (first 4 bytes = data length) *
- Send message 2 to the listener (first 4 bytes = data length)*
- Read message 2 from listener (first 4 bytes = data length) *
- Close socket and exit. *
*****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. COBCLI.
ENVIRONMENT DIVISION.
IDMS-CONTROL SECTION.
PROTOCOL. MODE IS IDMS-DC DEBUG
IDMS-RECORDS MANUAL.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 COPY IDMS SUBSCHEMA-CTRL.
01 COPY IDMS SOCKET-LISTENER-PARMS.
01 COPY IDMS SOCKET-SOCKADDR-IN6.
01 COPY IDMS SOCKET-TIMEVAL.
01 COPY IDMS RECORD SOCKET-CALL-INTERFACE.
01 COPY IDMS RECORD SOCKET-MISC-DEFINITIONS.
01 SOCKADDR1.
02 COPY IDMS RECORD SOCKET-SOCKADDR-IN.
01 SOCKET-DESCRIPTOR PIC S9(8) COMP.
*****************************************************************
Modify DEST-PORT and IPA-HOST to connect to desired server *
*****************************************************************
01 DEST-PORT PIC 9(8) VALUE 12345.
01 IPAHOST-REC.
02 IPA-HOST PIC X(12) VALUE '255.255.25.2'.
02 FILLER PIC X(4) VALUE SPACES.
02 IPA-HOSTL PIC S9(8) COMP VALUE 16.
01 HOSTENTP USAGE IS POINTER.
01 WK1 PIC S9(8) COMP.
01 WK2 PIC S9(8) COMP.
01 WK3 PIC S9(8) COMP.
01 WK-SUBSCRIPT PIC S9(4) COMP.
01 WK-LENGTH PIC S9(8) COMP.
01 RETLEN PIC S9(8) COMP VALUE 0.
01 TERM-FLAG PIC S9(8) COMP VALUE 0.
01 ERROR-COUNT PIC S9(8) COMP VALUE 0.
01 BUFFER.
03 BUFFER-ARRAY PIC X(1) OCCURS 84 TIMES.
01 BUFFER-REDEF REDEFINES BUFFER.
03 BUFLEN PIC 9(8) COMP.
03 BUFTXT80 PIC X(80).
03 BUFTXT80-REDEF1 REDEFINES BUFTXT80.
05 BUFTXT04 PIC X(4).
05 BUFTXT76 PIC X(76).
03 BUFTXT80-REDEF2 REDEFINES BUFTXT80.
05 BUFTXT-MSG PIC X(41).
05 BUFTXT-BLANK PIC X(1).
05 BUFTXT-FILLER PIC X(38).
01 WORKW.
03 WORK-WCC PIC X.
03 WORK PIC X(80).
03 WORK-REDEF1 REDEFINES WORK.
04 WORK-ARRAY PIC X(1) OCCURS 80 TIMES.
03 WORK-REDEF2 REDEFINES WORK.
04 WORKNUM PIC 9(8) DISPLAY.
04 WORK-FILLER1 PIC X(72).
01 IPADDR-REC.
02 IPADDRBUFL PIC S9(8) COMP VALUE 16.
02 IPADDRRETL PIC S9(8) COMP.
02 IPADDRBUF PIC X(16).
01 RETURN-CODES.
02 RETCD PIC S9(8) COMP.
02 ERRNO PIC S9(8) COMP.
02 RSNCD PIC S9(8) COMP.
01 MSG01 PIC X(18) VALUE ' Creating Socket.'.
01 MSG02 PIC X(13) VALUE ' Connecting: '.
01 MSG03 PIC X(19) VALUE ' Socket return code'.
01 MSG04 PIC X(16) VALUE ' Starting read.'.
01 MSG05 PIC X(16) VALUE ' Starting write.'.
01 MSG06 PIC X(16) VALUE ' Closing Socket.'.
01 MSG07 PIC X(19) VALUE ' Socket reason code'.
01 MSG08 PIC X(19) VALUE ' Socket errno '.
01 MSG10 PIC X(08) VALUE ' Buffer:'.
01 MSG11 PIC X(22) VALUE ' Data length too long.'.
01 MSG12 PIC X(19) VALUE ' Calling INET_PTON.'.
01 MSG13 PIC X(23) VALUE ' Calling GETHOSTBYADDR.'.
01 MSG97 PIC X(24) VALUE ' Socket call successful.'.
01 MSG98 PIC X(19) VALUE ' Socket call error.'.
01 MSG99.
02 MSG99-1 PIC X(28) VALUE ' Program COBCLI terminated.'.
02 MSG99-2 PIC X(15) VALUE ' Error count = '.
02 MSG99-3 PIC 9(4) DISPLAY.
01 HOSTIPA PIC 9(8) COMP.
LINKAGE SECTION.
01 COPY IDMS RECORD SOCKET-HOSTENT.
01 AINFO1.
05 COPY IDMS RECORD SOCKET-ADDRINFO.
PROCEDURE DIVISION.
*****************************************************************
Create a socket in the communications domain *
*****************************************************************
*
TCP-CLIENT-SOCKET.
*
WRITE LOG MESSAGE ID 9060300
PARMS FROM MSG01 LENGTH 18.
CALL 'IDMSOCKI' USING SOCKET-FUNCTION-SOCKET,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
SOCKET-FAMILY-AFINET,
SOCKET-TYPE-STREAM,
SOCKET-PROTOCOL-TCP,
SOCKET-DESCRIPTOR.
PERFORM TCP-CLIENT-CHECKRC THRU TCP-CLIENT-CHECKRC-EXIT.
IF TERM-FLAG = 1
PERFORM TCP-CLIENT-CLOSE THRU TCP-CLIENT-CLOSE-EXIT
GO TO TCP-CLIENT-EXIT.
*****************************************************************
Convert the IP address from dotted string format to binary. *
*****************************************************************
TCP-CLIENT-INETPTON.
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG12 LENGTH 19.
CALL 'IDMSOCKI' USING SOCKET-FUNCTION-INETPTON,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
SOCKET-FAMILY-AFINET,
IPA-HOST,
IPA-HOSTL,
HOSTIPA.
PERFORM TCP-CLIENT-CHECKRC THRU TCP-CLIENT-CHECKRC-EXIT.
*****************************************************************
Take the IP address and domain and resolve it through a name *
server. If successful, return the information in a HOSTENT *
structure. *
*****************************************************************
TCP-CLIENT-GETHOST.
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG13 LENGTH 23.
CALL 'IDMSOCKI' USING SOCKET-FUNCTION-GETHOSTBYADDR,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
HOSTIPA,
SOCKET-IPADDR4L,
SOCKET-FAMILY-AFINET,
HOSTENTP.
PERFORM TCP-CLIENT-CHECKRC THRU TCP-CLIENT-CHECKRC-EXIT.
SET ADDRESS OF SOCKET-HOSTENT TO HOSTENTP.
TCP-CLIENT-CONNECT.
SET ADDRESS OF SOCKET-HOSTENT TO HOSTENTP.
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG02 LENGTH 13.
MOVE SOCKET-FAMILY-AFINET TO SIN-FAMILY OF SOCKADDR1.
MOVE DEST-PORT TO SIN-PORT-NUMBER OF SOCKADDR1.
MOVE HOSTIPA TO SIN-ADDRESS OF SOCKADDR1.
MOVE LOW-VALUES TO SIN-ZEROS OF SOCKADDR1.
CALL 'IDMSOCKI' USING SOCKET-FUNCTION-CONNECT,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
SOCKET-DESCRIPTOR,
SOCKADDR1,
SOCKADDR-IN-LENGTH.
PERFORM TCP-CLIENT-CHECKRC THRU TCP-CLIENT-CHECKRC-EXIT.
IF TERM-FLAG = 1
PERFORM TCP-CLIENT-CLOSE THRU TCP-CLIENT-CLOSE-EXIT
GO TO TCP-CLIENT-EXIT.
TCP-CLIENT-BUILD.
*
*****************************************************************
Build and send first message to DEST-PORT *
*****************************************************************
MOVE 'COBCLI - TCP/IP test message number 00001'
TO BUFTXT-MSG.
MOVE ' ' TO BUFTXT-BLANK.
MOVE 41 TO BUFLEN.
MOVE 45 TO WK-LENGTH.
MOVE 1 TO WK-SUBSCRIPT.
PERFORM TCP-CLIENT-WRITE THRU TCP-CLIENT-WRITE-EXIT.
IF TERM-FLAG = 1 GO TO TCP-CLIENT-EXIT.
*****************************************************************
Read the response from DEST-PORT *
*****************************************************************
MOVE 4 TO WK-LENGTH.
MOVE 0 TO BUFLEN.
MOVE 1 TO WK-SUBSCRIPT.
PERFORM TCP-CLIENT-READ THRU TCP-CLIENT-READ-EXIT.
IF TERM-FLAG = 1 GO TO TCP-CLIENT-EXIT.
IF BUFLEN GREATER THAN 80
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG11 LENGTH 22
PERFORM TCP-CLIENT-CLOSE THRU TCP-CLIENT-CLOSE-EXIT
GO TO TCP-CLIENT-EXIT.
MOVE BUFLEN TO WK-LENGTH.
MOVE 5 TO WK-SUBSCRIPT.
PERFORM TCP-CLIENT-READ THRU TCP-CLIENT-READ-EXIT.
IF TERM-FLAG = 1 GO TO TCP-CLIENT-EXIT.
MOVE BUFTXT80 TO WORK.
MOVE BUFLEN TO WK1.
ADD 1 TO WK1.
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG10 LENGTH 8
FROM WORKW LENGTH WK1.
*****************************************************************
Build and send second message to DEST-PORT *
*****************************************************************
MOVE 'COBCLI - TCP/IP test message number 00002'
TO BUFTXT-MSG.
MOVE ' ' TO BUFTXT-BLANK.
MOVE 41 TO BUFLEN.
MOVE 45 TO WK-LENGTH.
MOVE 1 TO WK-SUBSCRIPT.
PERFORM TCP-CLIENT-WRITE THRU TCP-CLIENT-WRITE-EXIT.
IF TERM-FLAG = 1 GO TO TCP-CLIENT-EXIT.
*****************************************************************
Read the response from DEST-PORT *
*****************************************************************
MOVE 4 TO WK-LENGTH.
MOVE 0 TO BUFLEN.
MOVE 1 TO WK-SUBSCRIPT.
PERFORM TCP-CLIENT-READ THRU TCP-CLIENT-READ-EXIT.
IF TERM-FLAG = 1 GO TO TCP-CLIENT-EXIT.
IF BUFLEN GREATER THAN 80
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG11 LENGTH 22
PERFORM TCP-CLIENT-CLOSE THRU TCP-CLIENT-CLOSE-EXIT
GO TO TCP-CLIENT-EXIT.
MOVE BUFLEN TO WK-LENGTH.
MOVE 5 TO WK-SUBSCRIPT.
PERFORM TCP-CLIENT-READ THRU TCP-CLIENT-READ-EXIT.
IF TERM-FLAG = 1 GO TO TCP-CLIENT-EXIT.
MOVE BUFTXT80 TO WORK.
MOVE BUFLEN TO WK1.
ADD 1 TO WK1.
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG10 LENGTH 8
FROM WORKW LENGTH WK1.
TCP-CLIENT-CLOSE-IT.
*****************************************************************
Close the socket and exit *
*****************************************************************
PERFORM TCP-CLIENT-CLOSE THRU TCP-CLIENT-CLOSE-EXIT.
GO TO TCP-CLIENT-EXIT.
TCP-CLIENT-EXIT.
MOVE ERROR-COUNT TO MSG99-3.
WRITE LINE TO TERMINAL FROM MSG99 LENGTH 48.
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG99 LENGTH 48.
GOBACK.
*
*****************************************************************
Procedure to read a message from DEST-PORT *
*****************************************************************
TCP-CLIENT-READ.
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG04 LENGTH 15.
PERFORM UNTIL WK-LENGTH = 0
CALL 'IDMSOCKI' USING SOCKET-FUNCTION-READ,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
SOCKET-DESCRIPTOR,
BUFFER-ARRAY(WK-SUBSCRIPT),
WK-LENGTH,
RETLEN
PERFORM TCP-CLIENT-CHECKRC THRU TCP-CLIENT-CHECKRC-EXIT
IF TERM-FLAG = 1 OR RETLEN = 0
PERFORM TCP-CLIENT-CLOSE THRU TCP-CLIENT-CLOSE-EXIT
GO TO TCP-CLIENT-READ-EXIT
END-IF
ADD RETLEN TO WK-SUBSCRIPT
SUBTRACT RETLEN FROM WK-LENGTH
END-PERFORM.
TCP-CLIENT-READ-EXIT.
EXIT.
*****************************************************************
Procedure to send a message to DEST_PORT *
*****************************************************************
TCP-CLIENT-WRITE.
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG05 LENGTH 16.
PERFORM UNTIL WK-LENGTH = 0
CALL 'IDMSOCKI' USING SOCKET-FUNCTION-WRITE,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
SOCKET-DESCRIPTOR,
BUFFER-ARRAY(WK-SUBSCRIPT),
WK-LENGTH,
RETLEN
PERFORM TCP-CLIENT-CHECKRC THRU TCP-CLIENT-CHECKRC-EXIT
IF TERM-FLAG = 1 OR RETLEN = 0
PERFORM TCP-CLIENT-CLOSE THRU TCP-CLIENT-CLOSE-EXIT
GO TO TCP-CLIENT-WRITE-EXIT
END-IF
ADD RETLEN TO WK-SUBSCRIPT
SUBTRACT RETLEN FROM WK-LENGTH
END-PERFORM.
TCP-CLIENT-WRITE-EXIT.
EXIT.
*****************************************************************
Procedure to close the socket *
*****************************************************************
TCP-CLIENT-CLOSE.
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG06 LENGTH 16.
CALL 'IDMSOCKI' USING SOCKET-FUNCTION-CLOSE,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
SOCKET-DESCRIPTOR.
PERFORM TCP-CLIENT-CHECKRC THRU TCP-CLIENT-CHECKRC-EXIT.
TCP-CLIENT-CLOSE-EXIT.
EXIT.
*****************************************************************
Procedure to check the return codes *
*****************************************************************
TCP-CLIENT-CHECKRC.
MOVE SOCKET-RETCD TO RETCD.
MOVE SOCKET-ERRNO TO ERRNO.
MOVE SOCKET-RSNCD TO RSNCD.
IF RETCD NOT = 0
MOVE 1 TO TERM-FLAG
ADD 1 TO ERROR-COUNT
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG98 LENGTH 19
SNAP FROM RETURN-CODES LENGTH 12
ELSE
MOVE 0 TO TERM-FLAG
WRITE LOG MESSAGE ID 9060300 PARMS FROM MSG97 LENGTH 24
END-IF.
TCP-CLIENT-CHECKRC-EXIT.
EXIT.
*****************************************************************
COPY IDMS IDMS-STATUS.
IDMS-ABORT SECTION.
IDMS-ABORT-EXIT.
EXIT.
Copyright © 2014 CA.
All rights reserved.
|
|