********************************************************************** * Project: Web Service-Client for Web Service CAT100R * Customer: Internal, for Website Blog * * Created: 2020/07/13 K. Moedinger * * Changed: * Reason.: * * Purpose: * * Remarks: ********************************************************************** H DFTACTGRP(*NO) ********************************************************************** * Includes ********************************************************************** /COPY JVASRV/SRC,SOCKETH ********************************************************************** * Prototypes ********************************************************************** D CAT100R PR EXTPGM('CAT100R') D paString1 10A D paString2 10A D paResult 20A ********************************************************************** * Constants ********************************************************************** D CRLF C CONST(X'0D25') ********************************************************************** * Program parameters ********************************************************************** D CAT100R PI D paString1 10A D paString2 10A D paResult 20A ********************************************************************** * Global variables / Data structures D host S 32A INZ('dev7com') D p_hostent S * D hostent DS BASED(p_hostent) D h_name * D h_aliases * D h_addrtype 10I 0 D h_length 10I 0 D h_addr_list * D p_h_addr S * BASED(h_addr_list) D h_addr S 10U 0 BASED(p_h_addr) D sockaddress DS D gnFamily 5I 0 D gnPort 5U 0 D gnAddr 10U 0 D gaZero 8A D gnSocket S 10I 0 D gaRcvBuf S 4096A D gaSndBuf S 30000A D headData S 30000A VARYING D soapData S 30000A VARYING D IP S 10U 0 D p1 S 10I 0 D p2 S 10I 0 D rc S 10I 0 D gaResult S 20A ********************************************************************** * Main program ********************************************************************** /FREE soapData = '' + CRLF; soapData += '' + CRLF; soapData += '' + paString2 + '' + CRLF; soapData += '' + CRLF; soapData += '' + CRLF; soapData += '' + CRLF; soapData += '' + CRLF; headData = 'POST /web/services/CAT100RService'; headData += '/CAT100R HTTP/1.1' + CRLF; headData += 'Content-Length: ' + %CHAR(%LEN(soapData)) + CRLF; headData += 'Host: dev7com:10035' + CRLF; IP = inet_addr(%trim(host)); IF IP = cnINADDR_NONE; p_hostent = gethostbyname(%trim(host)); IP = h_addr; ENDIF; // Send POST request gnFamily = cnAF_INET; gnPort = 10035; gnAddr = IP; gaZero = *ALLx'00'; gnSocket = socket(cnAF_INET : cnSOCK_STREAM : cnIPPROTO_IP); rc = connect(gnSocket : %ADDR(sockaddress) : %LEN(sockaddress)); // TODO: Close socket and terminate program if connection fails gaSndBuf = headData + CRLF + soapData; rc = sndStr(gnSocket : gaSndBuf); // Read server response rc = recv(gnSocket : %ADDR(gaRcvBuf) : %LEN(gaRcvBuf) : 0); QDCXLATE(%LEN(gaRcvBuf) : gaRcvBuf : 'QTCPEBC'); // Parse server response p1 = %SCAN('' : gaRcvBuf); p2 = %SCAN('' : gaRcvBuf); gaResult = '"' + %SUBST(gaRcvBuf : p1 + 10 : p2 - p1 - 10) +'"'; DSPLY %CHAR(gaResult); closeSocket(gnSocket); *INLR = *ON; /END-FREE ********************************************************************** * Subprocedure: Convert String to ASCII and send it over socket * QDCXLATE doesn't work with varying strings ... ********************************************************************** P sndStr B D PI 10I 0 D pnSocket 10I 0 VALUE D paStr 30000A VALUE D lnSndLen S 10I 0 D rc S 10I 0 /FREE paStr = %TRIM(paStr) + x'25'; // Add linefeed lnSndLen = %LEN(%TRIM(paStr)); QDCXLATE(lnSndLen : paStr : 'QTCPASC'); rc = send(pnSocket : %ADDR(paStr) : lnSndLen : 0); RETURN rc; /END-FREE P E