Re: Web apps on the AS/400 (where's the Java?)

["Leif Svalgaard" <leif@xxxxxxxx>]

See below

From: <Ken.Slaugh@cm-inc.com>
> Yes, Leif. For what started out as Nina's 'food fight' has actually been a
> good set of posts.
>
> I've been happy to see and consider all the code, concepts and information
> so far. I am hoping however, this thread continues until someone shows all
> of us a better 'hook' into existing RPG programs.
>
> But, before someone can create a Java hook... maybe MI code can show a more
> practical side then just changing test_some_string to
> test_some_other-string. How about a new situation, one that MI would be
> great at. Can you follow this enough to code it or discuss it?
>
> d Field_ID        s             15 varying
> d Field_Values    s          32000 varying    (a User space? or Pointer?
> Discuss.)
> d Field_Value     s          32000 varying    (a User space? or Pointer?
> Discuss.)
> d $Delim          c                   const('=')
> d $Tab            c                   const(x'05')
>
> Field_ID, Field_Values are to be assigned and initialized by an RPG
> program. This solution is, to calculate the value of Field_Value. Field_ID
> will not contain a $Delim and is not case sensitive. This solution may not
> change the contents of either Field_ID or Field_Values.
>
> Here's the simplest example of what Field_Values may look like...
> Field_Values = 'Field1=' + 'value1' + $Tab + 'Field2=' + $Tab + 'Field3=' +
> 'Value3'
>
> Simply find the Field_ID within the Field_Values and return Field_Value.
> Field_Value may be zero length or Null.
>
> Field_ID values of "field1", "fIELD2" and "Field3" would result in a
> Field_Value of "value1", Null and "Value3" respectfully.
>
> It doesn't really matter how fast it can be coded and it will run fast
> enough. It will be faster or slower on someone's machine or in some other
> language. Speed is always an issue though and invoking the routine must be
> quick.
>
> BTW, I have RPG and a Visual Basic code for this solution (in case you're
> interested),

Here is an MI-version  (somewhat simplified as the variables
should have been parameters - but they are just hard-coded in this version):
Nothe that the MI-code that does it is only 10 instructions and
took only a few minutes to code.

DCL DD TAB    CHAR(1) INIT(";");
DCL DD DELIM  CHAR(1) INIT("=");
DCL DD FIELD  CHAR(15);
DCL DD VALUE  CHAR(256);
DCL DD VALUES CHAR(32000) INIT
   ("FIELD1=ABC1;FIELD2=abcded2;FIELD3=Xyz3;");

    CPYBLAP     FIELD, "Field2", " ";
    CALLI       GET-VALUE, *, .GET-VALUE;
    BRK "1";

    CPYBLAP     FIELD, "FieldX", " ";      /* NOT FOUND */
    CALLI       GET-VALUE, *, .GET-VALUE;
    BRK "2";

    RTX         *;

DCL DD WHERE  BIN(2);
DCL DD SIZE   BIN(2);
DCL DD END    BIN(2);
DCL DD ID   CHAR(16);

DCL DD UC-TABLE CHAR(256);
    DCL DD *(16) CHAR(16) DEF(UC-TABLE) POS(1) INIT
    (X'B3B3B3B3B3B3B3B3B3B3B3B3B3B3B3B3', /* 00-0F ALL CTRL-CHARS  */
     X'B3B3B3B3B3B3B3B3B3B3B3B3B3B3B3B3', /* 10-1F ARE TRANSLATED  */
     X'B3B3B3B3B3B3B3B3B3B3B3B3B3B3B3B3', /* 20-2F INTO FAT "."    */
     X'B3B3B3B3B3B3B3B3B3B3B3B3B3B3B3B3', /* 30-3F                 */
     X'4041C1C1C1C1C1C1C3D54A4B4C4D4E4F', /* 40-4F ACCENTS REMOVED */
     X'50C5C5C5C5C9C9C9C9E25A5B5C5D5E5F', /* 50-5F FROM ACCENTED   */
     X'6061C1C1C1C1C1C1C1D56A6B6C6D6E6F', /* 60-6F LETTERS...      */
     X'D6C5C5C5C5C9C9C9C9797A7B7C7D7E7F', /* 70-7F                 */
     X'D6C1C2C3C4C5C6C7C8C98A8BC4E8D78F', /* 80-8F lower case      */
     X'90D1D2D3D4D5D6D7D8D9C1D6C19DC19F', /* 90-9F letters =>      */
     X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF', /* A0-AF UPPER CASE      */
     X'C3B1B2B3B4B5B6B7B8B9BABBBCBDBEBF', /* B0-BF                 */
     X'C0C1C2C3C4C5C6C7C8C9CAD6D6D6D6D6', /* C0-CF                 */
     X'D0D1D2D3D4D5D6D7D8D9DAE4E4E4E4E8', /* D0-DF                 */
     X'E0E0E2E3E4E5E6E7E8E9EAD6D6D6D6D6', /* E0-EF                 */
     X'F0F1F2F3F4F5F6F7F8F9FAE4E4E4E440');/* F0-FF                 */

DCL INSPTR .GET-VALUE;
ENTRY       GET-VALUE INT;
    XLATEWT     ID, FIELD, UC-TABLE;       /* CONVERT TO UPPER CASE */
    TRIML       SIZE, ID(1:15), " ";       /* GET SIZE OF ID        */
    CMPNV(B)    SIZE, 0/EQ(NOT-FOUND);     /* HANDLE EMPTY ID       */
    ADDN(S)     SIZE, 1;                   /* POINT TO TOP OF ID    */
    CPYBLA      ID(SIZE:1), DELIM;         /* PLACE 'DELIM' THERE   */
    SCAN(B)     WHERE, VALUES, ID(1:SIZE)  /* FIND ID IN VALUES     */
                     / ZER(NOT-FOUND);     /*   HANDLE NOT FOUND    */
    ADDN(S)     WHERE, SIZE;               /* ADJUST TO AFTER ID    */
    SCAN(B)     END,   VALUES(WHERE:256), TAB
                     / ZER(NOT-FOUND);     /* FIND TAB              */
    SUBN(SB)    END, 1/NPOS(NOT-FOUND);    /* DON'T COPY 'TAB'      */
    CPYBLAP     VALUE, VALUES(WHERE:END), " ";   /* GET RESULT      */
    B          .GET-VALUE;

NOT-FOUND:
    CPYBREP     VALUE, " ";
    B          .GET-VALUE;




+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---