• 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
Menu

Show posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.

Show posts Menu

Messages - jep

#1
Hello,

here's some code to get the MAC address for one or more computers on the LAN (but not the one running the code?!).

The function I've written behave differently depending on how you use it.

If you specify a computer name like rxGetMacAddr( 'ACOMPUTER' ) it will return information about that specific computer with one or more NICs.
If you leave out the computer name like rxGetMacAddr() it will return information about as many computers it can find on the LAN.

Remove the line stem = 'host.' to return information from rxGetMacAddr( 'ACOMPUTER' ) as a string and not as a stem.
Then you can PARSE VALUE rxGetMacAddr( 'ACOMPUTER' ) WITH name' 'macaddr' 'ipaddr'0D0A0D0A'x .


The code included in the example below behave like this:
host.1.name               computername, like ACOMPUTER
host.1.macaddr           mac address for computer ACOMPUTER in hex format, like  00:50:BA:DA:DD:A4
host.1.ipaddr              ip address for computer ACOMPUTER in standard ip format, like 192.168.0.1

host.2.name               computername, like COMPUTER2
...                              etc.

This example also contain code to send "Wake on Lan in REXX". Please see the original unmodified code (magic.cmd) in the original thread started by Andy P.

/*
* Filename: macaddr.cmd
*   Author: JAN-ERIK LÄRKA
*  Created: Mon Sep 10 2012
*  Purpose: Retrieve MAC Address
*  Changes:
*/
stem = 'host.'
count = rxGetMacAddr()

DO i = 1 TO count
    /*magic.cmd*/
    /*Wake on Lan in REXX*/
    /*MAC = '11:22:33:44:55:66';*/
    MAC = host.i.macaddr
    SAY MAC;
    A = X2C(SUBSTR(MAC,1,2));
    B = X2C(SUBSTR(MAC,4,2));
    C = X2C(SUBSTR(MAC,7,2));
    D = X2C(SUBSTR(MAC,10,2));
    E = X2C(SUBSTR(MAC,13,2));
    F = X2C(SUBSTR(MAC,16,2));
    X = A||B||C||D||E||F;
    call RxFuncAdd 'SockLoadFuncs', 'rxsock', 'SockLoadFuncs';
    call SockLoadFuncs( '*' );
    SCT = SockSocket( 'AF_INET', 'SOCK_DGRAM', 'IPPROTO_UDP' );
    RC = SockSetSockOpt( SCT, 'SOL_SOCKET', 'SO_BROADCAST', '1' );
    RC = SockIOCtl( SCT, 'FIONBIO', '0' );
    adr.!family = 'AF_INET';
    /*adr.!addr   = '255.255.255.255';*/
    adr.!addr   = host.i.ipaddr
    adr.!port   = 9;
    S = COPIES( D2C(255) ,6 );
    T = COPIES( X ,16);
    G = COPIES( D2C(0) ,6 );
    RC = SockConnect( SCT, "adr.!" );
    STG = S||T||G;
    SAY STG;
    RC = SockSend( SCT, STG );
    call SockSoClose SCT;
END
RETURN 0

rxGetMacAddr: PROCEDURE EXPOSE (stem) /*Optional parameter <COMPUTERNAME>*/
    isStem = ( RIGHT( stem, 1 )  = '.' )
    stemval = STRIP( stem, 'T', '.' )
    retval = 0
    i = 1
    /* No parameters given, list all computers */
    IF ARG() = 0 THEN
    DO
        DO WHILE QUEUED() > 0; PARSE PULL; END;
        /* Computers on network */
        '@NET VIEW 2>&1|RXQUEUE'
        DO WHILE QUEUED() > 0
            PARSE UPPER VALUE LINEIN( 'QUEUE:' ) WITH '\\'computer.i' '.
            /* Add computer to list */
            IF LENGTH( computer.i ) > 0 THEN i = i + 1
        END
        computer.0 = i - 1
    END
    ELSE DO
        /* Search for a specific computer */
        computer.0 = 1
        computer.1 = TRANSLATE( ARG(1) )
    END
    j = 0
    DO WHILE QUEUED() > 0; PARSE PULL; END;
    DO i = 1 TO computer.0
        '@PING '||TRANSLATE( computer.i )||' 1 1 2>&1|RXQUEUE'
        DO WHILE QUEUED() > 0; PARSE PULL; END;
        '@ARP '||TRANSLATE( computer.i )||' 2>&1|RXQUEUE'
        DO WHILE QUEUED() > 0
            PARSE UPPER VALUE SUBWORD( LINEIN( 'QUEUE:' ), 2 ) WITH machex +17 ipnum .
            IF LENGTH( machex ) = 17 & LENGTH( ipnum ) > 7 THEN
            DO
                j = j + 1
                IF isStem THEN
                    INTERPRET stemval'.j.name = computer.i;'||stemval'.j.macaddr = TRANSLATE( machex, "0", " " );'||stemval'.j.ipaddr = ipnum;'||stemval'.0 = j; retval = j'
                ELSE
                    retval = retval||computer.i||' '||TRANSLATE( machex, "0", " " )||' '||ipnum||D2C(13)||D2C(10)
            END
        END
    END
RETURN retval


//Jan-Erik
#2
Networking / Re: Wake on LAN
2012.09.10, 09:32:05
Hello,

Neat!

Is it possible with rexx to find out the MAC address on the computers on the LAN?

Would it be interesting to only specify/use the hostname of the computer and with that run the magic.cmd code to wake that specific computer.

//Jan-Erik
#3
Hello,

I tried to search for OpenChat as well, but couldn't find anything useful as the search results came up with different Chat Channels etc.

Please do tell how to find it easily, possibly where as well.


//Jan-Erik
#4
/*
* 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
#5
Speed improvements applied to script on web server.
You should now get the data as soon as the data is available.

//Jan-Erik
#6
Rexx / Re: Database engine written in rexx
2012.09.04, 11:20:57
Update to rxdb.cmd

Can now handle mixed and lower case statements.
Before:
SELECT * FROM mytable WHERE pos( 'DOCUMENTS', fname ) != 0
Now:
sELect * FRoM mytable WhErE pos( 'DOCUMENTS', fname ) != 0

You should now also get better results from:
SELECT count(*), sum(filesize) from mytable WHERE pos( 'DOCUMENTS', fname ) != 0 GROUP BY path


Note that you have to handle mixed case comparisons like before.

Example:
select * from mytable Where pos( 'DOCUMENTS', fname ) != 0
can only find filenames with the text DOCUMENTS in upper case, while

select * from mytable Where pos( 'DOCUMENTS', translate( fname ) ) != 0
will find any filename that contain the text documents as the function "translate(...)" convert the text to upper case before the comparison.

Note: rxdb.cmd is a stand alone database engine but it doesn't (yet) work with ODBC.

//Jan-Erik
#7
Links to the page that now let you look at stock data from NASDAQ OMX.

Volvo B

Assa Abloy B

SSAB B

etc.
#8
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?
#9
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. :-/

#10
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
#11
THe problem with checkdisk will go away with some fixpack, yes.
I think it was a harmless but annoying bug they accidently had in the original OS/2 Warp 4 HPFS.

//Jan-Erik
#12
General Discussion / Re: Injoy
2012.07.14, 09:21:56
Hello,

the Firewall product contains several nifty things... but you have to click in the right spot AND enable some setting to find the IPSec VPN tunnel Wizard.


//Jan-Erik
#13
Programming / Re: WPS Classes
2012.07.11, 19:00:27
Lars,

please do also send me (jan-erik.larka@os2world.com) your "Post-it Class".

//Jan-Erik
#14
Applications / Re: Java for os2
2012.07.02, 09:18:31
Quote from: miturbide on 2012.07.01, 20:19:07
Nop.... I can not make megamek run.. I got the same error.

Me neither, it just barf at me with the same problem as described by martini.

______
(Firefox 10.0.5 and JDownloader doesn't seem to get along either on that computer, AMD Quad Core, as it cause a reboot after a sys3170 in popup.log). The same setup work (FF 10.0.5 and JDownloader) fine on a single core machine.  (MegaMek not tested there though)

//Jan-Erik
#15
Rexx / Re: Database engine written in rexx
2012.06.21, 23:44:11
REXX SQL Engine - Mid Summer Edition

Tweaks added The options you can set as environment variables
TCP/IP network connectionTested with a slightly modified example from EDM/2
External NLSNational Language Support available in Swedish and English


I'd like to ask for your help to add IPC through rxu.
A short example would be nice to have.

Regarding TCP/IP
Ensure that the port 2638 (41592, 41593, 42595, 41596, 41597, 42598, 45299 & 6110 if you consume ports by crashing) is open in your firewall and router.
Type in the command line:
rxdb TCPIP PRELOAD mytable
where "mytable" is a table in the right file format.
ON the "client" ide you can type tmsg <ip-number> SELECT TOP 300 COUNT(*),PATH FROM mytable WHERE PATH != '\' GROUP BY EXTENSION where <ip-number> should be replaced by something similar to 192.168.0.123
Close the server with QUIT on the client.

Use tmsg.cmd from EDM/2 (with port set to the one the server select to send the SQL query to use) and modify some of the code for example to:
/*------------------------------------------------------------------
* send message across ... loop in case entire message can't be sent
* in one SockSend()
*------------------------------------------------------------------*/
cr = d2c(13)
lf = d2c(10)
crlf = cr || lf

message = message || crlf

do while (message <> "")
  bytes = SockSend(socket,message)

  message = substr(message,bytes+1)
end
say date() time() ': sent'

   text = ''

IF TRANSLATE( ARG(1) ) <> 'QUIT' THEN
DO WHILE rc > -1 & chunk <> ''
   text = ''
       rc = SockRecv( socket, 'chunk', 1000 )
/*        IF rc < 0 | chunk = '' THEN
           text = text||crlf*/
       text = text||chunk
   SAY 'recieved:' rc ':' text
END
say date() time()


Is it possible to write code (workstation/client side) to figure out which port this db-server use when the client tries to connect?
How?
               
//Jan-Erik