• Welcome to OS2World OLD-STATIC-BACKUP Forum.
 

News:

This is an old OS2World backup forum for reference only. IT IS READ ONLY!!!

If you need help with OS/2 - eComStation visit http://www.os2world.com/forum

Main Menu

Stock Data for NASDAQ OMX (Stockholmsbörsen)

Started by jep, 2012.09.03, 21:07:35

Previous topic - Next topic

jep

Hello,

here's a rexx script to fetch historical stock data from NASDAQ OMX (Sweden).

Please do note that the current version has been developed to target the Swedish stock market, but should help you if you want to add something similar in the country you live in.

The code use rxSock and POST data to retrieve information and thus doesn't rely on cURL or wget.

SSE366 = the code for a particular stock.
2012-05-04 = the start date to retrieve historical data from.

The output is a simple html code that Lotus 1-2-3 and OpenOffice.org Calc should be able to read and present as web query table data.

You may also want to modify the code to allow parameter input for dynamic usage.
While you're at it, rewrite it some more to retrieve current live stock data.

Those of you that feel a bit more adventures should figure out how to use it with the rexx web server sre2003 (srehttp/2) as a cgi-bin script to let the whole world get historical stock data.
(It's actually quite straight forward if you see test-cgi.cmd that come with srehttp/2)

/*
* Filename: fetchstockdata.cmd
*   Author: JAN-ERIK LÄRKA
*  Created: Mon Sep  3 2012
*  Purpose: Fetch stock data for NASDAQ-OMX (Stockholmsbörsen)
*  Changes:
*/

/* initialize socket package */
if RxFuncQuery( "SockLoadFuncs" ) then
do
  rc = RxFuncAdd( "SockLoadFuncs", "RxSock", "SockLoadFuncs" )
  rc = SockLoadFuncs()
end

CALL rxURLComponents 'host.1.', 'http://www.nasdaqomxnordic.com/webproxy/DataFeedProxy.aspx'
vars = rxAddXMLTags( 'SSE366', '2012-05-04' )
CALL rxURLConnect
PARSE VALUE rxURLRetrieve( 1, 'Content-type: application/x-www-form-urlencoded; charset=UTF-8 '||"0D0A"x||'Content-length: '||LENGTH( vars )||"0D0A0D0A"x||vars ) WITH ."0D0A0D0A"x retval
CALL CHAROUT 'sse366.html', '<html><body>'||retval||'</body></html>'
RETURN 0

rxURLConnect: PROCEDURE EXPOSE host.
IF \DATATYPE( host.0, 'W' ) THEN
   host.0 = 0
j = host.0 + 1
DO i = 1 TO host.0
   IF TRANSLATE( host.i.location ) = TRANSLATE( host.j.location ) THEN LEAVE
END
IF i > host.0 THEN
DO
   /* get dot address of host */
   SAY 'Resolving ip address of "'host.i.location'"'
   IF 1 <> SockGetHostByName( host.i.location, "host."i"." ) then
       call error "Don't know who" host.i.location "is ... sorry"
END
ELSE
   host.j.addr = host.i.addr

   host.0 = j
   i = j

   /* Close the connection if already open but not closed */
   IF SYMBOL( host.i.socket ) = 'VAR' THEN
       rc = SockClose( host.i.socket )

   SAY 'Connecting to 'host.i.addr

   /* create socket */
   host.i.socket  = SockSocket( host.i.family, "SOCK_STREAM", 0 )
   IF s < 0 then
       call error "Error creating socket:" errno

   SAY 'Connecting to 'host.i.location'/'host.i.path
   /* connect it to the server */
   rc = SockConnect( host.i.socket, "host."i"." )
   if rc < 0 then
       call error "Error connecting to" host.i.addr ":" errno
RETURN rc

/* PRocedure to build and encode the xmlquery */
rxAddXMLTags: PROCEDURE
   param.1 = 'SubSystem'
   param.2 = 'Action'
   param.3 = 'ApendIntraDay'
   param.4 = 'Instrument'
   param.5 = 'FromDate'
   param.6 = 'ToDate'
   param.7 = 'hi_a'
   param.8 = 'ext_xslt'
   param.9 = 'ext_xslt_options'
   param.10 = 'ext_xslt_lang'
   param.11 = 'ext_xslt_hiddenattrs'
   param.12 = 'ext_xslt_tableId'
   param.13 = 'app'
   param.0 = 13

   swe_date = DATE( 'S' )
   val.1 = 'History'
   val.2 = 'GetDataSeries'
   val.3 = 'no'
   val.4 = ARG(1) /* Stock ID */
   IF LENGTH( ARG(2) ) > 0 THEN
       val.5 = ARG(2) /* From Date */
   ELSE
       val.5 = LEFT( swe_date, 4 )||'-'||SUBSTR( swe_date, 5, 2 )||'-01' /* From Date ( First day of month ) */
   IF LENGTH( ARG(3) ) > 0 THEN
       val.6 = ARG(3) /* To Date */
   ELSE
       val.6 = LEFT( swe_date, 4 )||'-'||SUBSTR( swe_date, 5, 2 )||'-'||RIGHT( swe_date, 2 ) /* To Date ( Today ) */
   val.7 = '0,1,2,4,21,8,10,11,12,9'
   val.8 = '/nordicV3/hi_table_shares_adjusted.xsl'
   val.9 = ',undefined,'
   val.10 = 'en'
   val.11 = ',ip,iv,'
   val.12 = 'historicalTable'
   val.13 = '/shares/historical_prices'
   val.0 = 13

   retval = ''
   DO i = 1 TO param.0
       retval = retval||'<param name="'||param.i||'" value="'||val.i||'"/>'
       END
   /* Replace ' ' (space) with + (plus) */
   retval = TRANSLATE( 'xmlquery=<post>'||retval||'</post>', '+', ' ' )
   /* Find characters to encode */
   rest = SPACE( TRANSLATE( XRANGE(),, XRANGE( 0, 9 )||XRANGE( 'A', 'Z' )||XRANGE( 'a', 'z' )||'%_+=' ), 0 )
   chstr = ''
   /* Replace each special character with its hex value preceded by %, use the changestr-function to do it. */
   DO i = i TO LENGTH( rest )
       retval = CHANGESTR( SUBSTR( rest, i, 1 ), retval, '%'||C2X( SUBSTR( rest, i, 1 ) ) )
   END
RETURN retval

/* Replace one string (needle) with another (newneedle) in text (haystack) */
CHANGESTR: PROCEDURE /* needle, haystack <, newneedle<, caselss>> */
   IF TRACE() = '?I' THEN CALL TRACE 'O'
   PARSE ARG needle, haystack, newneedle, caselss
   new_haystack = ''
   IF caselss = '' THEN
   DO WHILE POS( needle, haystack ) > 0
       PARSE VALUE haystack WITH pre(needle)haystack
       new_haystack = new_haystack||pre||newneedle
   END
   ELSE DO
       needle = TRANSLATE( needle )
       strpos = POS( needle, TRANSLATE( haystack ) )
       DO WHILE strpos > 0
           IF strpos > 1 THEN
               pre = LEFT( haystack, strpos - 1 )
           ELSE pre = ''
           haystack = SUBSTR( haystack, strpos + LENGTH( needle ) )
           new_haystack = new_haystack||pre||newneedle
           strpos = POS( needle, TRANSLATE( haystack ) )
       END
   END
RETURN new_haystack||haystack

rxURLRetrieve: PROCEDURE EXPOSE host. text

/* send message across ... loop in case entire message can't be sent in one SockSend() */
   i = host.0
   IF LENGTH( ARG(1) ) > 0 THEN
       message = 'POST /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A"x||ARG(2)||"0D0A0D0A"x
   ELSE IF SYMBOL( 'host.'i'.cookie' ) = 'VAR' THEN
       message = 'GET /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A"x||'Cookie: '||host.i.cookie||"0D0A0D0A"x
   ELSE
       message = 'GET /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A0D0A"x

   do while ( message <> "" )
       bytes = SockSend( host.i.socket, message )
       message = substr( message, bytes + 1 )
   end
   say date() time() ':' host.i.location 'contacted.'

   text = ''

   IF TRANSLATE( ARG(1) ) <> 'QUIT' THEN
   DO WHILE rc > -1 & chunk <> ''
       rc = SockRecv( host.i.socket, 'chunk', 1000 )
       text = text||chunk
       CALL CHAROUT , '█'
   END
   IF LENGTH( text ) > 0 THEN
   DO
       SAY
       SAY date() time() ':' host.i.location 'replied.'
   END

/* wait for server to close the connection, then close our end */
   rc = SockClose( host.i.socket )
   DROP host.i.socket
RETURN text

rxURLComponents:
   !_host_! = ARG(1)
   CALL GetURLComponents ARG( 2 )
   CALL VALUE !_host_!'scheme', host.scheme
   CALL VALUE !_host_!'location', host.location
   CALL VALUE !_host_!'port', host.port
   CALL VALUE !_host_!'params', host.params
   CALL VALUE !_host_!'query', host.query
   CALL VALUE !_host_!'target', host.target
   CALL VALUE !_host_!'file', host.file
   CALL VALUE !_host_!'family', host.family
   CALL VALUE !_host_!'path', host.path
RETURN

GetURLComponents: PROCEDURE EXPOSE host.
/* URL syntax consists of these components:          */
/* <scheme>://<location>:<port>/<path><params>?<query>#<target> */

   PARSE VALUE ARG( 1 ) WITH host.scheme '://' host.location '/' host.path
   host.location = strip( host.location, 'L', '/' ) /* in case of scheme like "file:///" */

   IF host.location = '' THEN
       PARSE VALUE ARG( 1 ) WITH host.location '/' host.path

   PARSE VALUE host.location WITH host.location ':' host.port
   IF host.port = '' THEN
       IF TRANSLATE( host.scheme ) = 'HTTP' then
           host.port = 80
       ELSE IF TRANSLATE( host.scheme ) = 'FTP' then
           host.port = 21

   PARSE VALUE host.path WITH host.file '' host.params '?' host.query '#' host.target

   IF host.params = '' THEN
       PARSE VALUE host.path WITH host.file '?' host.query '#' host.target

   IF host.query = '' THEN
       PARSE VALUE host.path WITH host.file '#' host.target

   host.family = "AF_INET"

RETURN

GetURLComponent: PROCEDURE EXPOSE host.

   IF LENGTH( ARG(1) ) > 0 THEN
       CALL GetURLComponents ARG( 1 )

   SELECT
       WHEN TRANSLATE( ARG( 2 ) ) = 'S' THEN
           RETURN host.scheme
       WHEN TRANSLATE( ARG( 2 ) ) = 'H' THEN
           RETURN host.location||':'||host.port
       WHEN TRANSLATE( ARG( 2 ) ) = 'N' THEN
           RETURN host.location
       WHEN TRANSLATE( ARG( 2 ) ) = 'L' THEN
           RETURN host.port
       WHEN TRANSLATE( ARG( 2 ) ) = 'P' THEN
           RETURN host.param
       WHEN TRANSLATE( ARG( 2 ) ) = 'Q' THEN
           RETURN host.query
       WHEN TRANSLATE( ARG( 2 ) ) = 'T' THEN
           RETURN host.target
       WHEN TRANSLATE( ARG( 2 ) ) = 'F' THEN
           RETURN FILESPEC( 'N', host.path )
       OTHERWISE
           RETURN host.path
   END

/* print an error message */
error: procedure
   say arg(1)
   exit


//Jan-Erik

abwillis

Here I get an error in line 19 about an extra close paren or comma.  I removed the 1, just to see what would happen and it then runs without error but the output in sse336.html was
<html><body>xmlquery=%3Cpost%3E%3Cparam+name=%22SubSystem%22+value=%22History%22%2F%3E%3Cparam+name=%22Action%22+value=%22GetDataSeries%22%2F%3E%3Cparam+name=%22ApendIntraDay%22+value=%22no%22%2F%3E%3Cparam+name=%22Instrument%22+value=%22SSE366%22%2F%3E%3Cparam+name=%22FromDate%22+value=%222012%2D05%2D04%22%2F%3E%3Cparam+name=%22ToDate%22+value=%222012%2D09%2D03%22%2F%3E%3Cparam+name=%22hi_a%22+value=%220%2C1%2C2%2C4%2C21%2C8%2C10%2C11%2C12%2C9%22%2F%3E%3Cparam+name=%22ext_xslt%22+value=%22%2FnordicV3%2Fhi_table_shares_adjusted%2Exsl%22%2F%3E%3Cparam+name=%22ext_xslt_options%22+value=%22%2Cundefined%2C%22%2F%3E%3Cparam+name=%22ext_xslt_lang%22+value=%22en%22%2F%3E%3Cparam+name=%22ext_xslt_hiddenattrs%22+value=%22%2Cip%2Civ%2C%22%2F%3E%3Cparam+name=%22ext_xslt_tableId%22+value=%22historicalTable%22%2F%3E%3Cparam+name=%22app%22+value=%22%2Fshares%2Fhistorical_prices%22%2F%3E%3C%2Fpost%3E</body></html><html><body>xmlquery=%3Cpost%3E%3Cparam+name=%22SubSystem%22+value=%22History%22%2F%3E%3Cparam+name=%22Action%22+value=%22GetDataSeries%22%2F%3E%3Cparam+name=%22ApendIntraDay%22+value=%22no%22%2F%3E%3Cparam+name=%22Instrument%22+value=%22SSE366%22%2F%3E%3Cparam+name=%22FromDate%22+value=%222012%2D05%2D04%22%2F%3E%3Cparam+name=%22ToDate%22+value=%222012%2D09%2D03%22%2F%3E%3Cparam+name=%22hi_a%22+value=%220%2C1%2C2%2C4%2C21%2C8%2C10%2C11%2C12%2C9%22%2F%3E%3Cparam+name=%22ext_xslt%22+value=%22%2FnordicV3%2Fhi_table_shares_adjusted%2Exsl%22%2F%3E%3Cparam+name=%22ext_xslt_options%22+value=%22%2Cundefined%2C%22%2F%3E%3Cparam+name=%22ext_xslt_lang%22+value=%22en%22%2F%3E%3Cparam+name=%22ext_xslt_hiddenattrs%22+value=%22%2Cip%2Civ%2C%22%2F%3E%3Cparam+name=%22ext_xslt_tableId%22+value=%22historicalTable%22%2F%3E%3Cparam+name=%22app%22+value=%22%2Fshares%2Fhistorical_prices%22%2F%3E%3C%2Fpost%3E</body></html>

jep

Well, please do se the modification I made to the code when I checked it again after a moment (1 h 7 min later) I had posted it.

PARSE VALUE rxURLRetrieve( 1, 'C...

I use FTE to edit the code as it support rexx syntax with highlightning, but I constantly forget to press ESC to deselect code before wokring with something else. The function name above was missing as I had accidently deleted it right before I copied it here. :-/


jep

Ohh, by the way...

I wrote the cgi-bin script myself but have a problem I'd like your help with.
It's online and running, but as my web server fetch the data which it may take while to complete, especially the last part when it get the last bit of information. I know I can rewrite the code to be more smart and close as soon as a certain tag has been returned but I'd like to learn how to extend the transmission time for another project as well.

How do I make the connection stay alive so that the client web browser doesn't give up the wait before all data can be sent from my web server?

jep

Links to the page that now let you look at stock data from NASDAQ OMX.

Volvo B

Assa Abloy B

SSAB B

etc.

jep

Speed improvements applied to script on web server.
You should now get the data as soon as the data is available.

//Jan-Erik

jep

/*
* Filename: nasdaqomx.cmd
*   Author: JAN-ERIK
*  Created: Tue Sep  4 2012
*  Purpose: CGI-BIN script for web server to fetch historical stock data from NASDAQ OMX (Sweden)
*  Changes:
*/

call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs

PARSE ARG argv

env = "OS2ENVIRONMENT"
argc = WORDS( argv )

/* The web server set some environment variables with information */
method = VALUE( "REQUEST_METHOD",, env )
len = VALUE( "CONTENT_LENGTH",, env )

stem = 'stem.'

/* Use the right method to read the information, GET is the most common */
IF method = 'GET' THEN
DO
   query_string = VALUE( "QUERY_STRING",, env )
   /* Parse data into variables */
   Entries = ParseQueryString( query_string )
END
/* POST is not supported/untested here right now */
/*ELSE IF method = 'POST' & len \= '' THEN
DO
   query_string = CHARIN( ,, len )
   NF = ParseQueryString( query_string )
   Entries = BreakDownInput( query_string, stem.Tag.1 )
END*/

/* Begin to write the html tags */
Say 'Connection: keep-alive'
Say
Say '<html>'||"0D0A"x||'<body>'

/* Set default values if the user leave one out */
stockid = 'SSE366'
fromdate = '2005-05-04'
todate = '2012-09-03'

/* Overwrite default values */
do i = 1 to Entries
   CALL VALUE stem.Tag.i, stem.XVal.i
end

/* Initialize socket package */
if RxFuncQuery( "SockLoadFuncs" ) then
do
  rc = RxFuncAdd( "SockLoadFuncs", "RxSock", "SockLoadFuncs" )
  rc = SockLoadFuncs()
end

/* Split up the url into components */
CALL rxURLComponents 'host.1.', 'http://www.nasdaqomxnordic.com/webproxy/DataFeedProxy.aspx'
/* Build the XML query */
vars = rxAddXMLTags( stockid, fromdate, todate )
rc = 0

/* xml query available? */
IF LENGTH( vars ) > 0 THEN
DO
   /* Connect to host */
   IF rxURLConnect() > -1 THEN
   DO
       /* Retrieve data from host, post (1) the data and append the data to post (Content-type....) */
       retval = rxURLRetrieve( 1, 'Content-type: application/x-www-form-urlencoded; charset=UTF-8 '||"0D0A"x||'Content-length: '||LENGTH( vars )||"0D0A0D0A"x||vars )
       IF retval < 0 THEN
       DO
           CALL CHAROUT , 'No data available.'
           rc = 3
       END
   END
   ELSE
   DO
       CALL CHAROUT , "An unknown error occured, couldn't connect to nasdaqomx to retrieve historical data.("||vars||")"
       rc = 2
   END
END
ELSE
DO
   CALL CHAROUT , "An unknown error occured, xml tag builder error.("||vars||")"
   rc = 1
END
Say '</body>'||"0D0A"x||'</html>'||"0D0A0D0A"x
RETURN rc

rxURLConnect: PROCEDURE EXPOSE host.
/* The following lines add new host to the array if you try to connect to several within the same script */
/* If none has been added before (host.0 is uninitialized) */
IF \DATATYPE( host.0, 'W' ) THEN
   host.0 = 0
/* Add another */
j = host.0 + 1
/* Check if the host has been used already, then leave */
DO i = 1 TO host.0
   IF TRANSLATE( host.i.location ) = TRANSLATE( host.j.location ) THEN LEAVE
END
/* If the host has not been added before, add it and check the ip-address (can take quite some time) */
IF i > host.0 THEN
DO
   /* get dot address of host */
/*    SAY 'Resolving ip address of "'host.i.location'"'*/
   IF 1 <> SockGetHostByName( host.i.location, "host."i"." ) then
       call error "Don't know who" host.i.location "is ... sorry"
END
ELSE
   host.j.addr = host.i.addr

/* Set the number of unique hosts */
   host.0 = j
   i = j

/* Close the connection if already open but not closed */
   IF SYMBOL( host.i.socket ) = 'VAR' THEN
       rc = SockClose( host.i.socket )

/*    SAY 'Connecting to 'host.i.addr*/

   /* create socket */
   host.i.socket  = SockSocket( host.i.family, "SOCK_STREAM", 0 )
   IF s < 0 then
       call error "Error creating socket:" errno

/*    SAY 'Connecting to 'host.i.location'/'host.i.path*/
   /* connect it to the server */
   rc = SockConnect( host.i.socket, "host."i"." )
   if rc < 0 then
       call error "Error connecting to" host.i.addr ":" errno
RETURN rc

/* Procedure to build and encode the xmlquery */
rxAddXMLTags: PROCEDURE
   param.1 = 'SubSystem'
   param.2 = 'Action'
   param.3 = 'ApendIntraDay'
   param.4 = 'Instrument'
   param.5 = 'FromDate'
   param.6 = 'ToDate'
   param.7 = 'hi_a'
   param.8 = 'ext_xslt'
   param.9 = 'ext_xslt_options'
   param.10 = 'ext_xslt_lang'
   param.11 = 'ext_xslt_hiddenattrs'
   param.12 = 'ext_xslt_tableId'
   param.13 = 'app'
   param.0 = 13

   swe_date = DATE( 'S' )
   val.1 = 'History'
   val.2 = 'GetDataSeries'
   val.3 = 'no'
   val.4 = ARG(1) /* Stock ID */
   IF LENGTH( ARG(2) ) > 0 THEN
       val.5 = ARG(2) /* From Date */
   ELSE
       val.5 = LEFT( swe_date, 4 )||'-'||SUBSTR( swe_date, 5, 2 )||'-01' /* From Date ( First day of month ) */
   IF LENGTH( ARG(3) ) > 0 THEN
       val.6 = ARG(3) /* To Date */
   ELSE
       val.6 = LEFT( swe_date, 4 )||'-'||SUBSTR( swe_date, 5, 2 )||'-'||RIGHT( swe_date, 2 ) /* To Date ( Today ) */
   val.7 = '0,1,2,4,21,8,10,11,12,9'
   val.8 = '/nordicV3/hi_table_shares_adjusted.xsl'
   val.9 = ',undefined,'
   val.10 = 'en'
   val.11 = ',ip,iv,'
   val.12 = 'historicalTable'
   val.13 = '/shares/historical_prices'
   val.0 = 13

   retval = ''
   DO i = 1 TO param.0
       retval = retval||'<param name="'||param.i||'" value="'||val.i||'"/>'
       END
   /* Replace ' ' (space) with + (plus) */
   retval = TRANSLATE( 'xmlquery=<post>'||retval||'</post>', '+', ' ' )
   /* Find characters to encode */
   rest = SPACE( TRANSLATE( XRANGE(),, XRANGE( 0, 9 )||XRANGE( 'A', 'Z' )||XRANGE( 'a', 'z' )||'%_+=' ), 0 )
   chstr = ''
   /* Replace each special character with its hex value preceded by %, use the changestr-function to do it. */
   DO i = i TO LENGTH( rest )
       retval = CHANGESTR( SUBSTR( rest, i, 1 ), retval, '%'||C2X( SUBSTR( rest, i, 1 ) ) )
   END
RETURN retval

/* Replace one string (needle) with another (newneedle) in text (haystack) */
CHANGESTR: PROCEDURE /* needle, haystack <, newneedle<, caselss>> */
   IF TRACE() = '?I' THEN CALL TRACE 'O'
   PARSE ARG needle, haystack, newneedle, caselss
   new_haystack = ''
   IF caselss = '' THEN
   DO WHILE POS( needle, haystack ) > 0
       PARSE VALUE haystack WITH pre(needle)haystack
       new_haystack = new_haystack||pre||newneedle
   END
   ELSE DO
       needle = TRANSLATE( needle )
       strpos = POS( needle, TRANSLATE( haystack ) )
       DO WHILE strpos > 0
           IF strpos > 1 THEN
               pre = LEFT( haystack, strpos - 1 )
           ELSE pre = ''
           haystack = SUBSTR( haystack, strpos + LENGTH( needle ) )
           new_haystack = new_haystack||pre||newneedle
           strpos = POS( needle, TRANSLATE( haystack ) )
       END
   END
RETURN new_haystack||haystack

rxURLRetrieve: PROCEDURE EXPOSE host. text

/* send message across ... loop in case entire message can't be sent in one SockSend() */
   i = host.0
   IF LENGTH( ARG(1) ) > 0 THEN
       message = 'POST /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A"x||ARG(2)||"0D0A0D0A"x
   ELSE IF SYMBOL( 'host.'i'.cookie' ) = 'VAR' THEN
       message = 'GET /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A"x||'Cookie: '||host.i.cookie||"0D0A0D0A"x
   ELSE
       message = 'GET /'||host.i.path||' HTTP/1.1'||"0D0A"x||'Host: '||host.i.location||"0D0A0D0A"x

   do while ( message <> "" )
       bytes = SockSend( host.i.socket, message )
       message = substr( message, bytes + 1 )
   end
/*    say date() time() ':' host.i.location 'contacted.'

   text = ''*/
onoff = 0
   IF TRANSLATE( ARG(1) ) <> 'QUIT' THEN
   DO WHILE rc > -1 & chunk <> ''
       rc = SockRecv( host.i.socket, 'chunk', 1000 )
       IF POS( "0D0A0D0A"x, chunk ) > 0 THEN DO
           PARSE VALUE chunk WITH ."0D0A0D0A"x chunk
           onoff = 1
       END
       IF onoff = 1 THEN
           CALL CHAROUT , chunk
/*        test = text||chunk
       CALL CHAROUT , '█'*/
       IF POS( '</table>', chunk ) > 0 THEN LEAVE
   END
/*    IF LENGTH( text ) > 0 THEN
   DO
       SAY
       SAY date() time() ':' host.i.location 'replied.'
   END*/

/* wait for server to close the connection, then close our end */
   rc = SockClose( host.i.socket )
   DROP host.i.socket
RETURN rc /*text*/

rxURLComponents:
   !_host_! = ARG(1)
   CALL GetURLComponents ARG( 2 )
   CALL VALUE !_host_!'scheme', host.scheme
   CALL VALUE !_host_!'location', host.location
   CALL VALUE !_host_!'port', host.port
   CALL VALUE !_host_!'params', host.params
   CALL VALUE !_host_!'query', host.query
   CALL VALUE !_host_!'target', host.target
   CALL VALUE !_host_!'file', host.file
   CALL VALUE !_host_!'family', host.family
   CALL VALUE !_host_!'path', host.path
RETURN

GetURLComponents: PROCEDURE EXPOSE host.
/* URL syntax consists of these components:          */
/* <scheme>://<location>:<port>/<path><params>?<query>#<target> */

   PARSE VALUE ARG( 1 ) WITH host.scheme '://' host.location '/' host.path
   host.location = strip( host.location, 'L', '/' ) /* in case of scheme like "file:///" */

   IF host.location = '' THEN
       PARSE VALUE ARG( 1 ) WITH host.location '/' host.path

   PARSE VALUE host.location WITH host.location ':' host.port
   IF host.port = '' THEN
       IF TRANSLATE( host.scheme ) = 'HTTP' then
           host.port = 80
       ELSE IF TRANSLATE( host.scheme ) = 'FTP' then
           host.port = 21

   PARSE VALUE host.path WITH host.file '' host.params '?' host.query '#' host.target

   IF host.params = '' THEN
       PARSE VALUE host.path WITH host.file '?' host.query '#' host.target

   IF host.query = '' THEN
       PARSE VALUE host.path WITH host.file '#' host.target

   host.family = "AF_INET"

RETURN

GetURLComponent: PROCEDURE EXPOSE host.

   IF LENGTH( ARG(1) ) > 0 THEN
       CALL GetURLComponents ARG( 1 )

   SELECT
       WHEN TRANSLATE( ARG( 2 ) ) = 'S' THEN
           RETURN host.scheme
       WHEN TRANSLATE( ARG( 2 ) ) = 'H' THEN
           RETURN host.location||':'||host.port
       WHEN TRANSLATE( ARG( 2 ) ) = 'N' THEN
           RETURN host.location
       WHEN TRANSLATE( ARG( 2 ) ) = 'L' THEN
           RETURN host.port
       WHEN TRANSLATE( ARG( 2 ) ) = 'P' THEN
           RETURN host.param
       WHEN TRANSLATE( ARG( 2 ) ) = 'Q' THEN
           RETURN host.query
       WHEN TRANSLATE( ARG( 2 ) ) = 'T' THEN
           RETURN host.target
       WHEN TRANSLATE( ARG( 2 ) ) = 'F' THEN
           RETURN FILESPEC( 'N', host.path )
       OTHERWISE
           RETURN host.path
   END

/* print an error message */
error: procedure
   say arg(1)
   exit


/* Uppercase and return only A-Z and 0-9 */
rxCleanup: PROCEDURE
RETURN SPACE( TRANSLATE( TRANSLATE( ARG(1) ),, TRANSLATE( XRANGE(),, XRANGE( 'A', 'Z' )||XRANGE( '0', '9' ) ) ), 0 )

BreakDownInput: PROCEDURE EXPOSE (stem)
   q_string = ARG(1)
   delim = ARG(2)
   newln = D2C(13)||D2C(10)
   i = 0
   IF LENGTH( delim ) > 0 THEN
   DO WHILE POS( delim, q_string ) > 0
       i = i + 1
       PARSE VALUE q_string WITH .'"'t_name'"'t_var(delim)q_string
       CALL VALUE stem'KeyVal.i', t_var
       PARSE VALUE t_var WITH (newln)(newln)t_var(newln).
       CALL VALUE stem'Tag.i', t_name
       CALL VALUE stem'XVal.i', t_var
       CALL VALUE stem''t_name, t_var
   END
   CALL VALUE stem'0', i
Return i


/* Do not modify below this line --  Important parsing code... */
ParseQueryString: PROCEDURE EXPOSE (stem)
   PARSE ARG P
   i = 0
   DO WHILE ( ( P \= '' ) & ( i < 10 ) )
       i = i + 1
       PARSE VALUE P WITH txt '&' P
       PARSE VALUE txt WITH tagval '=' kval
       CALL VALUE stem'Text.i', txt
       CALL VALUE stem'KeyVal.i', kval
       CALL VALUE stem'Tag.i', tagval
       CALL VALUE stem'XVal.i', DecodeKeyVal( kval )
   END
RETURN i

/* Code from the test-cgi.cmd example SRE2003, SREHTTP/2 */
/************************************************/
/* procedure from TEST-CGI.CMD, modified by daniel hellerstein 12/97,
from code by  Frankie Fan <kfan@netcom.com>  7/11/94 */
DecodeKeyVal: PROCEDURE
   PARSE ARG Code
   Text = ''
   Code = TRANSLATE( Code, ' ', '+' )
   rest = '%'
   DO WHILE ( rest \= '' )
       PARSE VAR Code T '%' rest
       Text = Text || T
       IF rest \= '' THEN
       DO
           ch = TRANSLATE( LEFT( rest, 2 ) )
           IF VERIFY( ch,'01234567890ABCDEF' ) = 0 THEN
               c = X2C( ch )
           ELSE
               c = ch
           Text = Text || c
           Code = SUBSTR( rest, 3 )
           END
       END
RETURN Text

/* Code from RExx Tips & Tricks 3.60 */
RXQUEUE: PROCEDURE
 parse arg action, queue_name
/* init the return code (40 = incorrect call) */
 rc = 40
 currentQueue = ""
/* install local error handler                */
 SIGNAL ON SYNTAX NAME RxQueueError
 SIGNAL ON FAILURE NAME RxQueueError
 SIGNAL ON ERROR NAME RxQueueError

 curAction = TRANSLATE( action )
 curQueue = TRANSLATE( STRIP( queue_name ) )

 SELECT
     WHEN curAction = "QUERY" THEN
     DO
         IF curQueue <> '' THEN
         DO
             /* try to create the queue ...                */
             tempQueue = "RXQUEUE"( "CREATE", curQueue )
             /* ... and delete the just created queue      */
             CALL "RXQUEUE" "DELETE", tempQueue

             /* set the return code                        */
             rc = ( tempQueue <> curQueue )
         END
     END
     WHEN curAction = "TEST" THEN
     DO
         rc = 1
         /* save the current queue name                */
         IF queue_name <> '' THEN
             currentQueue = "RXQUEUE"( "SET", queue_name )

         /* The current queue is restored a the end of the routine */
         queue_teststring = "rxqueue test function"
         queue queue_teststring
         IF QUEUED() <> 0 THEN
         DO
             curString = LINEIN( 'QUEUE:' )
             IF curString <> queue_testString THEN
                 QUEUE curString
             ELSE
                 rc = 0
         END
     END
     OTHERWISE
     DO
         /* call the original RXQUEUE function         */
         IF queue_name <> '' THEN
             rc = "RXQUEUE"( action, queue_name )
         ELSE
             rc = "RXQUEUE"( action )
     END
 END

RxQueueError:
/* restore the current queue if necessary     */
   IF currentQueue <> '' THEN
       CALL "RXQUEUE" 'set', currentQueue
RETURN rc