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.


Topics - jep

Pages: [1] 2 3 ... 5
1
Rexx / Get MAC address of one or more computers on LAN
« on: 2012.09.10, 19:59:58 »
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.

Code: [Select]
/*
 * 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
Rexx / Stock Data for NASDAQ OMX (Stockholmsbörsen)
« on: 2012.09.03, 20:07:35 »
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)

Code: [Select]
/*
 * 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

3
Rexx / Call another script
« on: 2011.12.24, 12:20:51 »
Hello,

This script use another script (see "Database engine written in rexx") through the use of SysAddRexxMacro available in Rexxutil that come with Object Rexx and is included with eComstation.
Please note that cut and paste may not work reliably for certain special characters, so please ensure to double check the code before usage.

This script also contain some functions you may want to try somewhere else.
rxProgress can handle up to 6 values for progress at once.
It can be quite handy if you want to show how large each processing step is and how much of that has been handled.
It only update the progress bar every second even though you may call it more often.

Notice the use of RIGHT( STREAM( file.i, 'C', 'QUERY SIZE' ), 10 ) to be able to order output according to numeric file size with SELECT ... ORDER BY FILESIZE in rxdb.cmd (see "Database engine written in rexx").

Code: [Select]
/*
 * Filename: add2db.cmd
 *   Author: JAN-ERIK
 *  Created: Sat Dec 24 2011
 *  Purpose: Script that use another script to add data to database (csv-like)
 *  Changes:
*/

/* Load RexxUtil Library */
If RxFuncQuery('SysLoadFuncs') Then
Do
    Call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
    Call SysLoadFuncs
End

CALL SysCls
SAY ''
SAY ''
SAY ''
If RxFuncQuery('SysAddRexxMacro') Then
    RETURN 1

retval = SysAddRexxMacro( 'rxSQL','rxdb.cmd', 'B' )
IF ARG() = 0 THEN
DO
CALL CHAROUT , 'Specify drive to list and add to database: '
PARSE PULL answer
END
ELSE answer = ARG(1)

IF rxProcess( LEFT( answer, 1 )||':' ) THEN
    Call rxProgress 2, 1
RETURN 0

rxProcess: PROCEDURE EXPOSE  __meter.
    PARSE ARG path, progress, chunk
    IF progress = '' THEN progress = 0
    IF chunk = '' THEN chunk = 1
    rc = SysFileTree( path||'\*.*', 'folder', 'DO' )
    rc = SysFileTree( path||'\*.*', 'file', 'FO' )
    DO i = 1 TO file.0
        CALL rxBusy 1, file.i
        CALL rxProgress 2, progress + ( i - 1 ) / ( file.0 + folder.0 ) * chunk
        CALL rxSQL "INSERT INTO files (COMPUTER,PATH,NAME,DRIVE,FILESIZE) VALUES ('"||VALUE( 'HOSTNAME',, 'OS2ENVIRONMENT' )||"','"||FILESPEC( 'P', file.i )||"','"||FILESPEC( 'N', file.i )||"','"||FILESPEC( 'D', file.i )||"','"||RIGHT( STREAM( file.i, 'C', 'QUERY SIZE' ), 10 )||"')"
    END
    DO i = 1 TO folder.0
        CALL rxBusy 1, folder.i
        Call rxProgress 2, progress + ( i + file.0 - 1 ) / ( file.0 + folder.0 ) * chunk
        CALL rxProcess folder.i, progress + ( i + file.0 - 1 ) / ( file.0 + folder.0 ) * chunk, chunk / ( file.0 + folder.0 )
    END
RETURN 1

/* display_on_row, part  */
rxProgress: PROCEDURE EXPOSE  __meter.
/*    IF TRACE() <> 'O' THEN RETURN 0*/
    row = ARG(1)
    chr = '█▓▒░■█ '
    IF \DATATYPE( __meter.width, 'W' ) THEN
        PARSE VALUE SysTextScreenSize() WITH . __meter.width
    DO i = 2 TO MIN( ARG(), LENGTH( chr ) )
        j = i - 1
        IF \DATATYPE( ARG(i), 'N' ) THEN RETURN 0
        progress.j = FORMAT( ARG(i),,, 0 )
        IF LENGTH( FORMAT( 100 * progress.j,, 0, 0 ) ) > 3 THEN
            RETURN 0
    END
    progress.0 = j
    processed.0 = 0
    output = ''
    CALL SysStemSort 'progress'
    DO i = 1 TO MIN( progress.0, LENGTH( chr ) )
        j = i - 1
        processed.i = FORMAT( MIN( ( __meter.width - 4 ) * progress.i , __meter.width - 4 ),, 0, 0 )
        progress.i = FORMAT( 100 * progress.i, 3, 0, 0 )
       
        IF processed.i > processed.j THEN
            output = output||COPIES( SUBSTR( chr, i, 1 ), processed.i - processed.j )
    END
    i = i - 1
    output = output||COPIES( SUBSTR( chr, LENGTH( chr ), 1 ), __meter.width - 4 - processed.i )
    CALL rxOut ARG(1), output||RIGHT( progress.1||'%', 4 )
RETURN 0
 
/* display_on_row, text  */
rxBusy: PROCEDURE EXPOSE __meter.
/*    IF TRACE() <> 'O' THEN RETURN 0*/
    PARSE ARG row, txt   
    IF \DATATYPE( __meter.row.t_stamp , 'N' ) THEN
        __meter.row.t_stamp = TIME( 'S' )
    IF __meter.row.t_stamp + 1 < TIME( 'S' ) THEN
    DO
        SELECT
            WHEN __meter.counter = 1 THEN
                CALL rxOut row, '/ '||txt
            WHEN __meter.counter = 2 THEN
                CALL rxOut row, '- '||txt
            WHEN __meter.counter = 3  THEN
                CALL rxOut row, '\ '||txt
            OTHERWISE
            __meter.counter = 0
            CALL rxOut row, '| '||txt
        END
        __meter.counter = __meter.counter + 1
    END
RETURN 0
 
/* display_on_row, text  */
rxOut: PROCEDURE EXPOSE __meter.
/*    IF TRACE() <> 'O' THEN RETURN 0*/
    PARSE ARG row, txt
    IF \DATATYPE( __meter.row.t_stamp, 'W' ) THEN
        PARSE VALUE SysTextScreenSize() WITH . __meter.width
    isNum = DATATYPE( row, 'W' )
    IF isNum THEN
    DO
        IF DATATYPE( __meter.row.t_stamp, 'W' ) THEN
            IF __meter.row.t_stamp + 1 > TIME( 'S' ) THEN RETURN 0
        PARSE VALUE SysCurPos( row, 0 ) with prev_row prev_col
    END
    ELSE IF DATATYPE( __meter.row.t_stamp, 'W' ) THEN
        IF __meter.row.t_stamp + 1 > TIME( 'S' ) THEN RETURN 0
    SAY LEFT( txt, MAX( __meter.width, MIN( LENGTH( ARG(2) ), __meter.width ) ) )
    IF isNum THEN
    DO
        CALL SysCurPos prev_row, prev_col
        __meter.row.t_stamp = TIME( 'S' )
    END
    ELSE
        __meter.row.t_stamp = TIME( 'S' )
RETURN 0

Merry XMas from Sweden
//Jan-Erik

4
Rexx / Database engine written in rexx
« on: 2011.12.24, 12:02:42 »
Hello,

I'm working quite alot with databases these days and therefore came up with the idea to write one on my own  ;)
So here's my initial version, that support group and sort* with the help of SysStemSort (available in the Object Rexx version of rexxutil included with eComStation)
Please feel free to try it out.

There are hand made functions at the end of the script that may be handy to use elsewhere as well.

Usage:
   Example for table "files" with some columns related to file info

   CREATE TABLE files COLUMNS (COMPUTER,DRIVE,PATH,NAME,FILESIZE,CRC32,MODIFIED)
   INSERT INTO files (DRIVE,PATH,NAME) VALUES ('J:','\Temp\','MyFile.txt')
   UPDATE files SET COMPUTER = 'eComStation PC' WHERE PATH = '\Temp\'
   SELECT * FROM files WHERE DRIVE = 'J:' GROUP BY COMPUTER ORDER BY PATH
   DELETE FROM files WHERE COMPUTER != 'eComStation PC'
   VACUUM TABLE files WHERE DRIVE != 'J:'

Notice!
The engine doesn't care about
duplicate data (so you may add the same info several times)
primary keys
or
relations between tables

You can leave out columns in SELECT and INSERT INTO ... and add them unorderd, the "engine" will take care of how to match the entered data to the table layout on disk, just as other database engines do.
   INSERT INTO files (PATH,DRIVE,NAME) VALUES ('\Temp\','J:','MyFile.txt')
and
   INSERT INTO files (DRIVE,PATH,NAME) VALUES ('J:','\Temp\','MyFile.txt')
in the example will both be saved to the table created by
   CREATE TABLE files COLUMNS (COMPUTER,DRIVE,PATH,NAME,FILESIZE,CRC32,MODIFIED)
as
"","J:","\Temp\","MyFile.txt","","",""

The engine contain code to handle strings that contain ' and , that would otherwise cause problems.
You may want to use != to exclude data:
rxdb SELECT * FROM files WHERE DRIVE != 'C:'
to exclude entries that contain C: in the column DRIVE as you can't use <> on the command line.

*SysStemSort sort data according to each characters ascii value.
Therefore, add numeric data formatted/padded with space or zeros in front if you want to sort by something like FILESIZE.
Example (non padding):
0
16
168
5
54
75
91
99
Example (space):
    0
    5
  16
  54
  75
  91
  99
168
which can be achieved with RIGHT( mynumber, 3 ) for numbers up to 999
Code: [Select]
/*
 * Filename: rxdb.cmd
 *   Author: JAN-ERIK LÄRKA
 *  Created: Sat Dec 24 2011
 *  Purpose: Database engine entirly written in REXX
 *  Changes:
 */

/* Don't echo commands */
'@ECHO OFF'

/* place argument in variable */
sqlstr.input = ARG(1)

/* Add procedures to handle problems */
SIGNAL ON ERROR NAME SignalError
SIGNAL ON FAILURE NAME SignalFailure
SIGNAL ON HALT NAME SignalHalt
SIGNAL ON NOVALUE NAME SignalNoValue
SIGNAL ON SYNTAX NAME SignalSyntax
SIGNAL ON NOTREADY NAME SignalNotReady

/* Load RexxUtil Library */
IF RxFuncQuery('SysLoadFuncs') THEN
Do
    CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
    CALL SysLoadFuncs
END
values = ''
columns = ''

/* An array with supported arguments */
sqlstr.1 = "'SELECT 'columns' FROM 'table' 'rest"
sqlstr.2 = "'INSERT INTO 'table' ('columns') VALUES ('rest"
sqlstr.3 = "'UPDATE 'table' SET 'rest"
sqlstr.4 = "'DELETE FROM 'table' 'rest"
sqlstr.5 = "'CREATE TABLE 'table' COLUMNS ('columns')'rest"
sqlstr.6 = "'VACUUM TABLE 'table' 'rest"
sqlstr.0 = 6

/* Check to see what argument has been entered */
DO sqlcase = 1 TO sqlstr.0
    IF WORD( sqlstr.input, 1 ) = STRIP( WORD( sqlstr.sqlcase, 1 ),, "'" ) THEN
    DO
        INTERPRET 'PARSE VALUE sqlstr.input WITH '||sqlstr.sqlcase
        /* Fix to handle the case where data may contain ) that would cause problems */
        IF sqlcase = 2 THEN
        DO
            values = WRDS( rest, ',', COUNTSTR( ',', columns ), ')' )
            rest = SUBSTR( rest, LENGTH( values ) + 2 )
        END
        LEAVE sqlcase
    END
END
/*  Show usage if argument didn't match those supported */
IF sqlcase > sqlstr.0 THEN SIGNAL VALUE "USAGE"

/* Create an array for the names of the trailing parameters */
sqlstr.1.1 = 'table'
sqlstr.1.2 = ''
sqlstr.1.3 = 'columns'
sqlstr.1.4 = 'table'
sqlstr.1.5 = ''
sqlstr.1.6 = 'table'

/* Create arrays for the optional additional arguments */
sqlvar.2 = 'conditions'
sqlvar.3 = 'group'
sqlvar.4 = 'order'
sqlvar.5 = '.'

sqlclause.2 = 'WHERE'
sqlclause.3 = 'GROUP BY'
sqlclause.4 = 'ORDER BY'
sqlclause.5 = 'DESC'
sqlclause.0 = 5

/* Check if the last word is DESC or D and modify sort order from the default Ascending */
IF SUBWRDS( rest, ',', -1 ) = 'DESC'  THEN
    sort = '"D"'
ELSE
    sort = ''

/* Check the optional arguments */
i = 1
DO j = sqlclause.0 TO 2 BY -1
    IF j > 1 & j < 5 THEN INTERPRET sqlvar.j' = ""'
    IF POS( sqlclause.j, rest ) > 0 THEN
    DO
        INTERPRET 'PARSE VALUE rest WITH rest "'||sqlclause.j||'" '||sqlvar.j
        IF sqlvar.j <> '.' THEN
            INTERPRET sqlvar.j||' = STRIP( VALUE( "'||sqlvar.j||'" ) )'
    END
END
/* Name the trailing parameters */
IF LENGTH( STRIP( rest ) ) > 0 THEN
    INTERPRET 'PARSE VALUE rest WITH '||sqlstr.1.sqlcase||';IF '||sqlstr.1.sqlcase||' <> "" THEN '||sqlstr.1.sqlcase||' = STRIP( VALUE( "'||sqlstr.1.sqlcase||'" ) )'

/* Combine groups and order as both specify how to order data */
IF ( LENGTH( STRIP( order ) ) > 0 ) THEN
DO
    order = order||','
    IF ( LENGTH( STRIP( group ) ) > 0 ) THEN
        order = ','||order
END
ELSE IF ( LENGTH( STRIP( group ) ) > 0 ) THEN
        group = group||','
group = STRIP( CHANGESTR( ',', group||order, '","' ), 'T', '"' )

/* Set file name extension of table */
table = table||'.rxdb'

/* Check if the table has been created */
IF STREAM( table, 'C', 'QUERY EXISTS' ) <> '' THEN
DO

    columns = STRIP( CHANGESTR( '"', columns, '' ) )
    colnames = LINEIN( table )
    cols = COUNTSTR( ',', colnames ) + 1
    
    IF sqlcase = 1 THEN /* SELECT FROM ... */
    DO
        parse_columns = CHANGESTR( "'", CHANGESTR( '"', colnames, '' ), '' )
        columns = CHANGESTR( '*', CHANGESTR( ',', columns, '","' ), colnames )
        select_direct = ( LENGTH( group ) = 0 )
        
        /* Modify condition(s) to look at the right "column" */
        DO j = 1 TO cols
            PARSE VALUE parse_columns WITH colname','parse_columns
            conditions = CHANGESTR( colname, conditions, 'STRIP( SUBWRD( input, '||j||', '||"'"||'","'||"'"||' ),, '||"'"||'"'||"' )" )
        END
        /* Modify the != command line argument to <> (One doesn't work on the command line while the other can't be interpreted) :-/ */
        conditions = CHANGESTR( '!=', conditions, '<>' )
        count = 0
        grps = COUNTSTR( ',', group )
        
        /* Go through each line in the database */
        DO WHILE LINES( table ) > 0
            input = LINEIN( table )
            IF LEFT( input, 1 ) = '*' | LENGTH( input ) = 0 THEN ITERATE
            IF LENGTH( conditions ) > 0 THEN
                INTERPRET 'result = ('||conditions||')'
            ELSE result = 1
            /* Does the condition match?! */
            IF result THEN
            DO
                count = count + 1
                INTERPRET 'PARSE VALUE input WITH '||STRIP( colnames,, '"' )||';sqlstr.count = '||STRIP( group||columns,, '"' )
                IF select_direct THEN SAY sqlstr.count
            END
        END
        /* We need go through this as well if the data has to be sorted */
        IF \select_direct THEN
        DO
            sqlstr.0 = count
            IF sqlstr.0 > 0 & LENGTH( order ) > 0 THEN
                Call SysStemSort 'sqlstr.', sort
            DO count = 1 TO sqlstr.0
                SAY SUBWRDS( sqlstr.count, ',', grps )
            END
        END
        CALL STREAM table, 'C', 'CLOSE'
    END
    ELSE IF sqlcase = 2 THEN /* INSERT INTO... */
    DO
        /* Set up the arguments with the right style */
        columns = CHANGESTR( '*', CHANGESTR( ',', columns, '","' ), colnames )
        /* Empty all variables (column names) to recieve data */
        INTERPRET 'PARSE VALUE "" WITH '||STRIP( colnames,, '"' )
        /* Special handling for ' and , that are crutial parts of the database file format */
        INTERPRET 'PARSE VALUE "'||CHANGESTR( D2C(1), CHANGESTR( ",", CHANGESTR( "'", STRIP( CHANGESTR( "','", values, D2C(1) ),, "'" ), D2C(2) ), D2C(3) ), ',' )||'" WITH '||columns||';temp = '||STRIP( colnames,, '"' )
        CALL STREAM table, 'C', 'SEEK <0'
        /* Write the added data to the database table file */
        CALL LINEOUT table, '"'||CHANGESTR( D2C(3), CHANGESTR( ',', CHANGESTR( D2C(2), temp, "'" ), '","' ), ',' )||'"'
        CALL STREAM table, 'C', 'CLOSE'
    END
    ELSE IF sqlcase = 3 | sqlcase = 4 THEN /* UPDATE ... and DELETE FORM ... */
    DO
        IF sqlcase = 3 THEN /* UPDATE ... */
        DO
            parse_columns = columns
            /* Replace with the input that point to a column name */
            DO k = 1 TO cols
                PARSE VALUE parse_columns WITH col'='val','parse_columns
                col = STRIP( col )
                val = STRIP( val )
                columns = CHANGESTR( col'='val, columns, 'input = CHANGEWRD( input, '||j||', ",", '||"'"||'"'||"'"||val||"'"||'"'||"'"||' )' )
            END
        END
        /* Go through the database table */
        DO WHILE LINES( table ) > 0
            input = LINEIN( table )
            IF LEFT( input, 1 ) = '*' | LENGTH( input ) = 0 THEN ITERATE
            IF LENGTH( conditions ) > 0 THEN            
                INTERPRET 'result = ('||conditions||')'
            ELSE result = 1
            /* Mark each matching entry as deleted */
            IF result THEN
            DO
                strpos = STREAM( table, 'C', 'SEEK -'||( LENGTH( input ) + 2 ) )
                CALL LINEOUT table, '*'||SUBSTR( input, 2 )
                /* Add the modified version last for UPDATE ... */
                IF i = 3 THEN /* UPDATE ... */
                DO
                    CALL STREAM table, 'C', 'SEEK <0'
                    INTERPRET columns
                    CALL LINEOUT table, input
                    CALL STREAM table, 'C', 'SEEK ='||( strpos + LENGTH( input ) )
                END
            END
        END
        CALL STREAM table, 'C', 'CLOSE'
        RETURN 0
    END
    ELSE IF sqlcase = 6 THEN /* VACUUM TABLE ... */
    DO
        /* Write the table names to a new temporary database table file */
        CALL LINEOUT table||'_tmp', colnames
        /* Write each non-deleted row the new temporary database table file */
        DO WHILE LINES( table ) > 0
            input = LINEIN( table )
            IF LEFT( input, 1 ) = '*' THEN ITERATE
            CALL LINEOUT table||'_tmp', input
        END
        CALL STREAM table||'_tmp', 'C', 'CLOSE'
        CALL STREAM table, 'C', 'CLOSE'
        /* Write all row back to the new database table file */
        IF SysFileDelete( table ) = 0 THEN
        DO WHILE LINES( table||'_tmp' ) > 0
            CALL LINEOUT table, LINEIN( table||'_tmp' )
        END
        CALL STREAM table||'_tmp', 'C', 'CLOSE'
        CALL STREAM table, 'C', 'CLOSE'
        CALL SysFileDelete table||'_tmp'
    END
    ELSE SIGNAL VALUE "TABLEALREADYEXISTS"
END
ELSE IF sqlcase = 5 THEN /* CREATE TABLE ... */
DO
    /* Create a file if not found */
    CALL LINEOUT table, '"'||CHANGESTR( ',', STRIP( columns,, '"' ), '","' )||'"'
    CALL STREAM table, 'C', 'CLOSE'
END
ELSE SIGNAL VALUE "TABLENOTFOUND"
RETURN 0

TableAlreadyExists:
    CALL LINEOUT 'STDERR', '[REXX SQL Engine] Table already exists, please specify a new table name or use the existing.'
    SAY ''
    CALL Usage
RETURN 7


TableNotFound:
    CALL LINEOUT 'STDERR', '[REXX SQL Engine] Table not found, create the table first'
    CALL LINEOUT 'STDERR', ''
    CALL Usage
RETURN 7

Usage:
    CALL LINEOUT 'STDERR', 'Usage:'
    CALL LINEOUT 'STDERR', '   Example for table "files" with some columns related to file info'
    CALL LINEOUT 'STDERR', ''
    CALL LINEOUT 'STDERR', '   CREATE TABLE files COLUMNS (COMPUTER,DRIVE,PATH,NAME,FILESIZE,CRC32,MODIFIED)'
    CALL LINEOUT 'STDERR', "   INSERT INTO files (DRIVE,PATH,NAME) VALUES ('J:','\Temp\','MyFile.txt')"
    CALL LINEOUT 'STDERR', "   UPDATE files SET COMPUTER = 'eComStation PC' WHERE PATH = '\Temp\'"
    CALL LINEOUT 'STDERR', "   SELECT * FROM files WHERE DRIVE = 'J:' GROUP BY COMPUTER ORDER BY PATH"
    CALL LINEOUT 'STDERR', "   DELETE FROM files WHERE COMPUTER != 'eComStation PC'"
    CALL LINEOUT 'STDERR', "   VACUUM TABLE files WHERE DRIVE != 'J:'"
    CALL LINEOUT 'STDERR', ''
RETURN 0
    
SignalError:
    SIGNAL OFF ERROR
    CALL LINEOUT 'STDERR', '[REXX SQL Engine] Error: Error processing command.'
    CALL LINEOUT 'STDERR', ''
RETURN 1
    
SignalHalt:
    SIGNAL OFF HALT
    CALL LINEOUT 'STDERR', '[REXX SQL Engine] Halt: Execution of the command has stopped.'
    CALL LINEOUT 'STDERR', ''
RETURN 2
    
SignalSyntax:
    SIGNAL OFF SYNTAX
    CALL LINEOUT 'STDERR', '[REXX SQL Engine] Syntax: The syntax of the command is incorrect.'
    CALL LINEOUT 'STDERR', ''
    CALL LINEOUT 'STDERR', ARG(1)||D2C(13)||D2C(10)||D2C(13)||D2C(10)||'should be on the form: '||SPACE( STRIP( TRANSLATE( sqlstr.sqlcase,, "'" ) ), 1 )||D2C(13)||D2C(10)||D2C(13)||D2C(10)||'where "rest" can be combined (in specified order) with:'
    DO i = 2 TO sqlclause.0 - 1
        CALL LINEOUT 'STDERR', sqlclause.i||' '||sqlvar.i
    END
    CALL LINEOUT 'STDERR', sqlclause.i||'     (to sort in descending order)'
    CALL LINEOUT 'STDERR', ''
    CALL STREAM table, 'C', 'CLOSE'
RETURN 3
    
SignalFailure:
    SIGNAL OFF FAILURE
    CALL LINEOUT 'STDERR', '[REXX SQL Engine] Failure: The system could not process the command.'
    CALL LINEOUT 'STDERR', ''    
RETURN 4
    
SignalNoValue:
    SIGNAL OFF NOVALUE
    CALL LINEOUT 'STDERR', "[REXX SQL Engine] NoValue: The variable "||CONDITION( 'D' )||" doesn't contain data."
    CALL LINEOUT 'STDERR', ''
    CALL Usage
RETURN 5
    
SignalNotReady:
    SIGNAL OFF NOTREADY
    CALL LINEOUT 'STDERR', '[REXX SQL Engine] Not Ready: Could not process the command.'
    CALL LINEOUT 'STDERR', ''
RETURN 6
    
/* Change word number x in haystack, delimited by "delimiter" to new word */    
CHANGEWRD: PROCEDURE /* haystack, wrdpos, <delimiter>, newwrd */
    PARSE ARG haystack, wrdpos, delimiter, newwrd
    IF delimiter = '' THEN delimiter = ' '
    retval = ''
    DO i = 2 TO wrdpos
        PARSE VALUE haystack WITH pre(delimiter)haystack
        retval = retval||pre||delimiter
    END
    PARSE VALUE haystack WITH pre(delimiter)haystack
RETURN retval||newwrd||delimiter||haystack
    
/* Count occurances of delimiter after the first occurance of needle */
WRDPOS: PROCEDURE /* needle, haystack<, delimiter> */
    PARSE ARG needle, haystack, delimiter
    IF POS( needle, haystack ) = 0 THEN RETURN 0
    PARSE VALUE haystack WITH pre(needle)post
    IF delimiter = '' THEN delimiter = ' '
RETURN COUNTSTR( delimiter, pre ) + 1

/* N:th word in haystack delimited by delimiter (space by delfault) */
SUBWRD: PROCEDURE /* haystack, wrdpos<, delimiter> */
    PARSE ARG haystack, wrdpos, delimiter
    IF delimiter = '' THEN delimiter = ' '
    DO i = 2 TO wrdpos
        PARSE VALUE haystack WITH .(delimiter)haystack
    END
    PARSE VALUE haystack WITH haystack(delimiter).
RETURN haystack
    
/* Number of word in haystack delimited by delimiter (space by delfault) starting at start word */
SUBWRDS: PROCEDURE /* haystack, delimiter<, start_wrd<, wrds>> */
    PARSE ARG haystack, delimiter, start_wrd, wrds
    start_pos = 0
    end_pos = 0
    IF start_wrd = '' THEN start_wrd = 1
    IF start_wrd = -1 THEN
        start_pos = LASTPOS( delimiter, haystack )
    ELSE IF start_wrd = 0 THEN
        start_pos = 1
    ELSE DO
        DO i = 1 TO start_wrd
            start_pos = POS( delimiter, haystack, start_pos + 1 )
            IF start_pos = 0 THEN RETURN ''
        END
    END
    IF DATATYPE( wrds, 'W' ) THEN
    DO
        end_pos = start_pos
        DO i = 1 TO wrds
            end_pos = POS( delimiter, haystack, end_pos + 1 )
            IF end_pos = 0 THEN LEAVE i
        END
    END
    IF start_pos > 0 THEN
    DO
        IF end_pos < 1 | wrds = '' | start_wrd < 0 THEN end_pos = LENGTH( haystack )
        haystack = SUBSTR( haystack, start_pos + 1, end_pos - start_pos - 1 )
    END
    ELSE RETURN ''
RETURN haystack
    
/* Up to characters in text (haystack) after the N:th number of occurances of delimiter */
WRDS: PROCEDURE /* haystack<, delimiter<, wrdpos<, tochar>>> */
    PARSE ARG haystack, delimiter, wrdpos, tochar
    IF delimiter = '' THEN delimiter = ' '
    IF wrdpos = '' THEN wrdpos = COUNTSTR( delimiter, haystack )
    strpos = POS( tochar, haystack, LENGTH( SUBWRDS( haystack, delimiter, 0, wrdpos ) ) + 1 ) - 1
    IF strpos > 0 THEN
        RETURN SUBSTR( haystack, 1, strpos )
RETURN haystack
    
/* Replace one string (needle) with another (newneedle) in text (haystack) */
CHANGESTR: PROCEDURE /* needle, haystack <, newneedle> */
    PARSE ARG needle, haystack, newneedle
    new_haystack = ''
    DO WHILE POS( needle, haystack ) > 0
        PARSE VALUE haystack WITH pre(needle)haystack
        new_haystack = new_haystack||pre||newneedle
    END
RETURN new_haystack||haystack

/* Count the number of occurances of needle in haystack from start pos to end pos (whole string by default) */
COUNTSTR: PROCEDURE /* needle, haystack< <, startpos>, endpos> */
    IF ARG() < 2 THEN RETURN -1
    IF DATATYPE( ARG(3), 'W' ) THEN
        next = ARG(3)
    ELSE
        next = 1
    needle = ARG(1)
    haystack = ARG(2)
    IF DATATYPE( ARG(4), 'W' ) THEN
        haystack = SUBSTR( haystack, next, ABS( ARG(4) - next ) )
    next = 1
    count = 0
    DO WHILE next > 0
        next = POS( needle, haystack, next )
        IF next > 0 THEN DO
            next = next + LENGTH( needle )
            count = count + 1
        END
    END
RETURN count

Merry XMas from Sweden
//Jan-Erik

5
Rexx / Java 6 and JDownloader with REXX
« on: 2011.10.09, 18:15:14 »
Hello,

this is my code to start and use JAVA 6 with e.g. JDownloader.

Usage:
  • Save it to e.g. javarun.cmd and place it in the java6\bin folder.
    Run it once and it'll create a WPS Program Object in the Command Prompts folder and associate it with .jar-files
  • Double click on a jar file and it'll ask if it should create a Program Object on the desktop for it
    If you place an .ico file next to it with the same base name as the .jar file, it'll create the program object with that icon.
  • It set some configuration code for path and beginlibpath before it run the jar-file.

Note 1:Please place the attached Java6.ico next to the script in the java6\bin folder
Note 2: Tested with JDownloader, place that attached icon next to the .jar-file with the same name ;)

Code: [Select]
/* Rexx wrapper to start Java apps */

/* Load RexxUtil Library */
IF RxFuncQuery('SysLoadFuncs') THEN
DO
    CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
    CALL SysLoadFuncs
END

PARSE SOURCE . . myRexxScript
java_dir = STRIP( FILESPEC( 'D', myRexxScript )||FILESPEC( 'P', myRexxScript ), 'T', '\' )

IF wpsObjectExist( '<RUN_JAVA6>' ) = 0 THEN
    rc = SysCreateObject( "WPProgram", "Java 6", "<WP_PROMPTS>", "OBJECTID=<RUN_JAVA6>;EXENAME="||myRexxScript||';PARAMETERS=-jar -Xmx512m "%**P\%**F";ICONFILE='||java_dir||'\java6.ico;ASSOCFILTER=*.jar;' )

PARSE VALUE REVERSE( ARG(1) ) WITH '"'ext'.'app'\'app_path'" m215xmX- raj-'
IF LENGTH( app ) > 0 THEN
DO
    app = REVERSE( app )
    app_path = REVERSE( app_path )
    objID = TRANSLATE( app )
    IF wpsObjectExist( '<WP_'||objID||'>' ) = 0 THEN
    DO
        CALL CHAROUT , 'Do you want to create an object on the desktop for '||app||'? (Y/n)'
        PARSE UPPER PULL answer
        IF answer <> 'N' THEN
            rc = SysCreateObject( "WPProgram", app, "<WP_DESKTOP>", "EXENAME="||myRexxScript||";PROGTYPE=PROG_WINDOWABLEVIO;PARAMETERS="||ARG(1)||";STARTUPDIR="||TRANSLATE( app_path )||";MINIMIZED=YES;OBJECTID=<WP_"||objID||">;ICONFILE="||app_path||"\"||app||".ico;" )
    END
END

CALL VALUE 'PATH', java_dir||';'||VALUE( 'PATH', 'OS2ENVIRONMENT' ), 'OS2ENVIRONMENT'
IF RxFuncQuery( 'SysSetExtLibPath ' ) Then
    'SET BEGINLIBPATH='||java_dir||';%BEGINLIBPATH%'
ELSE
    CALL SysSetExtLibPath java_dir||';'||SysQueryExtLIBPATH( 'B' ), 'B'
JAVA ARG(1)
RETURN rc

/* Code borrowed from REXX Tips & Tricks v3.60 */
wpsObjectExist: PROCEDURE /* parameter: '<new_wps_object_id>', return: 1 exist, 0 doesn't exist, 43 error */
  PARSE ARG objID
  rc = 43               /* init return/error code 43 = routine not found */
  SIGNAL ON SYNTAX NAME ObjectExistError

  IF SUBSTR( objID, 2, 1 ) <> ":" THEN
    IF LEFT( objID, 1 ) <> "<" & RIGHT( objID, 1 ) <> ">" THEN
      objID = "<" || objID || ">"

  /* create the object and see if it fail */
  tempRC = SysCreateObject( "WPFolder", "TestObject", "<WP_NOWHERE>", "OBJECTID=" || objID || ";", "FAIL" )

  IF tempRC = 1 THEN
  DO
    CALL SysDestroyObject objID
    rc = 0
  END
  ELSE
    rc = 1

ObjectExistError:

RETURN rc

REXX can do so much... use it!
Write a dll that both rexx and other apps can use instead of VIO/CLI apps!
Wrap the dll with a rexx script to do what the app does in other OS's!

6
Programming / Image Alpha + Transparency
« on: 2011.06.14, 14:00:03 »
Hello,

I've written a simple C++ class to take care of displaying images that contain transparency and/or alpha with the help of GBM by Heiko Nitzsche. I've also tried to make it more robust and forgiving than the examples I've seen elsewhere, so that it can handle situations/configurations where e.g. transparency support isn't available (SVGA graphics driver).

I've borrowed one of the images that come with the screen saver that display a nice clock made by Doodle.

I do however need your help with the provided example to:
a) Get smoother edges as compared to if you remove // in front of the line MeterImage.mapTransparancy2Color( CLR_PALEGRAY );
b) Reduce memory consumption as the code has to be rewritten to take care of it better.
c) A function to allow it to drawAt( HPS hps, int x, int y )
d) Allow it to share bitmaps to mix several images together
...

Your help is greatly appreciated
//Jan-Erik

Compiler: OpenWatcom
Linker:
Lib-directories: ?:\...\GBM\lib.wat
Libraries: gbm.lib,gbmmem.lib,gbmscale.lib
C++ compiler:
Inlude-directories: ...;?:\...\gbmos2

7
Security / Security/2 in eComStation 2.0
« on: 2011.04.18, 09:51:57 »
Hello,

I've tried Security/2 (0.4.5) with eComStation 2.0 GA and found it to be very interesting and with potential.
It seem to allow us to add secured login to the desktop and possibly multiple WPS desktops (1 per user).

There are however some things that remain unclear to me, that I need to ask you for guidance.
As mentioned by others in the original topic from 2007, I also have problems to set the HOME environment variable (system doesn't use it), it use the OS2 folder by default and it seem to me that one need to copy/create e.g. os2.ini and os2ini.ini to the folder one set as the user directory?!

Another ting, am I supposed to edit the acls-file by hand to allow/deny access various tools and folders?
Is there an editor (GUI, preferaply WPS integrated and then I mean not just a plain text editor) somewhere that can simplify the configuration task?

I'd like to set one account to allow me to start the DOS Command line, but that is not possible as it denies it. What setting should I use? An editor or documentation by example would be nice to have.

//Jan-Erik

8
Multimedia / How do I convert this?
« on: 2011.03.02, 20:16:29 »
I have 120 images that I've converted to an animation ( eCs.fli, 11.3 Mb ) that look great (in my opinion at least) in the built in player for OS/2-eCS. However, I'd like to convert it to another format (mpeg) but still maintain compability with the built in player. ffmpeg can compress it to 160 - 260 kB, but compability seem to go down the drain, why?

9
Applications / QT 4.6.2 apps screen corruption
« on: 2010.06.30, 13:36:25 »
Hello,

I've installed a few QT apps (SMPlayer 0.6.9 and Arora etc.) that all seem to have the same problem...
screen corruption as soon as I try to use them.

The tooltips cause the background to show through, move the window and the desktop/background will bleed through until you e.g. put another window in front of it etc.
Previous version of QT (3?) doesn't seem to have the same problems at all other same machine with e.g. the SQLLite Browser.

SMPLayer can't show any files either... so I have to use MPlayer alone.
QT doesn't render the SMPlayer settings window properly, unless I put another window in front of it for a moment.
Arora seem to have the same problem, especially for areas where it doesn't redraw often like the buttons and background next to the buttons as well as the scrollbars.
I can also see that Arora is unstable, but I haven't checked the logs, but suspect that is has to do with what Rudi replied to in another thread.

Any idea's why?
Suggestions?

//Jan-Erik

10
Rexx / Parse a CSV-file and create a stem.
« on: 2010.02.28, 11:29:46 »
Marked as: Easy
Hi,

this time I've looked at the file that the crc32 script* created to illustrate what one can do with the data to build a stem (array of values)

The function build a stem (array of values) in the form
csv.first_column_name.1
csv.first_column_name.2
...
csv.first_column_name.n
csv.second_column_name.1
...
based on what it can find on the first row.

You can also alter the behavior to the more traditional stems with integer values
csv.1.1
csv.1.2
...
csv.1.n
csv.2.1
...
if you remove the comment around "integer_style = 1"

You have the opportunity to specify how many rows should be parsed just as if you'd import the file with OpenOffice.org Calc, Lotus Smartsuite 123 or similar.
Specify a number as the second argument to the function to create a stem as a preview of just a few rows.

The delimiter character specify how to split up each row, while the symbol for quotation mark specify how to strip characters that surround text.


*Other applications also create and can use csv-files, so you can use this for other purposes as well.

Code: [Select]
/* Example how to parse a csv-file */

delimiter = ',' /* Change to the C2D(...) function for some characters like tab */
quotation_mark = '"'
/* integer_style = 1 */
CALL ParseCSV ARG(1)
IF csv.0 > 0 THEN
DO
    total = csv.1 /* total contain the name or number of the first column, we reuse the variable and dont use another */
    total = VALUE( 'csv.'total'.0' ) /* We assume that every column contain equally many rows */
END
ELSE RETURN 0

DO i = 1 TO total
    DO j = 1 TO csv.0
        col_name = csv.j
        SAY csv.col_name.i
    END
END

RETURN 0
/* Remove the line "RETURN 0" above to get to the code below */

/* Code below is specific to the file produced with the crc32 script */
DO i = 1 TO total
    j = i + 1
    DO WHILE csv.crc32.i = csv.crc32.j
        IF csv.filesize.i = csv.filesize.j THEN
        DO
            IF csv.computer.i <> csv.computer.j & csv.path.i = csv.path.j THEN j = j + 1
            ELSE DO
                SAY 'Delete 'csv.drive.j||csv.path.j||csv.name.j||'? (y/N)'
                PARSE PULL answer
                IF LEFT( TRANSLATE( answer ), 1 ) = 'Y' THEN /* Anything else than Y followed by Enter will be interpreted as NO, just Enter = NO as well */
                    '@del "'||csv.drive.j||csv.path.j||csv.name.j||'"'
            END
        END
        j = j + 1
    END
    i = j
END

RETURN total

ParseCSV: PROCEDURE EXPOSE csv. delimiter quotation_mark integer_style
    f_name = ARG(1)
    csv.0 = 0
    i = 0
    CALL STREAM f_name, 'C', 'OPEN'
    DO WHILE LINES( f_name ) > 0
        IF i = ARG(2) THEN RETURN 0 /* Only parse a few rows specified by ARG(2) */
        input = LINEIN( f_name )
        j = 0
        DO WHILE LENGTH( input ) > 0
            PARSE VALUE input WITH i_val(delimiter)input
            j = j + 1
            IF csv.0 = 0 THEN /* Build "header", use the names on the first row specifying the column names */
            DO
                IF VALUE( integer_style ) <> 'INTEGER_STYLE' THEN
                DO
                   csv.j = j
                   c_val = csv.j
                END
                ELSE DO
                    csv.j = TRANSLATE( STRIP( STRIP( i_val,, quotation_mark ) ) )
                    c_val = csv.j
               END
            END
            ELSE /* build the rows, use the names found on the first rows */
            DO
                c_val = TRANSLATE( csv.j )
                CALL VALUE 'csv.'c_val'.'i, STRIP( i_val,, quotation_mark )
            END
            CALL VALUE 'csv.'c_val'.0', i
        END
        IF csv.0 = 0 THEN
            csv.0 = j
        i = i + 1
    END
    CALL STREAM f_name, 'C', 'CLOSE'
RETURN

Example how the crc32.csv-file look like (with the addition of filesize not posted here in the forum yet)
"COMPUTER","DRIVE","PATH","NAME","CRC32","MODIFIED","FILESIZE"
"COMPUTERNAME","C:","\PROGRAMS\DSSAVER\Modules\PrClock\Digi\","38.png","007FB5DF","2006-01-12 13:31:30","282"
"COMPUTERNAME","D:","\CRC32TEST\PROGRAMS\DSSAVER\Modules\PrClock\Digi\","38.png","007FB5DF","2006-01-12 13:31:30","282"

11
Rexx / Finding the border
« on: 2010.01.14, 16:45:56 »
Marked as:Home work
(knowledge about Algorithms help)
Hi,

this time I need your help to solve a little problem I've stumbled upon.

I've got an image (represented here by ascii art) made of different characters. I've written some code to find the points (coordinates) that can be used to create borders around different colored areas of an image.

Each area/color is represented by a character and should be treated as an "island".

Question for you to help me with: How do I find out how to connect each point to a border for every "island"?

The code doesn't create ▓ for every point, only "essential corners" as the code scan the image horizontally.
I wouldn't mind if you can eliminate redundant points ▓ that appear vertically, but note that a border may contain shapes that need both an entry and an exit point* (see image further down).

Prerequisite:
  • Image what contain differently colored areas, but with some "islands" in the same color
  • copy the example below or convert some image to ascii art (80 pixels wide) and save it on your computer as borders.ascii

You'll have to replace the character that represent the variable "blank" with the character that contain/represent the areas in the ascii image to scan. You should also replace the variable "border" with some character that isn't present within the image elsewhere.

Code: [Select]
/* Code to find areas and create a border */

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

f_name = 'borders.ascii'
blank = '+'
border = '▓'
row = 0
counter = 0
DO WHILE LINES( f_name ) > 0
    row = row + 1
    data.row = LINEIN( f_name )
END
cls
data.0 = row
d_len = LENGTH( data.row )
fillen = LENGTH( data.0 )
filler = COPIES( '0', fillen )
DO row = 1 TO data.0
    chr = '-'
    DO col = 1 TO d_len + 1
        curr = SUBSTR( data.row, col, 1 )
        IF curr <> chr THEN
        DO
            IF curr = blank | chr = blank THEN
            DO
                edge = col - ( chr = blank )
                counter = counter + 1
                stem.counter = RIGHT( filler||row, fillen )||':'||RIGHT( filler||edge, fillen )||':'||( chr = blank )
                DO adjacent = row - ( row > 1 ) TO row + ( 1 < data.0 ) BY 1 + ( 1 < data.0 )
                    IF SUBSTR( data.adjacent, edge, 1 ) = blank THEN
                    DO
                        counter = counter + 1
                        stem.counter = RIGHT( filler||adjacent, fillen )||':'||RIGHT( filler||edge, fillen )||':'||( chr = blank )
                    END
                END
            END
        END
        chr = curr
    END
END
stem.0 = counter
DO counter = 1 TO stem.0
    PARSE VALUE stem.counter WITH row':'col':'
    row = FORMAT( row )
    col = FORMAT( col )
    data.row = OVERLAY( border, data.row, col )
END
DO row = 1 TO data.0
    SAY data.row
END    
IF SysStemSort( 'stem.' ) = 0 THEN
DO row = 1 TO stem.0
    SAY stem.row
END

How do I connect the pointes represented by ▓ for each closed area?
The result will look similar to:

▓+++▓▓█▓▓+++▓██████▓+++▓
▓++▓▓█▓█▓▓++▓█▓▓+▓█▓+++▓
▓+▓▓█▓▓▓█▓▓+▓▓█▓+▓█▓+++▓
▓▓▓█▓▓+▓▓█▓+▓▓█▓+▓█▓+++▓
▓▓█▓▓+▓▓█▓▓▓▓█▓▓+▓█▓███▓
▓█▓▓+▓▓█▓▓+▓█▓▓++▓█▓█▓█▓
█▓▓++▓█▓████▓▓+++▓█▓█▓█▓
▓▓+++▓█▓▓+▓▓█▓+++▓▓█▓▓█▓
▓++++▓▓█▓▓▓█▓▓++++▓+▓▓█▓
▓+++++▓█▓▓█▓▓++++++++▓+▓
▓+++++▓▓██▓▓+++++++++++▓
▓++++++▓++▓++++++++++++▓

from
++++++█++++++██████+++++
+++++█+█+++++█++++█+++++
++++█+++█+++++█+++█+++++
+++█+++++█++++█+++█+++++
++█+++++█++++█++++█+███+
+█+++++█++++█+++++█+█+█+
█+++++█+████++++++█+█+█+
++++++█+++++█++++++█++█+
+++++++█+++█++++++++++█+
+++++++█++█+++++++++++++
++++++++██++++++++++++++
++++++++++++++++++++++++


*Example of Entry->Exit point:

▓+▓█▓▓+▓
▓+▓▓█▓+▓
▓▓▓█▓▓+▓
▓▓█▓▓++▓
▓▓+▓+++▓

I need one or more stems that contain coordinates grouped and ordered so that they form closed shapes similar to the example below. The provided code create all the "gray squares", while your code has to group and connect them. Opposite direction is also ok.


//Jan-Erik

12
Multimedia / Software to create animation (video clip)
« on: 2010.01.09, 10:55:58 »
Hi,

I'd like to create a movie clip from 120 images... any suggestions on software that may be useful?

//Jan-Erik

13
Rexx / Remove multiple occurances from a log file
« on: 2010.01.08, 14:06:58 »
Marked as: Easy
Hi,

This script display the output from the log it read through StdErr and not the usual StdOut, so you can redirect the output to another file if you like.  ;D

Purpose (script):
Remove duplicate entries and display only one to the user. Output data as it appear in the log file.

Prerequisite:
A file that contain a lot of different information repeated over several times at various locations within the file. Each section has to begin with the text "ERROR:" or "WARNING:" (without the quotes).

Purpose (for you to learn about):
Difference between StdErr and StdOut and how to redirect output.
See Rexx Tips & Tricks for more information.

Usage (redirect errors to new log file named cleaned.log):
read_log my_log_with_duplicates.log 2 > cleaned.log

Output (screen):
Reading file: my_log_with_duplicates.log
File my_log_with_duplicates.log has been read

Output (log file "cleaned.log"):
Contents of the log file cleaned to only contain one occurrence of each log entry (See further sown for example).
Usage (all output to screen):
read_log my_log_with_duplicates.log

Code: [Select]
/* Short test script for the function below (read_log.cmd) */
Say 'Reading file:' ARG(1)
retval = parse_log( ARG(1) )
SAY 'File 'ARG(1)' has been read'
Return retval

parse_log: PROCEDURE
    IF ARG(2) <> '' THEN
        counter = counter + 1
    ELSE counter = 0
    IF STREAM( ARG(1), 'C', 'QUERY EXISTS' ) = '' THEN
        Return 4
    ELSE IF \STREAM( ARG(1), 'C', 'READABLE' ) THEN
    DO
         /* Log file could not be read */
        CALL SysSleep 1
         /* try for 5 minutes (expressed in seconds) */
        IF counter < 60 * 5 THEN
            CALL parse_log ARG(1), 1
        ELSE
            Return 5
    END
    f_size = STREAM( ARG(1), 'C', 'QUERY SIZE' )
    IF f_size > 0 THEN DO
        f_input = CHARIN( ARG(1), 1, f_size )
        CALL STREAM ARG(1), 'C', 'CLOSE'
        isProblem = 0
        delim.1 = 'ERROR:'
        delim.2 = 'WARNING:'
        delim.0 = 2
        DO i = 1 TO delim.0
            isDelim = POS( delim.i, f_input )
            isProblem = ( isProblem | ( isDelim > 0 ) )
            DO WHILE isDelim > 0
                INTERPRET 'PARSE VALUE f_input WITH "'||delim.i||'"pre"'||delim.i'"post'
                IF LENGTH( post ) > 0 THEN f_input = delim.i||post
                IF LENGTH( STRIP( pre ) ) > 0 THEN
                DO
                    pre = delim.i||pre
                    CALL LINEOUT 'STDERR', STRIP( pre )
                    count = COUNTSTR( pre, f_input )
                    DO count
                        f_input = DELSTR( f_input, POS( pre, f_input ), LENGTH( pre ) )
                    END
                END
                isDelim = POS( delim.i, f_input )
            END
        END
    END
Return isProblem

//Jan-Erik

Example file:
WARNING:
Please check the power cable

ERROR:
This is an error cause by a faulty drive...

ERROR:
This is an error cause by a faulty drive...

WARNING:
Please check the power cable

ERROR:
This is an error cause by a faulty drive...

ERROR:
This is an error cause by a faulty drive...

WARNING:
Please check the power cable

WARNING:
Please check the power cable


Output:
ERROR:
This is an error cause by a faulty drive...
WARNING:
Please check the power cable



14
Rexx / Duplicate files on your computer?
« on: 2009.12.31, 12:57:58 »
Maked as: Large
Hello,

here' s a rexx script for you all that you can use to determine if you've got duplicate files on your computer.

The script searches through your whole computer and calculate the CRC32 value and mark each files Extended Attribute (EA) with the crc32 value and the date it was last modified.

It also store information about each file if you set up a database with e.g. UnixODBC Database Administrator, type of database shouldn't matter just as long as it work and have a basic structure described further down. If you have a database present, the code will try to extract information about the files that have the same CRC32-value (files that contain the same data).

Prerequisite:
rxCRC32 extend rexx to support calculation of CRC32-values.
rxODBC (see attached file if you log on) extend rexx to support ODBC connections similar to rexxSQL that is included with UnixODBC.

Restrictions:
rxODBC support multithreaded calls so that the code can do other things while the database server process a SQL command to retrieve information, while UnixODBC doesn't seem to support multithreaded calls. You can't therefore set the last parameter in rxSQLCommand, rxSQLFetch to -2, -3, ... etc. as rxODBC then can't call UnixODBC as it barf. The script has therefore been designed to do everything in sequence, just as it would have worked with rexxSQL.

It's not possible to calculate values for large files (>2Gb) since rexx can't handle it. The code can be rewritten easily though if a solution should appear that require modification.

Parameter:
Drive to start to search through. You can therefore type X: to let it skip the first ones.

Info:
The output format of the file is CSV, with the database column names on the first row and data on row 2 and beyond, that look like.
"COMPUTER","DRIVE","PATH","NAME","CRC32","MODIFIED"
"....computer name...","...drive...","...path...","...file name...","...crc32...","...last modified..."

The code has been tested on 2 computers on my home network with the database engine PostgreSQL 8.0i by Lorne Sunley.

ODBC setup
1) Ensure that the connection has been labled "FileSystem" (without the quotes) in the column "DSN Name" where you add the connection (User DSN, System DSN or...)
2) No password may restrict access, you'll have to provide one in the connection settings if necessary (doesn't apply to text, dbf and SQLite databases as they don't rely on a database engine)

Database structure
Table name: file
Column names: computer, drive, path, name, crc32, modified
All columns set to type text (except the last that can have date time stamp set).

Code: [Select]
/* Set EA of file with information about CRC32-value */
/* File name: rxcrc32.cmd */
/* Parameters: drive */
/* Example: rxcrc32 E: */

database = 'FileSystem'

IF LENGTH( ARG(1) ) = 2 THEN
    start_drive = ARG(1)
ELSE start_drive = 'C:'

c_name = VALUE( 'HOSTNAME',, 'OS2ENVIRONMENT' )
IF LENGTH( c_name ) = 0 THEN DO
    c_name = VALUE( 'USER',, 'OS2ENVIRONMENT' )
    IF LENGTH( c_name ) = 0 THEN
        c_name = 'UNKNOWN'
END
out_file = database||'_'||c_name||'.csv'

start_time = TIME( 'S' )

CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
CALL SysLoadFuncs

CALL RxFuncAdd 'rxSQLLoadFuncs', 'rxODBC', 'rxSQLLoadFuncs'
CALL rxSQLLoadFuncs

/* Load External RxCRC32 Routines: */
CALL RxFuncAdd "RxCRC32Ver",    "RXCRC32", "RXCRC32VER"
CALL RxFuncAdd "RxCRC32Init",   "RXCRC32", "RXCRC32INIT"
CALL RxFuncAdd "RxCRC32Done",   "RXCRC32", "RXCRC32DONE"
CALL RxFuncAdd "RxCRC32Update", "RXCRC32", "RXCRC32UPDATE"

DO i = 1 TO 2
    CALL rxOut i, ''
END
DO i = 3 TO 5
    CALL rxProgress i, 0
END

CALL SysCls
db_writes = 0
CALL SysSleep 1
drives = SysDriveMap( start_drive, 'LOCAL' )
DO i = 1 TO WORDS( drives )
    CALL SysCls
    CALL rxOut 1, "Searching for files on drive" SUBWORD( drives, i, 1 )
    CALL rxProgress 5, i / WORDS( drives )
    CALL rxProgress 4, 0
    /* Find all files in subdirectories on drive */
    CALL SysFileTree SUBWORD( drives, i, 1 )||'\*.*', 'file', 'SFO'
    /* Connect to database with the name FileSystem */
    db_support = rxSQLConnect( 'DUPLICATES', 'DSN='||database )
    DO j = 1 TO file.0
        retval = SysGetEA( file.j, 'LASTWRITE', 'w_time' )
        f_time = SysGetFileDateTime( file.j, 'WRITE' )
        f_drive = FILESPEC( 'D', file.j )
        f_path = FILESPEC( 'P', file.j )
        f_name = FILESPEC( 'N', file.j )
        /* Check if the CRC32 value has been calculated before so we don't have to do it again */
        /* Also determined by the modification stamp we've set */
        IF retval = 0 THEN
            IF LENGTH( w_time ) > 0 THEN
                IF f_time = w_time THEN DO
                    retval = SysGetEA( file.j, 'CRC32', 'CRC' )
                    IF retval = 0 THEN
                        IF LENGTH( crc ) > 0 THEN DO
                            IF Add2DB() THEN
                                CALL rxOut 2, FORMAT( TIME( 'S' ) - start_time,, 0 )"s, CRC32:" crc "@" f_time "for" f_name
                            CALL rxProgress 4, j / file.0
                            /* Go to next file to shorten the processing time */
                            ITERATE j
                        END
                END

        crc = RxCRC32Init()

        /* Calculate CRC-32 of File: */
        BufferSize = 4096
        f_size = STREAM( file.j, 'C', 'QUERY SIZE' )
        IF f_size = 0 THEN ITERATE j
        c_size = 0
        o_time = TIME( 'S' )
        post_time = o_time
        pre_time = o_time

        IF STREAM( file.j, 'C', 'OPEN READ' ) = 'READY:' THEN
        DO UNTIL LENGTH( Buffer ) \= BufferSize /* Traverse File */
            Buffer = CHARIN( file.j,, BufferSize ) /* Fill Buffer (there may be a faster way :-) */
            c_size = c_size + LENGTH( Buffer )
            CALL rxProgress 3, c_size / f_size
            crc = RxCRC32Update( crc, Buffer ) /* Update CRC with Buffer */
            IF TIME( 'S' ) - o_time < pre_time THEN DO
                BufferSize = MIN( f_size, BufferSize + 1 )
                pre_time = TIME( 'S' ) - o_time
            END
            ELSE IF TIME( 'S' ) - o_time > post_time THEN DO
                BufferSize = MAX( f_size, BufferSize - 1 )
                post_time = TIME( 'S' ) - o_time
            END
            o_time = TIME( 'S' )
        END
        CALL STREAM file.j, 'C', 'CLOSE'
        CALL rxProgress 4, j / file.0

        /* Complete Calculation: */
        crc = RxCRC32Done( crc )
        CALL SysPutEA file.j, "CRC32", crc
        CALL SysPutEA file.j, "LASTWRITE", f_time

        /* Report the result: */
        IF Add2DB() THEN
            CALL rxOut 2, FORMAT( TIME( 'S' ) - start_time,, 0 )"s, CRC32:" crc "@" f_time "for" f_name

    END
    CALL rxSQLDisconnect 'DUPLICATES'
END
CALL SysCls
db_support = rxSQLConnect( 'DUPLICATES', 'DSN='||database )
CALL Export2CSV
CALL rxSQLDisconnect 'DUPLICATES'
CALL rxSQLDropFuncs
CALL SysDropFuncs
Return 0

/* display_on_row, text */
rxOut: PROCEDURE EXPOSE __last_write. __width
    row = ARG(1)
    IF \DATATYPE( row, 'W' ) THEN row = 0
    IF \DATATYPE( __last_write.row, 'N' ) THEN
        __last_write.row = TIME( 'S' )
    IF \DATATYPE( __width, 'W' ) THEN
        PARSE VALUE SysTextScreenSize() WITH . __width
    IF __last_write.row + 1 < TIME( 'S' ) THEN DO
        IF DATATYPE( row, 'W' ) THEN
            PARSE VALUE SysCurPos( row, 0 ) with prev_row prev_col
        SAY LEFT( ARG(2), __width )
        IF DATATYPE( row, 'W' ) THEN
            CALL SysCurPos prev_row, prev_col
        __last_write.row = TIME( 'S' )
    END
Return 0

/* display_on_row, percentage */
rxProgress: PROCEDURE EXPOSE __prev_progress. __last_write. __width
    row = ARG(1)
    IF \DATATYPE( __width, 'W' ) THEN
        PARSE VALUE SysTextScreenSize() WITH . __width
    IF DATATYPE( ARG(2), 'N' ) THEN
    DO
        progress = MIN( TRUNC( ( __width - 4 ) * ARG(2) ), ( __width - 4 ) )
        IF progress <> __prev_progress.row THEN DO
            CALL rxOut row, LEFT( COPIES( '█', progress )||COPIES( '░', ( __width - 4 ) - progress ), ( __width - 4 ) )||RIGHT( TRUNC( 100 * ARG(2) )||'%', 4 )
            __prev_progress.row = progress
        END
    END
Return 0

Add2DB:
    dup = 0
    sql_path = Insert_val( '\', f_path )
    sql_name = Insert_val( "'", f_name, "\" )
    IF db_support THEN DO
        IF rxSQLCommand( "DUPLICATES", "SELECT crc32 FROM file WHERE computer = '"||c_name||"' AND drive = '"||f_drive||"' AND path = '"||sql_path||"' AND name = '"||sql_name||"'" ) THEN DO
            IF DATATYPE( DUPLICATES.CRC32.0, 'W' ) THEN
            DO k = 1 TO DUPLICATES.crc32.0
                IF DUPLICATES.crc32.k = crc THEN dup = 1
            END
            IF dup <> 1 THEN
                RETURN rxSQLCommand( "DUPLICATES", "INSERT INTO file ( computer,drive,path,name,crc32,modified ) VALUES ( '"||c_name||"','"||f_drive||"','"||sql_path||"','"||sql_name||"','"||crc||"','"||f_time||"' )" )
            ELSE RETURN rxSQLCommand( "DUPLICATES", "UPDATE file SET crc32 = '"||crc||"', modified = '"||f_time||"' WHERE computer = '"||c_name||"' AND drive = '"||f_drive||"' AND path = '"||sql_path||"' AND name = '"||sql_name||"'" )
        END
        ELSE IF \rxSQLCommand( "DUPLICATES", "INSERT INTO file ( computer,drive,path,name,crc32,modified ) VALUES ( '"||c_name||"','"||f_drive||"','"||sql_path||"','"||sql_name||"','"||crc||"','"||f_time||"' )" ) THEN
            IF rxSQLInfo( 'M' ) = 1 THEN CALL rxOut 6, rxMessage( 'M' )
        ELSE RETURN 1
        IF rxSQLInfo( 'E' ) = 1 THEN CALL rxOut 7, rxMessage( 'E' )
        IF rxSQLInfo( 'S' ) = 1 THEN CALL rxOut 8, rxMessage( 'S' )
    END
    CALL rxSQLDisconnect
    db_support = rxSQLConnect( 'DUPLICATES', 'DSN='||database )
RETURN db_support

Insert_Val: PROCEDURE
    add_text = ARG(1)
    modify_text = ARG(2)
    IF LENGTH( ARG(3) ) > 0 THEN
        insert_text = ARG(3)
    ELSE insert_text = add_text
    from = POS( add_text, modify_text )
    DO WHILE from > 0
        modify_text = INSERT( insert_text, modify_text, from - 1 )
        from = POS( add_text, modify_text, from + LENGTH( insert_text ) + 1 )
    END
RETURN modify_text

Export2CSV:
    IF db_support THEN DO
        IF rxSQLCommand( "DUPLICATES", "ANALYZE file" ) THEN
            CALL rxOut 3, "Analysis done..."
        row_count = 0
        row_no = 1
        IF STREAM( out_file, 'C', 'OPEN' ) = 'READY:' THEN DO
            drives = SysDriveMap( , 'LOCAL' )
            CALL rxOut 2, 'Quering database for duplicate files... Please wait!'
            IF rxSQLCommand( "DUPLICATES", "SELECT file.computer AS computer, file.drive AS drive, file.path AS path, duplicate.name AS name, duplicate.crc32 AS crc32, file.modified AS modified FROM file, ( SELECT dup.crc32, dup.name FROM file AS dup WHERE dup.computer = '"||c_name||"' GROUP BY dup.crc32, dup.name HAVING ( COUNT( dup.crc32 ) > 1 ) ORDER BY dup.crc32 LIMIT 100 OFFSET 0 ) AS duplicate WHERE file.name = duplicate.name AND file.crc32 = duplicate.crc32 ORDER BY file.crc32" ) = 1 THEN
            DO WHILE row_no > 0
                row_count = row_count + 100
                CALL rxOut 1, row_no '(' row_count ')'
                CALL rxProgress 4, 100 / row_no
                IF Write2CSV( ( row_no = 1 ) ) THEN LEAVE
                IF rxSQLCommand( "DUPLICATES", "SELECT file.computer AS computer, file.drive AS drive, file.path AS path, duplicate.name AS name, duplicate.crc32 AS crc32, file.modified AS modified  FROM file, ( SELECT dup.crc32, dup.name FROM file AS dup WHERE dup.computer = '"||c_name||"' GROUP BY dup.crc32, dup.name HAVING ( COUNT( dup.crc32 ) > 1 ) ORDER BY dup.crc32 LIMIT 100 OFFSET "||row_count||" ) AS duplicate WHERE file.name = duplicate.name AND file.crc32 = duplicate.crc32 ORDER BY file.crc32" ) <> 1 THEN
                DO
                    IF rxSQLInfo( 'M' ) = 1 THEN CALL rxOut 6, rxMessage( 'M' )
                    IF rxSQLInfo( 'E' ) = 1 THEN CALL rxOut 7, rxMessage( 'E' )
                    IF rxSQLInfo( 'S' ) = 1 THEN CALL rxOut 8, rxMessage( 'S' )
                    LEAVE
                END
            END
            ELSE DO
                CALL rxOut 2, 'Quering database... Please wait!'
                IF rxSQLCommand( "DUP", "SELECT crc32, name FROM file WHERE computer = '"||c_name||"' GROUP BY crc32, name HAVING ( COUNT( crc32 ) > 1 ) ORDER BY crc32" ) = 1 THEN
                DO c = 1 TO DUP.crc32.0
                    CALL rxProgress 4, c / DUP.crc32.0
                    IF rxSQLCommand( "DUPLICATES", "SELECT DISTINCT * FROM file WHERE crc32 = '"||dup.crc32.c||"'" ) THEN
                    DO
                        IF Write2CSV( c = 1 ) THEN ITERATE d
                    END
                    ELSE DO
                        IF rxSQLInfo( 'M' ) = 1 THEN CALL rxOut 6, rxMessage( 'M' )
                        IF rxSQLInfo( 'E' ) = 1 THEN CALL rxOut 7, rxMessage( 'E' )
                        IF rxSQLInfo( 'S' ) = 1 THEN CALL rxOut 8, rxMessage( 'S' )
                    END
                END
                ELSE DO
                    CALL LINEOUT 'STDERR', 'No data could be retrived, try manually instead!'
                    IF rxSQLInfo( 'M' ) = 1 THEN CALL rxOut 6, rxMessage( 'M' )
                    IF rxSQLInfo( 'E' ) = 1 THEN CALL rxOut 7, rxMessage( 'E' )
                    IF rxSQLInfo( 'S' ) = 1 THEN CALL rxOut 8, rxMessage( 'S' )
                END
            END
        END
        CALL STREAM out_file, 'C', 'CLOSE'
    END
RETURN 0

Write2CSV:
    CALL rxOut 2, 'Writing duplicate entries to' out_file
    col_no = DUPLICATES.0
    col_name = DUPLICATES.1
    row_no = VALUE( 'DUPLICATES.'col_name'.0' )
    IF ARG(1) = 1 & row_no > 1 THEN DO
        col_val = ''
        DO col_num = 1 TO DUPLICATES.0
            col_val = col_val||'"'||VALUE( 'DUPLICATES.'col_num )||'",'
        END
        CALL LINEOUT out_file, STRIP( col_val, 'T', ',' )
    END
    IF DATATYPE( row_no, 'W' ) THEN
    DO
        IF row_no > 1 THEN
        DO row_num = 1 TO row_no
            CALL rxProgress 3, row_num / row_no
            row_val = ''
            DO col_num = 1 TO DUPLICATES.0
                col_name = DUPLICATES.col_num
                row_val = row_val||'"'||STRIP( VALUE( 'DUPLICATES.'col_name'.'row_num ) )||'",'
                END
            CALL LINEOUT out_file, STRIP( row_val, 'T', ',' )
        END
        ELSE RETURN 1
    END
    ELSE CALL rxOut 6, 'No data saved:' row_no
    DROP DUPLICATES.
RETURN 0

I wish you all a
Happy New Year

//Jan-Erik

15
Rexx / Search several files for text
« on: 2009.10.22, 16:58:39 »
Marked as: Normal
Hi all,

This time I've created a script to search files for text. First you type the name of the script and then what to search for e.g.
"myfindstr *.txt" and it's ask you for the text to find there, e.g. "computer".
When it has listed files, it will ask you to enter yet another criteria to limit the search futher e.g. "message", and it'll look for that and only display text with that combination present.

The code contain alot of the functions I've used elsewhere and may therefore appear to contain alot of extra "weight", of some that you may find is not needed. It's very convenient to create functions that one can reuse

Code: [Select]
/**/
@Echo Off
@cls
say ''
call Trace 'O'

cfg.debug = 0
cfg.curr_time = TIME( 'R' )

If RxLoadLib( 'SysStemSort', 'SysLoadFuncs', 'RexxUtil' ) Then
    Exit 1

call RxOut 0, 'Search for:'
call SysCurPos 0, 11
PARSE PULL instring

call SysFileTree ARG(1), 'file.', 'SFO' /* Remove/Rewrite to not contain S (in SFO) to only search 1 folder. */
DO i = 1 TO file.0
    rc = SysFileSearch( instring, file.i, 'outstring.i.', 'n' )
    call rxMeter 3, i / file.0, 1
    call rxWorking 5, outstring.i.0||' occurances of "'||instring||'" in '||file.i
END
call RxOut 1, 'Search in results for:'
call SysCurPos 1, 24
PARSE PULL instring

call SysCurPos 6, 0
DO i = 1 TO file.0
    if rc = 0 & outstring.i.0 > 0 then
    do
        contains = 0
        do j = 1 to outstring.i.0
            if POS( translate( instring ), translate( outstring.i.j ) ) > 0 | instring = '' then do
                if contains = 0 THEN
                do
                    say FILESPEC( 'N', file.i )||' contain: '
                    contains = 1
                end
                say outstring.i.j
                say ''
            END
        end
    end
END
Return 0

RxLoadLib: Procedure Expose !REXXDW. cfg.
    If RxFuncQuery( ARG(1) ) \= 0 Then
        If RxFuncAdd( ARG(2), ARG(3), ARG(2) ) \= 0 Then
            Return 1
    interpret 'If '||ARG(2)||'() \= 0 Then Return 1'
Return 0
   
rxWorking: Procedure Expose cfg.
    if cfg.debug | TRACE() = '?I' THEN Return 0
    if cfg.curr_time + 1 < TIME( 'S' ) then do
        SELECT
            WHEN cfg.counter = 1 THEN
                call rxOut ARG(1), left( '/ '||ARG(2), 80 )
            WHEN cfg.counter = 2  THEN
                call rxOut ARG(1), left( 'Ä '||ARG(2), 80 )
            WHEN cfg.counter = 3 THEN
                call rxOut ARG(1), left( '\ '||ARG(2), 80 )
            OTHERWISE
            cfg.counter = 0
            call rxOut ARG(1), left( '³ '||ARG(2), 80 )
        END
        cfg.counter = cfg.counter + 1
        cfg.ok = 1
        cfg.curr_time = TIME( 'S' )
    end
Return 0
   
rxMeter: Procedure Expose cfg.
    if cfg.debug | TRACE() = '?I' THEN Return 0
    temp = 100 * ARG(2)
    if length( format( temp,, 0, 0 ) ) > 3 then
        Return 0
    temp = format( temp, 3, 0, 0 )
    if cfg.progress <> temp | cfg.ok = 1 then do
        processed = FORMAT( min( 76 * ARG(2), 76 ),, 0, 0 )
        if datatype( ARG(3), 'N' ) then do
            loaded = FORMAT( min( 76 * ARG(3), 76 ),, 0, 0 )
            if temp > ARG(3) * 100 then
                temp = format( 100 * ARG(3), 3, 0, 0 )
        end
        else loaded = 0
        total = copies( '░', 76 - max( loaded, processed ) )
        if processed > loaded then do
            len = loaded
            loaded = copies( '▒', max( processed - loaded, 0 ) )
            processed = copies( '█', max( len, 0 ) )
        end
        else do
            loaded = copies( '▒', max( loaded - processed, 0 ) )
            processed = copies( '█', processed )
        end
        call rxOut ARG(1), left( processed||loaded||total, 76 )||right( min( temp, 100 ), 3 )||'%'
        cfg.progress = temp
        cfg.ok = 0
    end
Return 0

rxTimeOut: Procedure Expose cfg.
    if cfg.ok = 1 then
        call RxOut ARG(1), ARG(2)
Return 0
   
rxOut: procedure
    if datatype( ARG(1), 'W' ) then
        parse value SysCurPos( ARG(1), 0 ) with prev_row prev_col
    say left( ARG(2), max( 80, min( length( ARG(2) ), 80 ) ) )
    if datatype( ARG(1), 'W' ) then
        call SysCurPos prev_row, prev_col
Return 0

//Jan-Erik

Pages: [1] 2 3 ... 5