OpenVMS Source Code Demos

tcpip$tcp_client_qio_2014f

1000	%title "tcpip$tcp_client_qio_2014f_xxx.bas"				!
	%ident                      "version_108.1"				!
	declare string constant k_version = "108.1"	,			&
				k_program = "tcpip$tcp_client_qio_2014f"	!
	!========================================================================================================================
	! title      : tcpip$tcp_client_qio_2014f
	! author     : Neil Rieck	(mailto:n.rieck@bell.net)
	!	       Waterloo, Ontario, Canada.
	! created    : 2014-08-04
	! OS         : OpenVMS (Alpha or Itanium) or VMS on VAX
	! Stack      : TCP/IP Services V5.0 or higher (but should work with any stack after a few mods)
	! compile 1  : $ bas	tcpip$tcp_client_qio_2014f_108.bas (where 108 is the version number)
	! compile 2  : $ bas	[.inc]wcsm_tcp_functions_108.bas
	! link       : $ link	tcpip$tcp_client_qio_2014e_108,	-
	!			wcsm_tcp_functions_108
	! references : HP TCP/IP Services for OpenVMS
	!              Sockets API and System Services Programming (manual: BA548-90002)
	! notes      : 1. stack programming on VMS/OpenVMS can be done by "Sockets API" (easier) or using
	!		  "VMS System Services" (harder; a lot like building an Interociter)
	!	       2. A and B client demos employ sys$qiow (synchronous) via VMS System Services
	!	       3. The C client demo employs sys$qio (asynchronous) to provide even more control
	!	       4. The D client demo moves repetitive code to external functions
	!	       5. The E client demo adds NVT routines so we can telnet
	!	       6. The F clinet demo (non-public) breaks the code into maintainable pieces for the ICSIS system
	! Caveat     : after the NVT-handshake at the beginning of a telnet session, most stacks will already know the
	!	       TERMIMAL TYPE. However, many VMS/OpenVMS systems contain login scripts which always execute DCL
	!	       command "SET TERM/INQUIRE". This operation works as follows:
	!		a)	host sends:	<esc> [ c		(ANSI request to identify terminal type)
	!			expecting:	<esc> [ ? 1 ; 0 c	(for VT100 within 2 seconds)
	!			or:		<esc> [ ? 1 ; 2 c	(for VT102) within 2 seconds
	!		b)	if no terminal response after 2-seconds then you will see:
	!			host sends:	<esc> \			(clear character set)
	!			folowed by:	<esc> Z			(VT52 request to identify terminal type)
	!		c)	if no terminal response after 2-seconds then you will see:
	!			host sends:	<esc> [ 0 c		(alternate ANSI request to identify terminal)
	!		Obviously these 2-second delays will mess up my timers when set too low
	! history    :
	! ver who when   what
	! --- --- ------ --------------------------------------------------------------------------------------------------------
	! 105 NSR 140825 0. started with TCPIP$TCP_CLIENT_QIO_2014D_105.BAS
	!		 1. adding code to support NVT handshakes (see external function nsr_nvt_scan)
	!     NSR 140828 2. the saga continues
	! 106 NSR 140829 1. moved octets_to_quad into an external function
	!     NSR 140902 2. added nvt enhancements
	!		 3. introduced a little code mtce
	!     NSR 140903 4. introduced a tweak for the WONT/DONT problem with Solaris					bf_106.4
	! 107 NSR 140903 1. replace "any" with the correct data types in external function declarations
	!     NSR 140904 2. moved destination decoding into an external function (got to stick with the KISS principle)
	! 108 NSR 140905 1. break up the code into maintainable includes for the ICSIS system
	!     NSR 180111 2. added function ipv4_to_string()
	!========================================================================================================================
	option type=explicit							! formal coding
	set no prompt								!
	on error goto common_trap						! old school trapping for this demo
	!
	!	named constants
	!
	declare	long constant	TCPBUFSIZ	= 8192				! buffer size (no larger than 32767)
	declare long constant   k_os_vanilla	= 1			,	&
				k_os_openvms	= 2			,	&
				k_os_solaris	= 3			,	&
				k_os_windows	= 4
	!
	external string function ipv4_to_string(long)				!
	%include "[.inc]wcsm_tcp_support_108.inc"				! constants, record defs, library defs
	!		nsr_adr_prep(), nsr_tcp_prep(), nsr_tcp_open(), etc.
	!
	!	declare variables
	!
	map(recv)string	buffer_r = TCPBUFSIZ					!
	map(xmit)string buffer_w = TCPBUFSIZ					!
	!
	declare string		msg$					,	&
				keyboard$				,	&
				dest$					,	&
				path$					,	&
				tcp_proto$				,	&
				username$				,	&
				password$				,	&
				buffer$					,	&
				junk$					,	&
		long		ipv4_address				,	&
				first_time				,	&
				send_count				,	&
		word		tcp_port				,	&
		long		rc					,	&
				bytes_w					,	&
				readcount				,	&
				bytes_r					,	&
				nvt_msgs				,	&
				bytes_r_total				,	&
				os_type					,	&
				http%					,	&
				junk%					,	&
				try%					,	&
				junk1					,	&
				junk2					,	&
				dest_kind				,	&
				i%					,	&
				debug					,	&
		ncv_rec		ncv					,	! network connection variables		&
				ncv2						! support for a second connection
	!
	!=======================================================================
	!	main
	!=======================================================================
	main:
	print
	print k_program +"_"+ k_version						!
	!
	get_dest:
	print string$(len(k_program + k_version) + 1, asc("="))			!
	select tcp_port								!
	    case 23								!
		tcp_proto$ = "telnet"						!
	    case else								!
		tcp_port = 80							! default to HTTP
		tcp_proto$ = "http"						!
	end select								!
	print "-i-port:";tcp_port;"(";tcp_proto$;")"				!
	print "-i-debug:";debug
	print "-i-Destination Menu:"
	print "   1 = 142.180.221.226   (OpenVMS-8.4)"
	print "   2 = kawc96.on.bell.ca (OpenVMS-8.4)"
	print "   3 = 142.180.221.246   (Solaris-8  )"
	print "   4 = kawc3w.on.bell.ca (Solaris-8  )"
	print "   5 = 142.180.221.251   (OpenVMS-8.4)"
	print "   6 = kawc09.on.bell.ca (OpenVMS-8.4)"
	print "   or any string   (eg. neilrieck.net)"
	print "   T = toggle tcp port between 80 (http) and 23 (telnet)"
	PRINT "   D = set debug level"
	print "   Q = quit (default)"
	print
	print "-?-";tcp_proto$;" destination? ";				!
	input dest$								!
	dest$ = edit$(dest$,2)							! no white space
	select dest$								!
	    case "T","t"							!
		if tcp_port = 80 then						!
		    tcp_port = 23						!
		else								!
		    tcp_port = 80						!
		end if								!
		goto get_dest							!
	    case "1"								!
		dest$ = "142.180.221.226"					!
	    case "2"								!
		dest$ = "kawc96.on.bell.ca"					!
	    case "3"								!
		dest$ = "142.180.221.246"					!
	    case "4"								!
		dest$ = "kawc3w.on.bell.ca"					!
	    case "5"								!
		dest$ = "142.180.221.220"					!
	    case "6"								!
		dest$ = "kawc0f.on.bell.ca"					!
	    case "D","d"							!
		when error in							!
		    input "-?-debug? (0-3) ";debug				!
		    debug = 0 if debug < 0					!
		use								!
		    debug = 0							!
		end when							!
		goto get_dest							!
	    case else								!
		goto fini	if len(dest$)<=1 				! "Q", "q"
	end select								!
	!
	ipv4_address = nsr_adr_prep(debug, dest$, path$, dest_kind)		! all params (except debug) may be modified
	select dest_kind							!
	    case 1								! we "know" this is an IPv4 address
		print "-i-you entered an IPv4 address"				!
		print "-i-ipv4_address: ";ipv4_address;				!
		print "(";ipv4_to_string(ipv4_address);")"
		http% = 0							! only HTTP/1.0 requests are possible
	    case 2								! this might be a dns name
		print "-i-you entered a dns name"				!
		print "-i-ipv4_address: ";ipv4_address;				!
		print "(";ipv4_to_string(ipv4_address);")"
		http% = 1							! HTTP/1.1 request is possible
	    case else								!
		print "-e-error, your input data is not useable"		!
		goto get_dest							!
	end select								!
	!
	!-----------------------------------------------------------------------
	!
	if tcp_port = 23 then							! telnet requires more information
	    input "-?-username: ";username$					!
	    goto get_dest	if edit$(username$,2) = ""			!
	    input "-?-password: ";password$					!
	    goto get_dest	if edit$(password$,2) = ""			!
	    try% = 200								! start with sequence 200
	else									! must be HTTP
	    sleep 1								!
	    try% = 100								! start with sequence 100
	end if									!
	!-----------------------------------------------------------------------
	!
	!	create socket
	!
	rc = nsr_tcp_prep(debug, ncv )						! allocate flags, allocate channel, etc.
	goto rc_exit	if (rc and 7%) <> 1					!
	!
	!	connect
	!
	rc = nsr_tcp_open(debug, ncv, ipv4_address, tcp_port,"0 0:0:05.0")	! connect with 5 second time limit
	goto rc_exit	if (rc and 7%) <> 1					!
	!-----------------------------------------------------------------------
	!	send loop
	!-----------------------------------------------------------------------
	send_count = 0								! init
	!
	!	entry pt.
	!
	send_loop:								!
	send_count = send_count + 1								if debug > 0
	print "-i-SEND-try:";try%;" count:";send_count;" ############################>>>"	if debug > 0
	!
	!	action states (send)
	!	====================
	!	<=99	nothing
	!	100-199	http   handshake sequences
	!	200-299	telnet handshake sequences
	!	>=300	nothing
	!
	select try%								!
	    case <100								! this is more for information
		print "-e-try:";try%;"which is a programming error"
		rc = 2
		goto rc_exit
	    case 100								! http demo sequence starts here ------
		!-----------------------------------------------------------------------
		!	send a message to retrieve the default web page
		!
		!	eg. examples:	1	GET / HTTP/1.0
		!
		!			2	GET /n.rieck HTTP/1.0
		!
		!			3	GET /n.rieck HTTP/1.1
		!				host: www3.sympatico.ca
		!
		!	caveat: websevers sitting behind load balancers, or webservers in the cloud,
		!		usually will not accept requests employing HTTP/1.0
		!-----------------------------------------------------------------------
		path$ = "/" if path$ = ""					!
		if http% = 0 then						!
		    print "-i-sending this HTTP 1.0 request:"		if debug > 0
		    msg$ = "GET "+ path$ +" HTTP/1.0"	+ cr + lf +		&
				cr + lf						! blank line marks end of HTTP block
		else								!
		    print "-i-sending this HTTP 1.1 request:"		if debug > 0
		    msg$ = "GET "+ path$ +" HTTP/1.1"	+ cr + lf +		&
				"host: "+ dest$		+ cr + lf +		&
				cr + lf						! blank line marks end of HTTP block
		end if								!
		print msg$						if debug > 0
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		!
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
		goto rc_exit	if (rc and 7%) <> 1				!
	    case 101								!
		if http% = 1 then						!
		    print
		    print "-i-since this is a persistent connection..."
		    print "-i-resending this HTTP 1.1 request:"
		    msg$ = "GET "+ path$ +" HTTP/1.0"	+ cr + lf +		&
				"host: "+ dest$		+ cr + lf +		&
				cr + lf						! blank line marks end of HTTP block
		    sleep 1
		    print msg$							!
		    bytes_w = len(msg$)						! determine the data length
		    buffer_w = msg$						! xref data to buffer for qio
		    !
		    rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0") ! xmit with 5 second time limit
		    goto rc_exit	if (rc and 7%) <> 1			!
		end if								!
	    case 102								! http demo sequence ends here --------
		goto no_more_processing						!
	    case 103 to 199
		print "-e-try:";try%;"which is a programming error"
		rc = 2
		goto rc_exit
	    case 200								! telnet demo sequence starts here ----
		buffer$	= ""							! zap buffer
		print "-i-nothing to send"
										! telent usually starts nvt receive
	    case 201								!
		!
		! caveat: if you know this is a VMS system then you might wish to send:	username/nocommand
		!		to avoid processing startup scripts
		!
		print "-i-sending username"					!
		msg$ = username$ + cr						!
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
		goto rc_exit	if (rc and 7%) <> 1				!
	    case 202								!
		print "-i-sending password"					!
		msg$ = password$ + cr						!
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
		goto rc_exit	if (rc and 7%) <> 1				!
	    case 203 to 209							!
		print "-i-sending <cr>"						!
		msg$ = cr							!
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
		goto rc_exit	if (rc and 7%) <> 1				!
	    case 210
		select os_type							!
		    case k_os_openvms						! OpenVMS
			msg$ = "show symbol *"					! see DCL variables
		    case k_os_solaris						! Solaris
			msg$ = "set "						! see shell variables
		    case else							!
			msg$ = ""						!
		end select							!
		print "-i-sending: "; msg$					!
		msg$ = msg$ + cr						!
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
	    case 211								! LOGOUT
		select os_type							!
		    case k_os_vanilla						! Vanilla
			msg$ = "logout"						!
		    case k_os_openVMS						! OpenVMS
			msg$ = "logoutnow"					!
		    case k_os_solaris						! Solaris
			msg$ = "exit"						!
		    case k_os_windows						!
			msg$ = "log"						! Windows
		    case else							!
			msg$ = "exit"						!
		end select							!
		print "-i-sending: "; msg$					!
		msg$ = msg$ + cr						!
		bytes_w = len(msg$)						! determine the data length
		buffer_w = msg$							! xref data to buffer for qio
		rc = nsr_tcp_send(debug, ncv, buffer_w, bytes_w, "0 0:0:05.0")	! xmit with 5 second time limit
	    case 212								!
		goto no_more_processing						!
	    case else								!
		print "-e-try:";try%;"which is a programming error"
		rc = 2
		goto rc_exit
	end select
	!
	!-----------------------------------------------------------------------
	!	read the response
	!-----------------------------------------------------------------------
	receive_data:
	print "-i-RECV-try:";try%;" ######################################<<<"	if debug > 0
	print "-i-receiving data"						if debug > 0
	readcount = 0								! init loop counter
	bytes_r_total = 0							!
	!
	read_loop:
	bytes_r = 0								! init
	readcount =  readcount + 1
	print "-i-receiving count:";readcount	if debug > 0			!
	print "   -------------------"		if debug > 0			!
	rc = nsr_tcp_recv(debug,ncv,buffer_r,TCPBUFSIZ,bytes_r,"0 00:00:00.9")	! receive with 900 mS time limit
	if ((rc and 7%) <> 1) then						!
	    select rc								!
		case SS$_THIRDPARTY						! (8316) -f- (third party stack libraries)
		   print "-w-status:";rc;"network partner disconnected logical link"	if debug > 0
		case SS$_LINKDISCON						! (8428) -f- (native libraries)
		   print "-w-status:";rc;"network partner disconnected logical link"	if debug > 0
		case SS$_VCCLOSED						! (8612) -w-
		   print "-w-status:";rc;"network partner closed"			if debug > 0
		case SS$_TIMEOUT						! ( 556) -f
		   print "-w-status:";rc;"operation timeout"				if debug > 0
		case else							!
		   print "-e-error:";rc;"while reading from server"		!
	    end select								!
	    goto no_more_processing						!
	end if									!
	!
	!	action states (recv)
	!	====================
	!	<=99	nothing
	!	100-199	http   handshake sequences
	!	200-299	telnet handshake sequences
	!	>=300	nothing
	!
	select try%								!
	    case <100								! this is more for information
		goto no_more_processing						!
	    case 100 to 101							! http demo sequence starts here ------
		if bytes_r > 0 then						! if any data bytes
		    print left$(buffer_r,bytes_r)				! then output that amount
		    bytes_r_total = bytes_r_total + bytes_r			! also add to total
		end if								!
		if (bytes_r > 0)				and		! if we received something			&
		   (readcount < 150) then					! and we're not too crazy
			goto read_loop		 				! then read some more
		end if								!
		print
		print "------------------------------"
		sleep 1								!
		try% = try% + 1							! 100 -> 101
		goto send_loop							!
	    case 102								! http demo sequence ends here --------
		goto no_more_processing						!
	    case 103 to 199							! unsupported
		goto no_more_processing						!
	    case 200								! telnet demo sequence starts here ----
										! waiting for login prompt
		junk% = nsr_nvt_scan(						! 						&
			debug, ncv, buffer_w, bytes_w, "0 0:0:05.0",		! same params as nsr_tcp_send()			&
			buffer_r, bytes_r, nvt_msgs)				! params to test and set
		if bytes_r > 0 then						! if any data bytes (after nvt processing)
		    print left$(buffer_r,bytes_r)				! output that amount
		    bytes_r_total = bytes_r_total + bytes_r			! also add to total
		    buffer$ = buffer$ + left$(buffer_r,bytes_r)			!
		end if								!
		if ((bytes_r + nvt_msgs) > 0)		and			! if we received something			&
		    (readcount < 150) then					! and we're not too crazy
			goto read_loop		 				! then read some more
		end if								!
		junk$ = edit$(buffer$,128+32+16+8+4)				! trailing,ucase,compress,leading
		junk% = 0							! init
		junk% = 1 if pos(junk$,"USERNAME:",1)>0				! OpenVMS-8.4
		junk% = 1 if pos(junk$,"LOGIN:"   ,1)>0				! Solaris-8
		if junk% = 1 then						!
		    print "-i-detected login prompt"				!
		    try% = try% + 1						!
		    goto send_loop						!
		else								!
		    print "-w-oops, didn't detect a login prompt"		! just exit this demo
		end if								!
	    case 201								! waiting for password prompt
		junk% = nsr_nvt_scan(						! 						&
			debug, ncv, buffer_w, bytes_w, "0 0:0:05.0",		! same params as nsr_tcp_send()			&
			buffer_r, bytes_r, nvt_msgs)				! params to test and set
		if bytes_r > 0 then						! if any data bytes (after nvt processing)
		    print left$(buffer_r,bytes_r)				! output that amount
		    bytes_r_total = bytes_r_total + bytes_r			! also add to total
		    buffer$ = buffer$ + left$(buffer_r,bytes_r)			!
		end if								!
		if ((bytes_r + nvt_msgs) > 0)		and			! if we received something			&
		    (readcount < 150) then					! and we're not too crazy
			goto read_loop		 				! then read some more
		end if								!
		junk$ = edit$(buffer$,128+32+16+8+4)				! trailing,ucase,compress,leading
		junk% = 0							! init
		junk% = 1 if pos(junk$,"PASSWORD:",1)>0				! OpenVMS-8.4 (and Solaris-8)
		if junk% = 1 then						!
		    try% = try% + 1						!
		    goto send_loop						!
		else								!
		    print "-w-oops, didn't detect a password prompt"		! just exit this demo
		end if								!
	    case 202								! waiting for login success
		junk% = nsr_nvt_scan(						! 						&
			debug, ncv, buffer_w, bytes_w, "0 0:0:05.0",		! same params as nsr_tcp_send()			&
			buffer_r, bytes_r, nvt_msgs)				! params to test and set
		if bytes_r > 0 then						! if any data bytes (after nvt processing)
		    print left$(buffer_r,bytes_r)				! output that amount
		    bytes_r_total = bytes_r_total + bytes_r			! also add to total
		    buffer$ = buffer$ + left$(buffer_r,bytes_r)			!
		end if								!
		if ((bytes_r + nvt_msgs) > 0)		and			! if we received something			&
		    (readcount < 150) then					! and we're not too crazy
			goto read_loop		 				! then read some more
		end if								!
		junk$ = edit$(buffer$,128+32+16+8+4)				! trailing,ucase,compress,leading
		junk% = 0							! init
		junk% = k_os_vanilla	if pos(junk$,"WELCOME",1)>0		!
		junk% = k_os_openvms	if pos(junk$,"LAST INTERACTIVE LOGIN ON",1)>0
		junk% = k_os_solaris	if pos(junk$,"SUN MICROSYSTEMS",1)>0	!
		junk% = k_os_solaris	if pos(junk$,"SUNOS",1)>0		!
		junk% = k_os_windows	if pos(junk$,"MICROSOFT",1)>0		!
		junk% = 9 if pos(junk$,"BAD PASSWORD",1)>0			! vanilla
		junk% = 9 if pos(junk$,"USER AUTHORIZATION FAILURE",1)>0	! OpenVMS
		junk% = 9 if pos(junk$,"LOGIN INCORRECT",1)>0			! Solaris
		select junk%							!
		    case 0, 9							!
			print "-w-oops, didn't detect login success"		! just exit this demo (fall thru)
		    case else							!
			os_type = junk%						! rememeber OS type
			try% = try% + 1						!
			goto send_loop						!
		end select							!
	    case 202 to 299							!
		junk% = nsr_nvt_scan(						! 						&
			debug, ncv, buffer_w, bytes_w, "0 0:0:05.0",		! same params as nsr_tcp_send()			&
			buffer_r, bytes_r, nvt_msgs)				! params to test and set
		if bytes_r > 0 then						! if any data bytes (after nvt processing)
		    print left$(buffer_r,bytes_r)				! output that amount
		    bytes_r_total = bytes_r_total + bytes_r			! also add to total
		    buffer$ = buffer$ + left$(buffer_r,bytes_r)			!
		end if								!
		if ((bytes_r + nvt_msgs) > 0)		and			! if we received something			&
		    (readcount < 150) then					! and we're not too crazy
			goto read_loop		 				! then read some more
		end if								!
		junk$ = edit$(buffer$,128+32+16+8+4)				! trailing,ucase,compress,leading
		junk% = 0							! init
		!
		!	various tests could go here
		!
		junk% = 1
		if junk% = 1 then						!
		    try% = try% + 1						!
		    goto send_loop						! we'll just send <cr>
		else								!
		    print "-w-oops, didn't detect login success"		! just exit this demo
		end if								!
	    case else								!
		print "-e-try:";try%;"which is a programming error"		!
		rc = 2								!
		goto rc_exit							!
	end select								!
	no_more_processing:
	!
	!	but we still may have received something so test bytes_r
	!
	print "-i-total bytes received:";bytes_r_total	if debug > 0		!
	!
	rc = nsr_tcp_clos(debug, ncv )						! close the tcp connection
	goto rc_exit	if (rc and 7%) <> 1					!
	!
	rc = nsr_tcp_free(debug, ncv )						! release all allocated resources
	goto rc_exit	if (rc and 7%) <> 1					!
	!
	goto fini								! that's all she wrote...
	!-----------------------------------------------------------------------
	!	get keyboard
	!-----------------------------------------------------------------------
	get_keyboard:
	!
	!	Interactive Input is in this block of code but...
	!	while we are here we are not paying attention to the receive stream (bad)
	!
	keyboard$ = ""							!
	when error in							!
	    if first_time = 0 then					!
		print "Note: 1) don't enter anything until you see your prompt"
		print "      2) timeout applies to keystrokes; not the time until you hit <enter>"
		sleep 1							!
		first_time = 1						! don't come back this way
	    end if							!
	    wait 2							! enable keyboard timer (2-secs)
	    print "-?-text to send (blank line to exit) ";		!
	    linput keyboard$						!
	    junk% = 0							! not a timeout
	use								!
	    junk% = err							! probably a timeout
	end when							!
	wait 0								! disable timer
	if junk% = 15 then						!
		print cr + lf + "-w- timeout"				!
	end if								!
	return

	!
	!	old-school common trap (normally you would only use inline "when error / use / end when" blocks
	!
	common_trap:
	print
	print "common error trap"						!
!~~~	print "-i-line  ";erl							x
	print "-i-error ";err							!
	print "-i-text  ";ert$(err)						!
	rc = 2									! VMS-e-
	resume rc_exit								! fix the stack
	!
32000	fini:
	rc = 1									! VMS-s-
	rc_exit:								!
!~~~	junk% = nsr_tcp_release
	print "-i-adios..."							!
	end program rc								! <<<--- return exit code to DCL
	!
	!########################################################################################################################
	!	external functions
	!########################################################################################################################
	! vms-basic functions that used to be here were moved to file: [.inc]WCSM_TCP_FUNCTIONS_108.bas
	! compile 1  : $ bas	tcpip$tcp_client_qio_2014f_108.bas
	! compile 2  : $ bas	[.inc]wcsm_tcp_functions_108.bas
	! link       : $ link	tcpip$tcp_client_qio_2014e_108,	-
	!			wcsm_tcp_functions_108
	!
	!=======================================================================
	!	ip4v_to_string
32040	!=======================================================================
	function string ipv4_to_string(long ipv4)				!
	option type=explicit							!
	record twoway								!
	    variant
		case
		    group zero
			string hack = 4
		    end group zero
		case
		    group one
			long    ip4v_address
		    end group one
	    end variant
        end record twoway							!
	!
	declare twoway hack
	declare long	i,j
	declare string	temp$
	!
	hack::ip4v_address = ipv4						! xfer to overlay
	temp$ = ""								! init
	for i = 4 to 1 step -1							! scan
	    j = ascii( mid$(hack::hack,i,1))					!
	    temp$  = temp$  + str$(j)						!
	    temp$  = temp$  + "." if i <> 1					!
	next i									!
	ipv4_to_string = temp$							! xfer data back
	end function								!
	!================================================================================

home Back to Home
Neil Rieck
Waterloo, Ontario, Canada.