I was in need for a solution to convert a byte in Hex (x'00' to x'FF') to Binary and
place the result in an Array - and then 'flip' this array.


I asked Midrange.com and got three solutions to do this, and one of them (itoa/ltoa)
is in the code below.


The code are just a snippet and not the whole program.


     H DftActGrp(*No) ActGrp(*New)
     H BndDir('QC2LE') BndDir('SOCKTUT/SOCKUTIL')

      **********************************************************************
      * Prototypes                                                         *
      **********************************************************************
     D Ltoa            PR              *   ExtProc('__ltoa')
     D   nuInt                       10I 0 Value
     D   szRtnBuffer                   *   Value
     D   nRadix                      10I 0 Value

     D FlipInt         PR             8A
     D   Int                          8A   Value

      **********************************************************************
      * Data structures                                                    *
      **********************************************************************
     D BinAry          Ds
     D  Fnc0                           N   Overlay(BinAry:1)
     D  Fnc1                           N   Overlay(BinAry:*Next)
     D  Fnc2                           N   Overlay(BinAry:*Next)
     D  Fnc3                           N   Overlay(BinAry:*Next)
     D  Fnc4                           N   Overlay(BinAry:*Next)
     D  Fnc5                           N   Overlay(BinAry:*Next)
     D  Fnc6                           N   Overlay(BinAry:*Next)
     D  Fnc7                           N   Overlay(BinAry:*Next)

     D IntDs           Ds
     D  IntNum                        5I 0 Inz(0)
     D  IntChr                        1    Overlay(IntNum:2)
     D  IntChrOld                     1    Inz(*blank)

      **********************************************************************
      * Stand alone fields                                                 *
      **********************************************************************
     D len             S             10I 0
     D buf             S             64A
     D num2bin         S             32A

     c                   eval      *inlr = *on
      *--------------------------------------------------------------------*
      *                  TCP/IP sockets                                    *
      *--------------------------------------------------------------------*
     C                   Exsr      getIpAddr
     C                   Exsr      crtTcpSock
     c                   Exsr      crtSockAddr
     C                   Exsr      conBK9000
      *--------------------------------------------------------------------*
      *                  Send/receive data (loop)                          *
      *--------------------------------------------------------------------*
     C                   Dow       1 = 1
     c                   Exsr      sndDta
     c                   Exsr      rcvDta
      *--------------------------------------------------------------------*
      *                  Data received from BK9000 - Buf                   *
      *--------------------------------------------------------------------*

      * Byte 10 in the string 'Buf' contains a hex value, eg. x'80'
     c                   eval      IntChr      = %Subst(Buf : 10 : 1)

      * Testing if new received data has changed
     C                   If        IntChr     <> IntChrOld
     C                   Eval      IntChrOld   = IntChr

      * With the DS IntDs, IntNum = 128. num2bin will be 1000 0000
     c                   callp(e)  ltoa(IntNum : %addr(num2bin) : 2)

      * Len will be 8 (9 - 1)
     C                   eval      len         = %Len(%TrimR(num2bin)) -1


      * Reset BinAry to 0000 0000
     C                   Eval      BinAry      = *all'0'

      * BinAry will now be 1000 0000 (attn: itoa/ltoa does not left pad results
      * that have fewer than 8 binary digits. For example x'01' comes back as 1;
      * x'02' comes back as '10', etc.)
     C                   Eval      %Subst(BinAry:(%Len(BinAry)+1)-len)  =
     C                             %Subst(num2bin:1:len)

      * BinAry will change from 1000 0000 to 0000 0001
     C                   Eval      BinAry      = FlipInt(BinAry)
      *--------------------------------------------------------------------*
      * Changes in BK9000 registry input reg_0                             *
      *--------------------------------------------------------------------*
     c                   If        Fnc0
      * do something
     c                   Else
      * do something else
     c                   Endif

      * ... (reg_01 to reg_06)

      *--------------------------------------------------------------------*
      * Changes in BK9000 registry input reg_7                             *
      *--------------------------------------------------------------------*
     c                   If        Fnc7
      * do something
     c                   Else
      * do something else
     c                   Endif

      *--------------------------------------------------------------------*
      * End changes in registry                                            *
      *--------------------------------------------------------------------*
     c                   Endif
      *--------------------------------------------------------------------*
      * Sleep before new read                                              *
      *--------------------------------------------------------------------*
     C                   CallP     Sleep(0001)
     c                   Enddo
      **********************************************************************
      * Flip integers                                                      *
      **********************************************************************
     P FlipInt         B
     D FlipInt         PI             8A
     D   peInt                        8A   Value

     D                 Ds
     D   Int                          8A
     D   Bit1                         1A   Overlay(Int:1)
     D   Bit2                         1A   Overlay(Int:2)
     D   Bit3                         1A   Overlay(Int:3)
     D   Bit4                         1A   Overlay(Int:4)
     D   Bit5                         1A   Overlay(Int:5)
     D   Bit6                         1A   Overlay(Int:6)
     D   Bit7                         1A   Overlay(Int:7)
     D   Bit8                         1A   Overlay(Int:8)

     D  save           S              1A
      /free
            Int  = peInt;
            Save = Bit8 ;
            Bit8 = Bit1 ;
            Bit1 = Save ;
            Save = Bit7 ;
            Bit7 = Bit2 ;
            Bit2 = Save ;
            Save = Bit6 ;
            Bit6 = Bit3 ;
            Bit3 = Save ;
            Save = Bit5 ;
            Bit5 = Bit4 ;
            Bit4 = Save ;
            Return Int  ;
      /end-free
     P                 E

Thanks for the help, to....
   Scott Klement for his socket tutorial and the 'flipper'
   Bob Cozzi for the itoa/ltoa example
   Mel Rothman for his solution - and his timer-test
   Jonathan Mason for his solution.



By the way.... here's an example looping 256 times to create Hex and Binary values in
both Hi- and Lo-endian. Create a file with one field with a record length of 150.

     H DftActGrp(*No) ActGrp(*New)
     H BndDir('QC2LE')
     H TimFmt(*Iso.) DatFmt(*YMD.) DatEdit(*YMD.)
     H Option(*SrcStmt : *NoDebugIO : *NoShowCpy) Debug(*Yes)

     FED1900P1  O  a e           k disk    usropn

      **********************************************************************
      * Prototypes                                                         *
      **********************************************************************
     D Ltoa            PR              *   ExtProc('__ltoa')
     D   nuInt                       10I 0 Value
     D   szRtnBuffer                   *   Value
     D   nRadix                      10I 0 Value

     D FlipInt         PR             8A                                        Lo-endian
     D   LoInd                        8A   Value                                Hi-endian


      **********************************************************************
      * Data structures                                                    *
      **********************************************************************
     D BinAry          Ds
     D  Fnc0                          1N   Overlay(BinAry:1)
     D  Fnc1                          1N   Overlay(BinAry:*Next)
     D  Fnc2                          1N   Overlay(BinAry:*Next)
     D  Fnc3                          1N   Overlay(BinAry:*Next)
     D  Fnc4                          1N   Overlay(BinAry:*Next)
     D  Fnc5                          1N   Overlay(BinAry:*Next)
     D  Fnc6                          1N   Overlay(BinAry:*Next)
     D  Fnc7                          1N   Overlay(BinAry:*Next)

     D BinOld          Ds
     D  Old0                          1N   Overlay(BinOld:1)
     D  Old1                          1N   Overlay(BinOld:*Next)
     D  Old2                          1N   Overlay(BinOld:*Next)
     D  Old3                          1N   Overlay(BinOld:*Next)
     D  Old4                          1N   Overlay(BinOld:*Next)
     D  Old5                          1N   Overlay(BinOld:*Next)
     D  Old6                          1N   Overlay(BinOld:*Next)
     D  Old7                          1N   Overlay(BinOld:*Next)


     D IntDs           Ds                                                       Converting
     D  IntNum                        5I 0 Inz(0)                               Num
     D  IntChr                        1    Overlay(IntNum:2)                    Chr

      **********************************************************************
      * Stand alone fields                                                 *
      **********************************************************************
     D len             S             10I 0
     D buf             S             64A
     D buflen          S             10I 0
     D num2bin         S             32A
     D ix              S              5I 0
     D qLen            S              5P 0
     D LogMsg          S            150A

      **********************************************************************
      * Main routine.                                                      *
      **********************************************************************

     C                   Dow       Intnum < 256

     C                   Eval      BinAry      = *all'0'
     c                   callp(e)  ltoa(IntNum : %addr(num2bin) : 2)            num to bin
     C                   eval      len         = %Len(%TrimR(num2bin)) -1
     C                   Eval      %Subst(BinAry:(%Len(BinAry)+1)-len)  =
     C                             %Subst(num2bin:1:len)
     C                   Eval      BinOld      = FlipInt(BinAry)                Hi2Low Endian

     C                   Eval      LogMsg    = BinAry + ' ' + BinOld +
     c                                                  ' ' + Intchr
     C                   exsr      wrtrcd
     c                   Eval      Intnum    = Intnum + 1

     c                   Enddo

     c                   Eval      *InLr = *On
     c                   return

      **********************************************************************
      * Write transaction to the log file                                  *
      **********************************************************************
     C     WrtRcd        Begsr
     c                   eval      PlcDta   = %Trim(LogMsg)
     c                   If        Not %Open(ED1900P1)
     c                   Open      ED1900P1
     c                   Endif
     c                   write     ED1900R1
     C                   Endsr

      **********************************************************************
      *          P R O C E D U R E  I N T E R F A C E S                    *
      *--------------------------------------------------------------------*
      * Flip from High-endian to Low-endian.                               *
      **********************************************************************
     P FlipInt         B
     D FlipInt         PI             8A
     D   peInt                        8A   Value

     D                 Ds
     D   Int                          8A
     D   Bit1                         1A   Overlay(Int:1)
     D   Bit2                         1A   Overlay(Int:2)
     D   Bit3                         1A   Overlay(Int:3)
     D   Bit4                         1A   Overlay(Int:4)
     D   Bit5                         1A   Overlay(Int:5)
     D   Bit6                         1A   Overlay(Int:6)
     D   Bit7                         1A   Overlay(Int:7)
     D   Bit8                         1A   Overlay(Int:8)

     D  save           S              1A

      /free
            Int  = peInt;
            Save = Bit8 ;
            Bit8 = Bit1 ;
            Bit1 = Save ;
            Save = Bit7 ;
            Bit7 = Bit2 ;
            Bit2 = Save ;
            Save = Bit6 ;
            Bit6 = Bit3 ;
            Bit3 = Save ;
            Save = Bit5 ;
            Bit5 = Bit4 ;
            Bit4 = Save ;
            Return Int  ;
      /end-free

     P                 E

Running SQL commands from CL (or elsewhere) One of my guys just pointed this out to me, thought it might be of interest to the group... W/in QShell there's a db2 command. The command runs any sql statement you pass it. Since you can call QSH and pass it a command to run, you can effectively run SQL statements from w/in CL by executing a QSH cmd('db2 "sql command"') This is great when you want to do quick updates and inserts from w/in a CL. Thanks to Walden H Leverich III

Back

Display Subsystem Descriptions Q: I am looking for a way to print the subsystem description for each subsystem on the AS400. I have only found a way to do this one subsystem at a time. Is there an easier way? A: If you have PDM installed, the easiest way is to use WRKOBJPDM and select only *SBSD objects (in library QSYS, of course). Then create a "user option" with your choice of 2-character name that will do a DSPSBSD (&L/&N) OUTPUT(*PRINT). Then key that new user option on the first line, press F13 and press ENTER. Thanks to Dave Schnee

Back

Order PSP, Cum or Group PTF's Here's an example I wrote with a command and CL to order the c u m e, PSP, all group PTFs, or any combination thereof, and didn't want to get bothered repeatedly for that info. I just had the CL submit itself to batch. Here's the command: /* CPP=ORDPTFPKG */ CMD PROMPT('Order PSP, Cum, or Group PTFs') PARM KWD(QRYCUM) + TYPE(*CHAR) + LEN(1) + RSTD(*YES) + DFT(*NO) + SPCVAL((*YES Y) (*NO N)) + PROMPT('Query the latest cum PTF?') PARM KWD(GETPSP) + TYPE(*CHAR) + LEN(1) + RSTD(*YES) + DFT(*NO) + SPCVAL((*YES Y) (*NO N)) + PROMPT('Get the PSP information?') PARM KWD(GETCUM) + TYPE(*CHAR) + LEN(1) + RSTD(*YES) + DFT(*NO) + SPCVAL((*YES Y) (*NO N)) + PROMPT('Get the latest cum PTF?') PARM KWD(GETHIPER) + TYPE(*CHAR) + LEN(1) + RSTD(*YES) + DFT(*NO) + SPCVAL((*YES Y) (*NO N)) + PROMPT('Get the latest HIPER Group?') PARM KWD(GETDB2) + TYPE(*CHAR) + LEN(1) + RSTD(*YES) + DFT(*NO) + SPCVAL((*YES Y) (*NO N)) + PROMPT('Get the latest DB2 Group?') PARM KWD(GETBRS) + TYPE(*CHAR) + LEN(1) + RSTD(*YES) + DFT(*NO) + SPCVAL((*YES Y) (*NO N)) + PROMPT('Get the latest BRS Group?') PARM KWD(GETJVA) + TYPE(*CHAR) + LEN(1) + RSTD(*YES) + DFT(*NO) + SPCVAL((*YES Y) (*NO N)) + PROMPT('Get the latest JVA Group?') PARM KWD(GETHTTP) + TYPE(*CHAR) + LEN(1) + RSTD(*YES) + DFT(*NO) + SPCVAL((*YES Y) (*NO N)) + PROMPT('Get the latest HTTP Group?') PARM KWD(GETPFR) + TYPE(*CHAR) + LEN(1) + RSTD(*YES) + DFT(*NO) + SPCVAL((*YES Y) (*NO N)) + PROMPT('Get the latest PFR Group?') PARM KWD(GETTCP) + TYPE(*CHAR) + LEN(1) + RSTD(*YES) + DFT(*NO) + SPCVAL((*YES Y) (*NO N)) + PROMPT('Get recommended TCP/IP fixes?') Here's the CL: /* Order latest c u m e, PSP, or group PTFs */ PGM PARM(&QRYCUM &GETPSP &GETCUM &GETHIPER &GETDB2 &GETBRS + &GETJVA &GETHTTP &GETPFR &GETTCP) /* PARMS */ DCL VAR(&QRYCUM) + TYPE(*CHAR) + LEN(1)/* Inquire as to what is the latest cum PTF? */ DCL VAR(&GETPSP) + TYPE(*CHAR) + LEN(1)/* Get Preventative Service Planning (PSP) info? */ DCL VAR(&GETCUM) + TYPE(*CHAR) + LEN(1)/* Get latest cum PTF? */ DCL VAR(&GETHIPER) + TYPE(*CHAR) + LEN(1)/* Get latest HIPER group? */ DCL VAR(&GETDB2) + TYPE(*CHAR) + LEN(1)/* Get latest DB2 group? */ DCL VAR(&GETBRS) + TYPE(*CHAR) + LEN(1)/* Get latest BRS group? */ DCL VAR(&GETJVA) + TYPE(*CHAR) + LEN(1)/* Get latest JVA group? */ DCL VAR(&GETHTTP) + TYPE(*CHAR) + LEN(1)/* Get latest HTTP group? */ DCL VAR(&GETPFR) + TYPE(*CHAR) + LEN(1)/* Get latest PFR group? */ DCL VAR(&GETTCP) + TYPE(*CHAR) + LEN(1)/* Get latest recommended TCP/IP fixes? */ /* WORK VARIABLES */ DCL VAR(&QRYPFX) + TYPE(*CHAR) + LEN(4) + VALUE('SF97')/* Prefix for inquiring what is the latest + cum PTF */ DCL VAR(&PSPPFX) + TYPE(*CHAR) + LEN(4) + VALUE('SF98')/* Prefix for PSP info PTF */ DCL VAR(&VRMRAW) + TYPE(*CHAR) + LEN(9)/* As retrieved from data area */ DCL VAR(&VRMINF) + TYPE(*CHAR) + LEN(3)/* After stripping letters V, R, and M */ DCL VAR(&QRYPTF) + TYPE(*CHAR) + LEN(10)/* Latest query cum actual PTF number */ DCL VAR(&PSPPTF) + TYPE(*CHAR) + LEN(10)/* PSP actual PTF number */ DCL VAR(&ACTORDPTF) + TYPE(*CHAR) + LEN(10)/* Actual PTF currently ordering */ DCL VAR(&MSGDTA) + TYPE(*CHAR) + LEN(512)/* Message data */ DCL VAR(&TYPE1) + TYPE(*CHAR) + LEN(1) DCL VAR(&JOB) + TYPE(*CHAR) + LEN(10) DCL VAR(&SBMMSGQ) + TYPE(*CHAR) + LEN(10) DCL VAR(&SBMMSGQLIB) + TYPE(*CHAR) + LEN(10) /* GET JOB ATTRIBUTES */ RTVJOBA JOB(&JOB) + TYPE(&TYPE1) + SBMMSGQ(&SBMMSGQ) + SBMMSGQLIB(&SBMMSGQLIB) /* SET UP MESSAGE QUEUE NAME */ IF COND(&TYPE1 *EQ '1') + THEN(DO) CHGVAR VAR(&SBMMSGQ) + VALUE(&JOB) CHGVAR VAR(&SBMMSGQLIB) + VALUE('*LIBL') ENDDO /***********************/ /* INTERACTIVE PORTION */ /***********************/ IF COND(&TYPE1 *EQ '1') + THEN(DO) SBMJOB CMD(CALL PGM(ORDPTFPKG) PARM(&QRYCUM &GETPSP &GETCUM + &GETHIPER &GETDB2 &GETBRS &GETJVA &GETHTTP &GETPFR + &GETTCP)) + JOB(ORDPTFPKG) SNDPGMMSG MSGID(CPF9897) + MSGF(QCPFMSG) + MSGDTA('Requested PTF packages order has been + submitted.') RETURN ENDDO /*****************/ /* BATCH PORTION */ /*****************/ /* GET THE VERSION, RELEASE, AND MODIFICATION LEVEL */ RTVOBJD OBJ(QSYS/QCMD) + OBJTYPE(*PGM) + SYSLVL(&VRMRAW)/* Returned as VnnRnnMnn. (V02R03M01) */ CHGVAR VAR(&VRMINF) + VALUE(%SST(&VRMRAW 3 1) *CAT %SST(&VRMRAW 6 1) *CAT + %SST(&VRMRAW 9 1)) /* SET UP THE ACTUAL PTF NUMBERS */ CHGVAR VAR(&QRYPTF) + VALUE(&QRYPFX *TCAT &VRMINF) CHGVAR VAR(&PSPPTF) + VALUE(&PSPPFX *TCAT &VRMINF) /* QUERY LATEST C U M */ IF COND(&QRYCUM *EQ 'Y') + THEN(DO) CHGVAR &MSGDTA + VALUE('Querying the latest cumulative PTF,' *BCAT + &QRYPTF) CHGVAR VAR(&ACTORDPTF) + VALUE(&QRYPTF) CALLSUBR SUBR(ORDPTF) ENDDO /* PSP INFO C U M */ IF COND(&GETPSP *EQ 'Y') + THEN(DO) CHGVAR VAR(&MSGDTA) + VALUE('Ordering the latest Preventative Service Planning + (PSP) PTF,' *BCAT &PSPPTF) CHGVAR VAR(&ACTORDPTF) + VALUE(&PSPPTF) CALLSUBR SUBR(ORDPTF) ENDDO /* LATEST C U M */ IF COND(&GETCUM *EQ 'Y') + THEN(DO) CHGVAR VAR(&MSGDTA) + VALUE('Ordering the latest cumulative PTF') CHGVAR VAR(&ACTORDPTF) + VALUE('*CUMPKG') CALLSUBR SUBR(ORDPTF) ENDDO /* HIPER GROUP */ IF COND(&GETHIPER *EQ 'Y') + THEN(DO) CHGVAR VAR(&MSGDTA) + VALUE('Ordering the HIPER group') CHGVAR VAR(&ACTORDPTF) + VALUE('*HIPERGRP') CALLSUBR SUBR(ORDPTF) ENDDO /* DB2 GROUP */ IF COND(&GETDB2 *EQ 'Y') + THEN(DO) CHGVAR VAR(&MSGDTA) + VALUE('Ordering the DB2 group') CHGVAR VAR(&ACTORDPTF) + VALUE('*DB2GRP') CALLSUBR SUBR(ORDPTF) ENDDO /* BRS GROUP */ IF COND(&GETBRS *EQ 'Y') + THEN(DO) CHGVAR VAR(&MSGDTA) + VALUE('Ordering the BRS group') CHGVAR VAR(&ACTORDPTF) + VALUE('*BRSGRP') CALLSUBR SUBR(ORDPTF) ENDDO /* JAVA GROUP */ IF COND(&GETJVA *EQ 'Y') + THEN(DO) CHGVAR VAR(&MSGDTA) + VALUE('Ordering the JVA group') CHGVAR VAR(&ACTORDPTF) + VALUE('*JVAGRP') CALLSUBR SUBR(ORDPTF) ENDDO /* HTTP GROUP */ IF COND(&GETHTTP *EQ 'Y') + THEN(DO) CHGVAR VAR(&MSGDTA) + VALUE('Ordering the HTTP group') CHGVAR VAR(&ACTORDPTF) + VALUE('*HTTPGRP') CALLSUBR SUBR(ORDPTF) ENDDO /* PFR GROUP */ IF COND(&GETPFR *EQ 'Y') + THEN(DO) CHGVAR VAR(&MSGDTA) + VALUE('Ordering the PFR (performance) group') CHGVAR VAR(&ACTORDPTF) + VALUE('*PFRGRP') CALLSUBR SUBR(ORDPTF) ENDDO /* TCP/IP RECOMMENDED FIXES */ IF COND(&GETTCP *EQ 'Y') + THEN(DO) CHGVAR VAR(&MSGDTA) + VALUE('Ordering the recommended TCP/IP fixes') CHGVAR VAR(&ACTORDPTF) + VALUE('SF99315') CALLSUBR SUBR(ORDPTF) ENDDO /* Send a completion message */ SNDPGMMSG MSGID(CPF9897) + MSGF(QCPFMSG) + MSGDTA('All requested PTF groups/packages have been + ordered') + TOMSGQ(&SBMMSGQLIB/&SBMMSGQ) /*******************************/ /* Subroutine to order the PTF */ /*******************************/ SUBR SUBR(ORDPTF) SNDPGMMSG MSGID(CPF9897) + MSGF(QCPFMSG) + MSGDTA(&MSGDTA) + TOMSGQ(&SBMMSGQLIB/&SBMMSGQ QSYSOPR) SNDPTFORD PTFID((&ACTORDPTF)) + DELIVERY(*ANY) ENDSUBR ENDPGM Thanks to Jeff Crosby

Back

Get Installed Software Informations, ect. Q: How do I get our system version? A: CALL PGM(QSFWINV) (toggle F11 to see all informations including Keys) or for hardcopy CALL PGM(QSFWINV) PARM(*PRINT) This has the added advantage of showing your software keys and "P" group. Thanks to Bryan Dietz

Back

Commenting out blocks of code in FF There is a really easy way to do it in SEU: You can use the overlay function to overlay a line with another line. This is useful when one line contains a pattern of characters that you want to merge with characters on other lines. You use the overlay command in conjunction with the copy command. In the following example, the block form of the overlay command (OO) is used. This will cause the contents of line 1 to overlay the contents of lines 2 through 6. Please note that overlay characters are uppercase letter O, not the numeric digit 0 (zero). Also, in my example below, I entered a blank after the C and OO commands to make them more readable. *************** Beginning of data ************************** C 01.00 /* */ OO 2.00 111111111111111 0003.00 222222222222222 0004.00 333333333333333 0005.00 444444444444444 OO 6.00 555555555555555 ****************** End of data ***************************** The result below shows that lines 2 through 5 have been overlaid by the contents of line 1. *************** Beginning of data ************************** 0001.00 /* */ 0002.00 /* 111111111111111 */ 0003.00 /* 222222222222222 */ 0004.00 /* 333333333333333 */ 0005.00 /* 444444444444444 */ 0006.00 /* 555555555555555 */ ****************** End of data ***************************** Thanks to Karen Hodge

Back

Passing *INT2 to RPGLE As a refresher, if needed, and for the archives... *INT2 = 2 bytes = can hold from -32,768 to 32,767 (ie. 5 digits) = 5i 0 *INT4 = 4 bytes = can hold from -2,147,483,648 to 2,147,483,647 (ie. 10 digits) = 10i 0 I hate the syntax RPG uses, that's why I define a template in my STDTYPES copy source: d t_Int1 s 3i 0 based( TEMPLATE ) d t_Int2 s 5i 0 based( TEMPLATE ) d t_Int4 s 10i 0 based( TEMPLATE ) d t_Int8 s 20i 0 based( TEMPLATE ) d t_Uint1 s 3u 0 based( TEMPLATE ) d t_Uint2 s 5u 0 based( TEMPLATE ) d t_Uint4 s 10u 0 based( TEMPLATE ) d t_Uint8 s 20u 0 based( TEMPLATE ) Then whenever I need a 2-byte signed integer, I just: D Sides DS Qualified D Bread 8a D NumPcs like(t_Int2) D NumDrnks like(t_Int2) Thanks to Charles Wilt

Back

Check TCP/IP Interface Address Status with APIQtocRtvTCPA, QtocLstNetIfc Some time the system IPL STRTCP process slower than system startup program, so when I start socket program, I got some socket error TCP is not active or interface inactive and I browsed the QSYSOPR log list my socket program retry message before the Job nnnnnn/QTCP/QTCPIP started. I don't know why the IPL STRTCP process slower than the qstruppgm. The error is not often occurred. But I need more detail error message for the TCP/IP checking, Finally I write the CHKTCPIFC command to check the TCP/IP and Interface status with API QtocRtvTCPA, QtocLstNetIfc. File : QCLSRC Member: CHKTCPIFC Type : CLLE Usage : CRTBNDCL PGM(lib/CHKTCPIFC) SRCFILE(lib/QCLSRC) MBR(CHKTCPIFC) /* =============================================================== */ /* = Command ChkTcpIfc CPP = */ /* = ChkTcpIfc CLLE = */ /* = Paramater notes: = */ /* = NetIfc :Network interface address = */ /* = = */ /* = For V5R1 and later use = */ /* = = */ /* = Usage in CLP: = */ /* = ChkTcpIfc NETIFC( ip_address ) = */ /* = MONMSG CPF9898 => Possible error as following: = */ /* = 1. TCP/IP is not active. = */ /* = 2. Interface address is not active. = */ /* = 3. Interface address is not defined. = */ /* =============================================================== */ /* = Date : 2007/06/26 = */ /* = Author: Vengoal Chang = */ /* =============================================================== */ PGM (&NetIfc) DCL VAR(&NETIFC) TYPE(*CHAR) LEN(15) DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(140) DCL VAR(&APIERR) TYPE(*CHAR) LEN(8) + VALUE(X'0000000000000000') DCL VAR(&TCPAFORMAT) TYPE(*CHAR) LEN(8) + VALUE('TCPA0100') DCL VAR(&NIFCFORMAT) TYPE(*CHAR) LEN(8) + VALUE('NIFC0100') DCL VAR(&RCVVARLEN) TYPE(*CHAR) LEN(4) DCL VAR(&TCPSTKSTS) TYPE(*CHAR) LEN(4) DCL VAR(&TCPSTKSTSN) TYPE(*DEC) LEN(10) VALUE(0) DCL VAR(&USP_NAME) TYPE(*CHAR) LEN(10) DCL VAR(&USP_LIB) TYPE(*CHAR) LEN(10) DCL VAR(&USP_QUAL) TYPE(*CHAR) LEN(20) DCL VAR(&USP_TYPE) TYPE(*CHAR) LEN(10) DCL VAR(&USP_SIZE) TYPE(*CHAR) LEN(4) DCL VAR(&USP_FILL) TYPE(*CHAR) LEN(1) DCL VAR(&USP_AUT) TYPE(*CHAR) LEN(10) DCL VAR(&USP_TEXT) TYPE(*CHAR) LEN(50) DCL VAR(&STARTPOS) TYPE(*CHAR) LEN(4) DCL VAR(&DATALEN) TYPE(*CHAR) LEN(4) DCL VAR(&HEADER) TYPE(*CHAR) LEN(150) DCL VAR(&LST_OFFSET) TYPE(*DEC) LEN(5 0) DCL VAR(&LST_SIZE) TYPE(*DEC) LEN(5 0) DCL VAR(&LST_DATA) TYPE(*CHAR) LEN(4096) DCL VAR(&LST_NBR) TYPE(*DEC) LEN(5 0) DCL VAR(&LST_LEN) TYPE(*DEC) LEN(5 0) DCL VAR(&LST_LENBIN) TYPE(*CHAR) LEN(4) DCL VAR(&LST_POSBIN) TYPE(*CHAR) LEN(4) DCL VAR(&LST_COUNT) TYPE(*DEC) LEN(5) VALUE(0) DCL VAR(&EXC_COUNT) TYPE(*DEC) LEN(5) VALUE(0) DCL VAR(&INTNETADR) TYPE(*CHAR) LEN(15) DCL VAR(&NETWORKADR) TYPE(*CHAR) LEN(15) DCL VAR(&HOSTADR) TYPE(*CHAR) LEN(15) DCL VAR(&IFCSTSN) TYPE(*DEC) LEN(5) VALUE(0) DCL VAR(&IFCSTSC) TYPE(*CHAR) LEN(5) DCL VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00') DCL VAR(&idx ) TYPE(*dec ) LEN(5) VALUE(0) DCL VAR(&NETIFCDFN) TYPE(*CHAR) LEN(1) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(256) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&MSGTXT) TYPE(*CHAR) LEN(256) MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(ERROR)) chgvar %Bin(&RcvVarLen) 140 callprc 'QtocRtvTCPA' ( + &RcvVar + &RcvVarLen + &TCPAFormat + &ApiErr) ChgVar &TcpStkSts %SST(&RcvVar 9 4) ChgVar &TcpStkStsn %bin(&TcpStkSts) IF (&TCPStkStsn *EQ 0) DO SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('TCP/IP + status is not active.') MSGTYPE(*ESCAPE) ENDDO CHGVAR VAR(&USP_NAME) VALUE('CHKTCPIFC' ) CHGVAR VAR(&USP_LIB) VALUE('QTEMP') CHGVAR VAR(&USP_QUAL) VALUE(&USP_NAME *CAT + &USP_LIB) CHGVAR VAR(&USP_TYPE) VALUE('MYTYPE') CHGVAR VAR(%BIN(&USP_SIZE)) VALUE(65535) CHGVAR VAR(&USP_FILL) VALUE(' ') CHGVAR VAR(&USP_AUT) VALUE('*CHANGE') CHGVAR VAR(&USP_TEXT) VALUE('my user space') DLTUSRSPC USRSPC(&USP_LIB/&USP_NAME) MONMSG CPF0000 CALL PGM(QUSCRTUS) PARM(&USP_QUAL &USP_TYPE + &USP_SIZE &USP_FILL &USP_AUT &USP_TEXT) ChgVar &ApiErr X'0000000000000000' callprc 'QtocLstNetIfc' ( + &USP_QUAL + &NIFCFormat + &ApiErr) CHGVAR VAR(%BIN(&STARTPOS)) VALUE(1) CHGVAR VAR(%BIN(&DATALEN)) VALUE(140) CALL PGM(QUSRTVUS) PARM(&USP_QUAL &STARTPOS + &DATALEN &HEADER) CHGVAR VAR(&LST_OFFSET) VALUE(%BIN(&HEADER 125 4)) CHGVAR VAR(&LST_SIZE) VALUE(%BIN(&HEADER 129 4)) CHGVAR VAR(&LST_NBR) VALUE(%BIN(&HEADER 133 4)) CHGVAR VAR(&LST_LEN) VALUE(%BIN(&HEADER 137 4)) CHGVAR VAR(%BIN(&LST_POSBIN)) VALUE(&LST_OFFSET + 1) CHGVAR VAR(&LST_LENBIN) VALUE(%SST(&HEADER 137 4)) CHGVAR VAR(&LST_COUNT) VALUE(0) CHGVAR VAR(&EXC_COUNT) VALUE(0) LST_LOOP: IF COND(&LST_COUNT *EQ &LST_NBR) THEN(GOTO + CMDLBL(LST_END)) CALL PGM(QUSRTVUS) PARM(&USP_QUAL &LST_POSBIN + &LST_LENBIN &LST_DATA) CHGVAR VAR(&INTNETADR) VALUE(%SST(&LST_DATA 1 15)) /* CHGVAR VAR(&NETWORKADR) VALUE(%SST(&LST_DATA 21 15))*/ /* CHGVAR VAR(&HOSTADR ) VALUE(%SST(&LST_DATA 89 15))*/ CHGVAR VAR(&IFCSTSN) VALUE(%BIN(&LST_DATA 73 4)) CHGVAR VAR(&IFCSTSC) VALUE(&IFCSTSN) ChgVar &Idx 1 CVTNULLS: If (&Idx > 15) goto CVTNULLE If (%SST(&INTNETADR &Idx 1) *EQ &null) + ChgVar %SST(&INTNETADR &Idx 1) ' ' ChgVar &Idx (&Idx+1) goto CVTNULLS CVTNULLE: If (&NETIFC *EQ &INTNETADR) DO ChgVar &NETIFCDFN '1' If (&IFCSTSN *EQ 1) DO SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) + MSGDTA('Interface' *BCAT &NETIFC *BCAT + 'is active.') MSGTYPE(*INFO) CHGVAR VAR(&EXC_COUNT) VALUE(&EXC_COUNT + 1) GOTO LST_END ENDDO ENDDO CHGVAR VAR(&LST_COUNT) VALUE(&LST_COUNT + 1) CHGVAR VAR(%BIN(&LST_POSBIN)) + VALUE(%BIN(&LST_POSBIN) + &LST_LEN) GOTO CMDLBL(LST_LOOP) LST_END: IF (&EXC_COUNT *EQ 0) DO If (&NetIfcDfn *EQ '1') + SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + MSGDTA('Interface' *BCAT + &NETIFC *BCAT 'is not active') + MSGTYPE(*ESCAPE) Else + SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + MSGDTA('Interface' *BCAT + &NETIFC *BCAT 'is not defined') + MSGTYPE(*ESCAPE) ENDDO DLTUSRSPC USRSPC(&USP_LIB/&USP_NAME) Return /* =============================================================== */ /* = Error routine = */ /* =============================================================== */ Error: RcvMsg MsgType( *Excp ) + MsgDta( &MsgDta ) + MsgID( &MsgID ) + MsgF( &MsgF ) + MsgFLib( &MsgFLib ) MonMsg ( CPF0000 MCH0000 ) SndMsg: SndPgmMsg MsgID( &MsgID ) + MsgF( &MsgFLib/&MsgF ) + MsgDta( &MsgDta ) + MsgType( *Escape ) MonMsg ( CPF0000 MCH0000 ) /* =============================================================== */ /* = End of program = */ /* =============================================================== */ ENDPGM File : QCMDSRC Member: CHKTCPIFC Type : CMD /* =============================================================== */ /* = Command....... ChkTcpIfc = */ /* = CPP........... ChkTcpIfc = */ /* = Description... Check TCP/IP Interface Status = */ /* = = */ /* = CrtCmd Cmd( ChkTcpIfc ) = */ /* = Pgm( ChkTcpIfc ) = */ /* = SrcFile( YourSourceFile ) = */ /* = = */ /* = For V5R1 and later use = */ /* = = */ /* = Usage in CLP: = */ /* = ChkTcpIfc NETIFC( ip_address ) = */ /* = MONMSG CPF9898 => Possible error as following: = */ /* = 1. TCP/IP is not active. = */ /* = 2. Interface address is not active. = */ /* = 3. Interface address is not defined. = */ /* =============================================================== */ /* = Date : 2007/06/26 = */ /* = Author: Vengoal Chang = */ /* =============================================================== */ CMD PROMPT('Check TCP/IP Interface Status') PARM KWD(NETIFC) TYPE(*CHAR) LEN(15) MIN(1) + PROMPT('Network interface address') Testing program: for example: IP 192.16.15.27 is not defined on AS/400. IP 192.16.15.28 is on AS/400 and Active. You can use command CFGTCP select option 1 Work with TCP/IP interfaces to get detail interface information. PGM DCL VAR(&NETIFC) TYPE(*CHAR) LEN(15) CHGVAR VAR(&NETIFC) VALUE('192.16.15.27') CHKTCPIFC NETIFC(&NETIFC) MONMSG CPF9898 EXEC(DO) SNDPGMMSG MSG('Interface' *BCAT &NETIFC *BCAT 'is not + active or defined') ENDDO CHKTCPIFC NETIFC('192.16.15.28') ENDPGM Thanks to Vengoal Chang

Back

Check Active Job Sometime I need do some action to specified job , so I wrote a CHKACTJOB. Source as following: File : QCLSRC Member: CHKACTJOB Type : CLP Usage : CRTCLPGM CHKACTJOB /* =============================================================== */ /* = Command ChkJob CPP = */ /* = ChkJob CLP = */ /* = Paramater notes: = */ /* = Jobname : Jobname to check = */ /* = Jobuser : Jobuser to check = */ /* = SBS : Specified jobname running under which sbs = */ /* = Action : Change, End, Hold or Release job = */ /* = Job command option: only for Change or End job = */ /* = Other command : Other command for job = */ /* =============================================================== */ /* = Date : 2007/06/04 = */ /* = Author: Vengoal Chang = */ /* =============================================================== */ /* = Date : 2007/06/21 = */ /* = Author: Vengoal Chang = */ /* = Added on ACTION *MSG to send status message to user = */ /* =============================================================== */ /* = Date : 2007/08/08 = */ /* = Author: Vengoal Chang = */ /* = Added on JOBSTS keyword to limit job processing = */ /* =============================================================== */ /* = Date : 2007/08/14 = */ /* = Author: Vengoal Chang = */ /* = Added on ACTION *DSP to display job information = */ /* = DSPJOB OPTION(*ALL) OUTPUT(*PRINT) = */ /* = DSPJOB OPTION(*JOBLOG) OUTPUT(*PTINT) = */ /* =============================================================== */ CHKJOB: PGM PARM(&MYJOBNAME &JOBUSER &SBSDANDLIB &JOBSTS + &ACTION &JOBOPT &TOUSR &CMD) DCL VAR(&MYJOBNAME) TYPE(*CHAR) LEN(10) DCL VAR(&JOBUSER ) TYPE(*CHAR) LEN(10) DCL VAR(&SBSDANDLIB) TYPE(*CHAR) LEN(20) /* SBSD + AND LIBRARY */ DCL VAR(&SBSD) TYPE(*CHAR) LEN(10) /* SBS */ DCL VAR(&SBSDLIB) TYPE(*CHAR) LEN(10) DCL VAR(&RTNSBSDLIB) TYPE(*CHAR) LEN(10) DCL VAR(&JOBSTS) TYPE(*CHAR) LEN(5) DCL VAR(&ACTION) TYPE(*CHAR) LEN(5) DCL VAR(&JOBOPT) TYPE(*CHAR) LEN(3000) DCL VAR(&TOUSR ) TYPE(*CHAR) LEN(10) DCL VAR(&CMD ) TYPE(*CHAR) LEN(3000) DCL VAR(&CMDSTR) TYPE(*CHAR) LEN(3000) DCL VAR(&CMDLEN) TYPE(*DEC) LEN(15 5) DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(10) DCL VAR(&USER) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6) DCL VAR(&STATUS) TYPE(*CHAR) LEN(10) DCL VAR(&JOBTYPE) TYPE(*CHAR) LEN(1) DCL VAR(&SUBTYPE) TYPE(*CHAR) LEN(1) DCL VAR(&USP_NAME) TYPE(*CHAR) LEN(10) DCL VAR(&USP_LIB) TYPE(*CHAR) LEN(10) DCL VAR(&USP_QUAL) TYPE(*CHAR) LEN(20) DCL VAR(&USP_TYPE) TYPE(*CHAR) LEN(10) DCL VAR(&USP_SIZE) TYPE(*CHAR) LEN(4) DCL VAR(&USP_FILL) TYPE(*CHAR) LEN(1) DCL VAR(&USP_AUT) TYPE(*CHAR) LEN(10) DCL VAR(&USP_TEXT) TYPE(*CHAR) LEN(50) DCL VAR(&API_USQUAL) TYPE(*CHAR) LEN(20) DCL VAR(&API_JBQUAL) TYPE(*CHAR) LEN(26) DCL VAR(&API_JBNAM) TYPE(*CHAR) LEN(10) DCL VAR(&API_USER) TYPE(*CHAR) LEN(10) DCL VAR(&API_JOBNR) TYPE(*CHAR) LEN(6) DCL VAR(&API_STATUS) TYPE(*CHAR) LEN(10) DCL VAR(&STARTPOS) TYPE(*CHAR) LEN(4) DCL VAR(&DATALEN) TYPE(*CHAR) LEN(4) DCL VAR(&HEADER) TYPE(*CHAR) LEN(150) DCL VAR(&LST_OFFSET) TYPE(*DEC) LEN(5 0) DCL VAR(&LST_SIZE) TYPE(*DEC) LEN(5 0) DCL VAR(&LST_DATA) TYPE(*CHAR) LEN(4096) DCL VAR(&LST_NBR) TYPE(*DEC) LEN(5 0) DCL VAR(&LST_LEN) TYPE(*DEC) LEN(5 0) DCL VAR(&LST_LENBIN) TYPE(*CHAR) LEN(4) DCL VAR(&LST_POSBIN) TYPE(*CHAR) LEN(4) DCL VAR(&LST_COUNT) TYPE(*DEC) LEN(5) VALUE(0) DCL VAR(&EXC_COUNT) TYPE(*DEC) LEN(5) VALUE(0) DCL VAR(&TYPE) TYPE(*CHAR) LEN(1) VALUE('*') DCL VAR(&NBRTORTN) TYPE(*CHAR) LEN(4) DCL VAR(&KEYSTORTN) TYPE(*CHAR) LEN(8) DCL VAR(&KEY1 ) TYPE(*CHAR) LEN(4) DCL VAR(&KEY2 ) TYPE(*CHAR) LEN(4) DCL VAR(&SBSSYS ) TYPE(*CHAR) LEN(20) DCL VAR(&WRKSTS ) TYPE(*CHAR) LEN(4) DCL VAR(&JOBWRKSTS) TYPE(*CHAR) LEN(4) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(256) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&MSGTXT) TYPE(*CHAR) LEN(256) MONMSG MSGID(CPF0000 MCH0000) EXEC(GOTO CMDLBL(ERROR)) /*- DIVISION OF COMMAND PARAMETER ----------------------------------*/ CHGVAR VAR(&SBSD) VALUE(%SST(&SBSDANDLIB 1 10)) CHGVAR VAR(&SBSDLIB) VALUE(%SST(&SBSDANDLIB 11 10)) IF (&SBSD *NE '*ALL') DO CHKOBJ OBJ(&SBSDLIB/&SBSD) OBJTYPE(*SBSD) MONMSG MSGID(CPF9801) EXEC(DO) RCVMSG MSGQ(*PGMQ) RMV(*NO) /* MSG: SBSD IN LIBRARY NOT FOUND */ SNDPGMMSG MSGID(CPF9801) MSGF(QCPFMSG) + MSGDTA(&SBSDANDLIB) MSGTYPE(*ESCAPE) ENDDO RTVOBJD OBJ(&SBSDLIB/&SBSD) OBJTYPE(*SBSD) + RTNLIB(&RTNSBSDLIB) CHGVAR VAR(%SST(&SBSDANDLIB 11 10)) VALUE(&RTNSBSDLIB) ENDDO CHGVAR VAR(%BIN(&NBRTORTN)) VALUE(2) /* 0101 -- Ststus as WRKACTJOB */ CHGVAR VAR(%BIN(&KEY1 )) VALUE(0101) /* 1906 -- Subsystem */ CHGVAR VAR(%BIN(&KEY2 )) VALUE(1906) CHGVAR VAR(&KEYSTORTN) VALUE(&KEY1 *CAT &KEY2) CHGVAR VAR(&USP_NAME) VALUE('CHKJOBNAME') CHGVAR VAR(&USP_LIB) VALUE('QTEMP') CHGVAR VAR(&USP_QUAL) VALUE(&USP_NAME *CAT + &USP_LIB) CHGVAR VAR(&USP_TYPE) VALUE('MYTYPE') CHGVAR VAR(%BIN(&USP_SIZE)) VALUE(128000) CHGVAR VAR(&USP_FILL) VALUE(' ') CHGVAR VAR(&USP_AUT) VALUE('*USE') CHGVAR VAR(&USP_TEXT) VALUE('my user space') DLTUSRSPC USRSPC(&USP_LIB/&USP_NAME) MONMSG CPF0000 CALL PGM(QUSCRTUS) PARM(&USP_QUAL &USP_TYPE + &USP_SIZE &USP_FILL &USP_AUT &USP_TEXT) CHGVAR VAR(&API_USQUAL) VALUE(&USP_QUAL) CHGVAR VAR(&API_JBNAM) VALUE(&MYJOBNAME) /* CHGVAR VAR(&API_USER) VALUE('*ALL') */ CHGVAR VAR(&API_USER) VALUE(&JOBUSER) CHGVAR VAR(&API_JOBNR) VALUE('*ALL') CHGVAR VAR(&API_STATUS) VALUE('*ACTIVE') CHGVAR VAR(&API_JBQUAL) VALUE(&API_JBNAM *CAT + &API_USER *CAT &API_JOBNR) CALL PGM(QUSLJOB) PARM(&API_USQUAL 'JOBL0200' + &API_JBQUAL &API_STATUS X'00000000' + &TYPE &NBRTORTN &KEYSTORTN) CHGVAR VAR(%BIN(&STARTPOS)) VALUE(1) CHGVAR VAR(%BIN(&DATALEN)) VALUE(140) CALL PGM(QUSRTVUS) PARM(&API_USQUAL &STARTPOS + &DATALEN &HEADER) CHGVAR VAR(&LST_OFFSET) VALUE(%BIN(&HEADER 125 4)) CHGVAR VAR(&LST_SIZE) VALUE(%BIN(&HEADER 129 4)) CHGVAR VAR(&LST_NBR) VALUE(%BIN(&HEADER 133 4)) CHGVAR VAR(&LST_LEN) VALUE(%BIN(&HEADER 137 4)) CHGVAR VAR(%BIN(&LST_POSBIN)) VALUE(&LST_OFFSET + 1) CHGVAR VAR(&LST_LENBIN) VALUE(%SST(&HEADER 137 4)) CHGVAR VAR(&LST_COUNT) VALUE(0) CHGVAR VAR(&EXC_COUNT) VALUE(0) IF (&LST_NBR *EQ 0) DO IF (&JOBUSER *EQ '*ALL') DO SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Job' + *BCAT &MYJOBNAME *BCAT 'was not found!') + MSGTYPE(*ESCAPE) ENDDO ELSE DO ENDDO SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + MSGDTA('User' *BCAT &JOBUSER *BCAT + 'run job' *BCAT &MYJOBNAME *BCAT + 'was not found!') + MSGTYPE(*ESCAPE) ENDDO LST_LOOP: IF COND(&LST_COUNT *EQ &LST_NBR) THEN(GOTO + CMDLBL(LST_END)) CALL PGM(QUSRTVUS) PARM(&API_USQUAL &LST_POSBIN + &LST_LENBIN &LST_DATA) CHGVAR VAR(&JOBNAME) VALUE(%SST(&LST_DATA 1 10)) CHGVAR VAR(&USER) VALUE(%SST(&LST_DATA 11 10)) CHGVAR VAR(&JOBNBR) VALUE(%SST(&LST_DATA 21 6)) CHGVAR VAR(&STATUS) VALUE(%SST(&LST_DATA 43 10)) CHGVAR VAR(&JOBTYPE) VALUE(%SST(&LST_DATA 53 1)) CHGVAR VAR(&SUBTYPE) VALUE(%SST(&LST_DATA 54 1)) /* for status */ CHGVAR VAR(&WRKSTS ) VALUE(%SST(&LST_DATA 81 4)) /* for subsystem */ CHGVAR VAR(&SBSSYS ) VALUE(%SST(&LST_DATA 101 20)) IF COND(&MYJOBNAME *EQ '*ALL' *OR + &JOBNAME *EQ &MYJOBNAME) THEN(DO) IF ((&SBSD *EQ '*ALL') *OR + (&SBSDANDLIB *EQ &SBSSYS)) DO CHGVAR &JOBWRKSTS %SST(&JOBSTS 2 4) IF ((&JOBSTS *EQ '*ALL') *OR + (&JOBWRKSTS *EQ &WRKSTS)) DO IF (&ACTION *NE '*CMD') DO IF (&ACTION *EQ '*CHG') + CHGVAR &CMDSTR 'CHGJOB' IF (&ACTION *EQ '*END') + CHGVAR &CMDSTR 'ENDJOB' IF (&ACTION *EQ '*HLD') + CHGVAR &CMDSTR 'HLDJOB' IF (&ACTION *EQ '*RLS') + CHGVAR &CMDSTR 'RLSJOB' IF (&ACTION *EQ '*DSP') DO CHGVAR &CMDSTR 'DSPJOB' CHGVAR &JOBOPT 'OPTION(*ALL) OUTPUT(*PRINT)' ENDDO CHGVAR &CMDSTR (&CMDSTR *BCAT 'JOB(' *TCAT + &JOBNBR *TCAT '/' *CAT + &USER *TCAT '/' *CAT + &JOBNAME *TCAT ')' *BCAT &JOBOPT) ENDDO ELSE DO CHGVAR &CMDSTR &CMD ENDDO CHGVAR VAR(&EXC_COUNT) VALUE(&EXC_COUNT + 1) IF (&ACTION *EQ '*MSG') DO SNDPGMMSG MSG('Job' *BCAT + &JOBNBR *TCAT '/' *CAT + &USER *TCAT '/' *CAT + &JOBNAME *BCAT 'status is' *BCAT + &WRKSTS *TCAT '.') + TOUSR(&TOUSR) ENDDO ELSE DO CHGVAR VAR(&CMDLEN) VALUE(3000) CALL PGM(QCMDEXC) PARM(&CMDSTR &CMDLEN) MONMSG MSGID(CPF1346 CPF1349) IF (&ACTION *EQ '*DSP') DO CHGVAR &CMDSTR ('DSPJOB' *BCAT 'JOB(' *TCAT + &JOBNBR *TCAT '/' *CAT + &USER *TCAT '/' *CAT + &JOBNAME *TCAT ')' *BCAT + 'OPTION(*JOBLOG) OUTPUT(*PRINT)') CHGVAR VAR(&CMDLEN) VALUE(3000) CALL PGM(QCMDEXC) PARM(&CMDSTR &CMDLEN) MONMSG MSGID(CPF1346 CPF1349) ENDDO ENDDO ENDDO /* ENDDO JOBSTS */ ENDDO /* ENDDO SBSD */ ENDDO /* ENDDO JOBNAME */ CHGVAR VAR(&LST_COUNT) VALUE(&LST_COUNT + 1) CHGVAR VAR(%BIN(&LST_POSBIN)) + VALUE(%BIN(&LST_POSBIN) + &LST_LEN) GOTO CMDLBL(LST_LOOP) LST_END: IF (&EXC_COUNT *EQ 0) DO SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) + MSGDTA('User' *BCAT &JOBUSER *BCAT + 'run job' *BCAT &MYJOBNAME *BCAT + 'under subsystem' *BCAT + &RTNSBSDLIB *TCAT '/' *CAT &SBSD *BCAT + 'was not found!') + MSGTYPE(*ESCAPE) ENDDO DLTUSRSPC USRSPC(&USP_LIB/&USP_NAME) Return /* =============================================================== */ /* = Error routine = */ /* =============================================================== */ Error: RcvMsg MsgType( *Excp ) + MsgDta( &MsgDta ) + MsgID( &MsgID ) + MsgF( &MsgF ) + MsgFLib( &MsgFLib ) MonMsg ( CPF0000 MCH0000 ) SndMsg: SndPgmMsg MsgID( &MsgID ) + MsgF( &MsgFLib/&MsgF ) + MsgDta( &MsgDta ) + MsgType( *Escape ) MonMsg ( CPF0000 MCH0000 ) /* =============================================================== */ /* = End of program = */ /* =============================================================== */ ENDPGM File : QCMDSRC Member: CHKACTJOB Type : CMD Usage : CRTCMD CMD(lib/CHKACTJOB) PGM(lib/CHKACTJOB) /* =============================================================== */ /* = Command....... ChkJob = */ /* = CPP........... ChkJob = */ /* = Description... Check Job by job name and subsystem = */ /* = = */ /* = CrtCmd Cmd( ChkJob ) = */ /* = Pgm( ChkJob ) = */ /* = SrcFile( YourSourceFile ) = */ /* =============================================================== */ /* = Date : 2007/06/04 = */ /* = Author: Vengoal Chang = */ /* =============================================================== */ /* = Date : 2007/06/21 = */ /* = Author: Vengoal Chang = */ /* = Added on ACTION *MSG to send status message to user= */ /* =============================================================== */ /* = Date : 2007/08/08 = */ /* = Author: Vengoal Chang = */ /* = Added on JOBSTS keyword to limit job processing = */ /* =============================================================== */ /* = Date : 2007/08/14 = */ /* = Author: Vengoal Chang = */ /* = Added on ACTION *DSP to display job information = */ /* = DSPJOB OPTION(*ALL) OUTPUT(*PRINT) = */ /* = DSPJOB OPTION(*JOBLOG) OUTPUT(*PTINT) = */ /* =============================================================== */ CMD PROMPT('Check Job') PARM KWD(JOBNAME) TYPE(*NAME) SPCVAL((*ALL)) + MIN(1) PROMPT('Job name') PARM KWD(JOBUSER) TYPE(*NAME) SPCVAL((*ALL)) + MIN(1) PROMPT('Job user') PARM KWD(SBS) TYPE(SBSD) MIN(1) PROMPT('Job + running under subsystem') PARM KWD(JOBSTS) TYPE(*CHAR) LEN(5) RSTD(*YES) + DFT(*ALL) VALUES(*ALL *MSGW) PROMPT('Job + selection by ACTJOB status') PARM KWD(ACTION) TYPE(*CHAR) LEN(5) RSTD(*YES) + DFT(*MSG) VALUES(*DSP *CHG *END *HLD *RLS + *MSG *CMD) EXPR(*YES) PROMPT('Action') PARM KWD(JOBOPT) TYPE(*CHAR) LEN(3000) + PMTCTL(IFPGM) PROMPT('Job command option + DSP,CHG,END') PARM KWD(TOUSR) TYPE(*NAME) LEN(10) + SPCVAL((*SYSOPR)) PMTCTL(IFTOUSR) + PROMPT('Send status message to user') PARM KWD(CMD) TYPE(*CMDSTR) LEN(3000) + PMTCTL(IFCMD) PROMPT('Command to run') SBSD: QUAL TYPE(*NAME) LEN(10) SPCVAL((*ALL)) EXPR(*YES) QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL) (*CURLIB)) EXPR(*YES) + PROMPT('Library') IFPGM: PMTCTL CTL(ACTION) COND((*EQ *CHG)) PMTCTL CTL(ACTION) COND((*EQ *END)) LGLREL(*OR) IFTOUSR: PMTCTL CTL(ACTION) COND((*EQ *MSG)) IFCMD: PMTCTL CTL(ACTION) COND((*EQ *CMD)) DEP CTL(&ACTION *EQ *CHG) PARM((JOBOPT)) DEP CTL(&ACTION *EQ *END) PARM((JOBOPT)) DEP CTL(&ACTION *EQ *MSG) PARM((TOUSR)) DEP CTL(&ACTION *EQ *CMD) PARM((CMD)) File : QCLSRC Member: CHKACTJOBT Type : CLP Usage : CRTCLPGM PGM(lib/CHKACTJOBT) CALL CHKACTJOBT PGM DCL &MSGTXT *CHAR 256 CHKACTJOB JOBNAME(QSYSSCD) JOBUSER(QPGMR) SBS(QINTER) + ACTION(*CHG) JOBOPT('RUNPTY(10)') MONMSG CPF9898 EXEC(DO) RCVMSG MSGTYPE(*EXCP) MSG(&MSGTXT) DMPCLPGM ENDDO CHKACTJOB JOBNAME(QSYSSCD) JOBUSER(QPGMR) SBS(QCTL) + ACTION(*MSG) TOUSR(*SYSOPR) MONMSG CPF9898 EXEC(DO) RCVMSG MSGTYPE(*EXCP) MSG(&MSGTXT) DMPCLPGM ENDDO CHKACTJOB JOBNAME(QSYSSCD) JOBUSER(QPGMR) SBS(QCTL) + JOBSTS(*MSGW) ACTION(*MSG) TOUSR(*SYSOPR) MONMSG CPF9898 EXEC(DO) RCVMSG MSGTYPE(*EXCP) MSG(&MSGTXT) DMPCLPGM ENDDO CHKACTJOB JOBNAME(QSYSSCD) JOBUSER(QPGMR) SBS(QCTL) + JOBSTS(*MSGW) ACTION(*MSG) TOUSR(*SYSOPR) MONMSG CPF9898 ENDPGM Thanks to Vengoal Chang

Back

CL Difference In Dates Q: Is there a date testing method which I can use to compare today's date and the member creation date in CL and find the difference in months? If so, I could remove the RPG program from the process. A: The ILE environment has date capabilities built into it (via the CEE APIs). So if you don't mind using ILE CL, this will be relatively easy to do. The ILE date & time APIs work based on the notion of "Lilian days". The Gregorian calendar (which is what's used in most of the world, including the USA) started on October 14, 1582. A Lilian Day is a count of the number of days that have elapsed since that date. Since it's just a count of the number of days since a given point in time, adding and subtracting from the number equates to adding and subtracting days. More info about these APIs can be found here: http://publib.boulder.ibm.com/infocenter/iseries/v5r4/topic/apis/ile4a1TOC.htm Here's an example, based on my understanding of what you're trying to do. (It should work on V3R1 and later machines) PGM DCL VAR(&FILE) TYPE(*CHAR) LEN(10) VALUE('MYFILE') DCL VAR(&LASTMBR) TYPE(*CHAR) LEN(10) DCL VAR(&TODAY) TYPE(*CHAR) LEN(4) DCL VAR(&NOTUSED1) TYPE(*CHAR) LEN(8) DCL VAR(&NOTUSED2) TYPE(*CHAR) LEN(23) DCL VAR(&DATE13) TYPE(*CHAR) LEN(13) DCL VAR(&DATE8) TYPE(*CHAR) LEN(8) DCL VAR(&CRTDATE) TYPE(*CHAR) LEN(4) DCL VAR(&TOOOLD) TYPE(*CHAR) LEN(4) DCL VAR(&DONE) TYPE(*LGL) VALUE('0') /********************************************************+ * Calculate what the date was 182 days (1/2 year) ago + *********************************************************/ CALLPRC PRC(CEELOCT) PARM(&TODAY &NOTUSED1 &NOTUSED2 *OMIT) CHGVAR VAR(%BIN(&TOOOLD)) VALUE(%BIN(&TODAY) - 182) /*******************************************************+ * The following code gets the member create date: + * -- RTVMBRD retrieves the member date. + * -- CVTDAT converts it to a 4-digit year + * -- CEEDAYS converts it to lilian days + *******************************************************/ RTVMBRD FILE(&FILE) CRTDATE(&DATE13) RTNMBR(&LASTMBR) LOOP: CVTDAT DATE(%SST(&DATE13 1 7)) FROMFMT(*CYMD) + TOVAR(&DATE8) TOFMT(*YYMD) TOSEP(*NONE) CALLPRC PRC(CEEDAYS) PARM(&DATE8 'YYYYMMDD' &CRTDATE *OMIT) /* Check if member date is too old */ IF (&CRTDATE <= &TOOOLD) DO ... RMVM FILE(&FILE) MBR(&LASTMBR), etc ... ENDDO RTVMBRD FILE(&FILE) MBR(&LASTMBR *NEXT) + RTNMBR(&LASTMBR) CRTDATE(&DATE13) MONMSG MSGID(CPF3049) EXEC(CHGVAR &DONE '1') IF (*NOT &DONE) DO GOTO LOOP ENDDO ENDPGM In the preceding code, the CEELOCT API retrieves the current local time in Lilian format. I subtract 182 days from it (which is approx 6 months) to get the lilian date from 182 days ago. Then I retrieve the member description of each member in the file and convert the create date to lilian format (The CEE APIs don't understand the '0'=1900, '1'=2000 date format, so I use CVTDAT to make it a normal 4-digit year first). Then I can simply compare it to the date from 182 days ago, and if it's older, I can run RMVM, etc. Remember, the above source is ILE CL. That means the source member type must be CLLE (not CLP). And if you compile it from the command line, you have to use the CRTBNDCL command (not CRTCLPGM). (PDM opt 14 will automatically use CRTBNDCL based on the CLLE member type.) If the compiler chokes on the CALLPRC commands, that means you tried to compile it as the original (OPM) CL instead of ILE CL. Thanks to Scott Klement

Back

Synchronize user ID's and System Directory Q: Is there a way to find out what user i.d.'s are NOT set up in the System Directory? A: Depending on what you want to do...we run a program once every day to add directory entries. We do this in order to get "valid" email addresses. We just ignore the 'already exists' message. I'm sure there is a more elegant way to do this, but this will work for its purpose. Short and sweet; it looks like this: PGM DCL VAR(&EMAIL) TYPE(*CHAR) LEN(15) DCL VAR(&SYSNAME) TYPE(*CHAR) LEN(8) DCL VAR(&USRNAME) TYPE(*CHAR) LEN(8) DCLF FILE(QADSPUPB) RTVNETA SYSNAME(&SYSNAME) DSPUSRPRF USRPRF(*ALL) OUTPUT(*OUTFILE) + OUTFILE(QTEMP/USRPRF) OVRDBF FILE(QADSPUPB) TOFILE(QTEMP/USRPRF) TRY1AGN: RCVF MONMSG MSGID(CPF0864) EXEC(GOTO CMDLBL(END)) IF COND(%SST(&UPUPRF 1 1) = 'Q') THEN(GOTO + CMDLBL(TRY1AGN)) CHGVAR VAR(&USRNAME) VALUE(&UPUPRF) CHGVAR VAR(&EMAIL) VALUE('AS400' *CAT &UPUPRF) ADDDIRE USRID(&USRNAME &SYSNAME) USRD(&UPTEXT) + USER(&UPUPRF) USRDFNFLD((SMTPAUSRID SMTP + &email) (SMTPDMN SMTP + 'DOMAIN.COM')) MONMSG MSGID(CPF9082) GOTO CMDLBL(TRY1AGN) END: ENDPGM If you replace the adddire with a dspdire user(&upuprf) and monitor for CPF9006, you could probably find the list of users not enrolled. Thanks to Mike Krebs

Back

Print Debug Listing Q: Is there an easy way to print debug listing ? A: An alternative is to STRDBG on the program in question. If you have the source or listing debug view, you can copy everything by rolling through the screens. Use Edit-copy for the first screen, the Edit-copy append (it's on the Edit menu) for each successive page. A: Also, you can STRCPYSCN to an *outfile. Then you can scroll through the listing without needing to copy/paste. Some editing of the resulting *outfile leaves just the "source". Thanks to Vernon Hamberg and Tom Liotta

Back

Nightly Saves Are you aware of the GO SAVE -21 does NOT save your entire system, right? And I am not just talking about output queues and data queues (which IBM added support for backing up in V5R4). Turns out that numerous directories in the IFS are flagged with a Do Not Save attribute. We just did an Unload/Reload this weekend and several hundred objects were not restored because of this. Luckily I just threatened to clear out /tmp and people moved their permanent stuff out of that directory. That's one directory with such a flag. Gets rebuilt on the fly. You'll also notice lots of directories that contain stuff like web logs are also flagged this way. Speaking of rebuilding /tmp on the fly one thing to keep in mind when doing an unload/reload is that, starting with V5R3, they turn on an attribute in /tmp to "Restrict Rename and Unlink". I suggest you turn that off. Causes real problems with sending email from your i5. Maybe you should put the turning of that attribute off in your startup program. Then again, make sure it exists when your startup hits it, and if not, rebuild it with this attribute turned off. Thanks to Rob Berendt

Back

System Name (NetServer) Q: New lpar. I verified: - CHGNETA - CHGTCPDMN - CFGTCP 1. Work with TCP/IP interfaces 10. Work with TCP/IP host table entries However, when I fired up NetServer it still said that it was the name of this existing lpar. Granted it was only 1 character off and I could have fat fingered something. And, it was no big deal to modify the NetServer properties to use the right one after the next start of NetServer. My big concern was where did it get that name originally? I'd hate to think of something else that might think it is the wrong system. A: AFIAK, this has to be changed in iSeries Navigator (OpsNav). You can't set the Windows (NETBIOS) name via CHGNETA, CHGTCPDMN or CFGTCP. Only through OpsNav. Actually... there might be an API... A: There is an API; I found this link to be really handy in avoiding having to use Ops Naviagator for some of this stuff http://www-03.ibm.com/servers/eserver/iseries/netserver/fastpath.htm From the document referenced above, to rename NetServer server: CALL QZLSCHSN PARM(server-name domain-name 'Server description' X'00000000') Thanks to Scott Klement and Evan Harris

Back

Finding a file in the IFS (QSH) Answer: I often use the website http://www.computerhope.com/unix/ufind.htm That site has a lot of examples, not just a list of obscure parms. Comment: Wow Sarah, that site is f'ing awesome. Thanks for the link - I'm always sad that QSH has no 'man' command. This is probably the nicest online version of man that I've come across. Thanks to Sarah Poger Gladstone

Back

Display Object Locks in the IFS Q: Is there a cmd to display object locks for object in ifs? Something I can run from a cmd line... I see a release ifs lock cmd in v5r4, but no display. A: Execute: CALL PGM(QP0FPTOS) PARM(*LSTOBJREF '/mypath/mytextfile.txt' *FORMAT2) and view the spool file it creates. Thanks to Peter Levy

Back

Mass replace over multiple source members Q: I want to replace a piece of text that occurs in multiple source members. The text '/Copy QRPGLEPRT' should be replaced by '/Copy QCPYLESRC' (the case of the text to be found is not relevant). The text appears in about 30 members in source file QRPGLESRC. Instead of changing all members individually, I would like to execute the replace in a single operation. A: I would use SEU. It is still not a mass replace but can be pretty fast. Go to the Work with Members screen, put a 25 on the first one, hit F13 to put 25 to the end, press enter, put '/Copy QRPGLEPRT' in the search field. When the first matching member opens, go to F16 and put '/Copy QCPYLESRC' in the replace field. Change various parameters, e.g., to change all instances and to allow shifting text - whatever fits your situation. Press F17, then F3 and enter to save. For each successive member press F17, F3, and enter. Voila! Ba-da-bing! Thanks to Vern Hamberg

Back

Image Catalogues Q: Does anybody know how to copy or move Image-Catalogues from one system to another (same releases) ? V5R3 and higher ... A: Create the image catalogue on the remote system and FTP over the files in the IFS then use ADDIMGCLGE: ADDIMGCLGE IMGCLG(PTFCATALOG) FROMFILE('/iPTF/FileName.bin') TOFILE(*fromfile) Make sure the TOFILE parm is *fromfile so it does not duplicate the file. A: My solution involved no ftp. My solution used the special IFS directory called QFileSvr.400. Just to see how cool QFileSvr.400 is try the following: Let's say you are on system X locally. And you want to see system Y. Then try the following on system X: MD '/QFileSvr.400/Y' WRKLNK '/QFileSvr.400/Y' All sorts of directories on your remote system should show up. Comment: Since typing QFileSvr.400 can be a little awkward, especially if you have to do it repeatedly, after doing Rob's stuff create a symbolic link to the other machine: ADDLNK OBJ('/QFileSvr.400/Y') NEWLNK('/Y') Now, just do WRKLNK '/Y' Thanks to Chris Bipes, Rob Berendt and John Jones

Back

TCP goes down ... Tip: On several AS/400s at several community colleges over the past few years, I found that it really helps to specify the CMNRCYLMT parameter on CHGLINETH command for your ethernet line (e.g. ETHLINE) as follows: Recovery limits: Count limit . . .: 99 Time interval ..: 5 Also, add a reply list entry (WRKRPYLE, then F6=Add) for CPA58EE, specifying a reply of "R" for Retry, and a compare value of *NONE. This way, if, after 99 retries on ETHLINE, it still fails, the system issues CPA58EE, and this reply list entry tells the system to "retry" and this starts a new 99 tries every 5 minutes. :-) With the combination of these two, these AS/400s stayed up, available to students on the internet, and recovered, even after events like maintenance on the campus networks, etc., or power outages where the AS/400 was UPS-protected, and so it stayed up, but all of the campus routers, etc. were not UPS protected ... :-o Thanks to Mark S. Waterbury

Back

Command to check if write protect is set for loaded tape? pgm parm(&devd) /* Just a quick throw together to see how it works */ /* This works for "standard tape devices" */ /* but not on *TAPMLB devices */ /* Bryan Dietz */ /* written on V5R4 */ /* http://publib.boulder.ibm.com/ + infocenter/iseries/v5r4/ + index.jsp?topic=/apis/qtardsts.htm */ DCL VAR(&RCV) TYPE(*CHAR) LEN(1000) DCL VAR(&RCVL) TYPE(*INT) LEN(4 ) VALUE(1000) DCL VAR(&FMT) TYPE(*CHAR) LEN(8) VALUE(RDST0100) DCL VAR(&DEVD) TYPE(*CHAR) LEN(10) DCL VAR(&RSC) TYPE(*CHAR) LEN(10) DCL VAR(&ERR) TYPE(*CHAR) LEN(8) VALUE(X'00000000') DCL VAR(&OFFSET) TYPE(*INT) LEN(4) DCL VAR(&NUMENT) TYPE(*INT) LEN(4) DCL VAR(&CHAR4) TYPE(*CHAR) LEN(4) DCL VAR(&volid ) TYPE(*INT) LEN(4) /*offset to data */ DCL VAR(&cartid) TYPE(*INT) LEN(4) /*offset to data */ DCL VAR(&densit) TYPE(*INT) LEN(4) /*offset to data */ DCL VAR(&wp) TYPE(*INT) LEN(4) /*offset to data */ CHKTAP DEV(&TAPDEV) CALL PGM(QTARDSTS) PARM(&RCV &RCVL &FMT &DEVD + &RSC &ERR) /* get to the data we want to see */ CHGVAR VAR(&CHAR4) VALUE(%SST(&RCV 9 4)) CHGVAR VAR(&OFFSET) VALUE(%BIN(&CHAR4)) CHGVAR VAR(&CHAR4) VALUE(%SST(&RCV 13 4)) CHGVAR VAR(&NUMENT) VALUE(%BIN(&CHAR4)) /* get the offsets to the Current cartridge information */ CHGVAR VAR(&VOLID) VALUE(&OFFSET + 1) CHGVAR VAR(&CARTID) VALUE(&VOLID + 6) CHGVAR VAR(&DENSIT) VALUE(&CARTID + 6) CHGVAR VAR(&WP) VALUE(&DENSIT + 10) /* show it */ SNDPGMMSG MSG('Tape device=' *CAT &DEVD *TCAT '. + VolID=' *CAT %SST(&RCV &VOLID 6) *TCAT '. + CartID=' *CAT %SST(&RCV &CARTID 6) *TCAT + '. Density=' *CAT %SST(&RCV &DENSIT 10) + *TCAT '. WP=' *CAT %SST(&RCV &WP 1)) end: endpgm Thanks to Bryan Dietz

Back

License Keys.... know where you can find them ? BB wrote: Back in 2004, I accidentally deleted all our OS/400 license keys while trying to delete some old MAPICS license keys. A nice lady from IBM, came through in a big way by emailing the necessary keys back to me as I had no on-hand record of our keys. Now I make sure I do a DSPLICKEY OUTPUT(*PRINT) every so often and file it somewhere... TL wrote: Note that DSPLICKEY OUTPUT(*LICKEYFILE) is another possibility. This file can be saved, restored, downloaded, uploaded, sent to a secondary system, even loaded into a secondary system's license repository (though it won't do anything except hold the license keys). It can be worthwhile to run this command once in a while just to have the file available. Also note that ADDLICKEY LICKEYINP(*LICKEYFILE) expects a file in this format for input. Thanks to Bryan Burns and Tom Liotta

Back

Iseries Time Server question Q: I am trying to synch up laptops in the field with the Iseries system time. The laptops do not have access to the internet. I have read that the Iseries can act as an SNTP client and get time from the internet. The issue is I only want it to serve up the time, not act as a client to get time from the outside. Is it possible to set up the Iseries as a SNTP server only, and if so what are the steps to do it. A: Yes it is possible. Use iSeries Navigator Network, Servers, TCP/IP, SNTP. Right click on SNTP and choose properties. Notice there are two check boxes, one for client and one for server. Make sure to only select the server box and then go to the server tab and uncheck "server must be sync..." Thanks to Chris Bipes

Back

DASD CL API Q: Does anyone know if there is an API I can call that will return the percentage of storage used similar to WRKSYSSTS? /* Here is a quick way to see the percent used of ASP1. */ /* The API used is QWCRSSTS. */ /* */ /* comments to bryandietz@yahoo.com */ PGM DCL VAR(&PCT) TYPE(*CHAR) LEN(7) DCL VAR(&RCVDTA) TYPE(*CHAR) LEN(067) DCL VAR(&RCVLEN) TYPE(*CHAR) LEN(4) VALUE(X'00000043') DCL VAR(&RESETO) TYPE(*CHAR) LEN(10) VALUE('*YES ') DCL VAR(&FMTNAM) TYPE(*CHAR) LEN(08) VALUE('SSTS0200') DCL VAR(&ERRSTS) TYPE(*CHAR) LEN(08) VALUE(X'00000000') DCL VAR(&PCTASP) TYPE(*DEC) LEN(7) VALUE(0) DCL VAR(&PCTX) TYPE(*DEC) LEN(7 4) VALUE(0) CALL PGM(QWCRSSTS) PARM(&RCVDTA &RCVLEN &FMTNAM &RESETO &ERRSTS) CHGVAR VAR(&PCTASP) VALUE(%BIN(&RCVDTA 53 4)) CHGVAR VAR(&PCTX) VALUE(&PCTASP / 10000) CHGVAR VAR(&PCT) VALUE(&PCTX) SNDPGMMSG MSG('The system disk is ' || &PCT *TCAT '% used') ENDPGM Thanks to Bryan Dietz

Back

Undeleting Deleted Records UN wrote: If memory serves correctly, Dave McKenzie came up with it, and you can read all about it just by searching for UNDEL in the MI400 and MIDRANGE-L archives. DH wrote: He did, although it did one record at a time. UNDEL was also used under the covers by WRKDBF to undelete specific records. WRKDBF also included a command WRKDBFUNDL which did a global undelete of an entire file, by cycling through the file and using UNDEL on each deleted record. However, WRKDBF is not longer available so unless you already have a copy, you should look at other alternatives. MH wrote: It's possible to write a CL program that calls UNDEL in a loop. UNDEL takes a relative record number as a parameter and all you need to do put it in a loop and increment a counter. I think it returns a message that kills the program when you try to undelete a record that isn't deleted but MONMSG will handle that. Here's an example CL: PGM DCL VAR(&RRN) TYPE(*DEC) LEN(6 0) VALUE(1) START: UNDEL FILE(TPCHAASM/F57EMAIL) RCDNBR(&RRN) + ACTION(*RTV) OUTPUT(*OUTFILE) + OUTFILE(TPCHAASM/EMAILOUT) OUTMBR(*FIRST + *ADD) MONMSG MSGID(TOL0001 TOL0020) CHGVAR VAR(&RRN) VALUE(&RRN + 1) IF COND(&RRN < 46315) THEN(GOTO CMDLBL(START)) ENDPGM I will warn you that UNDEL isn't fast but it works great. RB wrote: I think one old hack was to save the file into a save file. Then you could hackinto the save file object and change the deleted record code. KC wrote: Modifying save file data *and* successfully restoring it's contents is a non-trivial task. IBM uses check sums to specifically thwart this hacking. The easier way to recover deleted records is to only read the save file and then write the deleted records data back into the database file. Not technically undeleting anything, but probably close enough to what most people are look for. I believe Dave McKenzie's last version of UNDEL used this save file method. His earlier version actually modified the record deleted status bit directly in the file, but the modified MI program used to do this only worked on older releases. IBM has since shutdown patched programs. Comment: Dave McKenzie has an UNDEL2 in the download section at this site. Thanks to *ALL

Back

API to display all users in USRPRF Q: I have a need to display all users that have an active profile on the system in a subfile, we will be using this for other security issues unrelated to the OS itself (application specific). Is anyone aware of an API that will do this? A: QSYRAUTU will get you started, but needs to be combined with QSYRUSRI. Below I've appended a sample program that should DSPLY all user profiles that match your definition of 'active'. Assuming you have option 13 (System Openness includes) of i5/OS installed you should be able to just CRTBNDRPG and then call the program. Where you find the statement 'dsply QSYUP01;' is where any subfile loading logic would be applied. One little warning. You may have your system setup to prevent this, but in general just getting a list of enabled non-group user profiles does not mean you have a list of all user profiles that are active on your system. There is nothing inherent to i5/OS which prevents someone from signing on using a group profile. You may want to supplement this sample program with another that displays all group profiles which are enabled with a password specified. This list of profiles, and the associated password information, can be found using the same APIs - QSYRAUTU and QSYRUSRI. h dftactgrp(*no) d/copy qsysinc/qrpglesrc,qsyrautu d/copy qsysinc/qrpglesrc,qsyrusri d/copy qsysinc/qrpglesrc,qusec dGetUsrList pr extpgm('QSYRAUTU') d Receiver 1 options(*varsize) d LengthRcv 10i 0 const d Feedback likeds(QSYUTUFI) d Format 8 const d Criteria 10 const d StrProfile 10 const d StrPrfOpt 1 const d GrpPrfName 10 const d QUSEC likeds(QUSEC) d EndProfile 10 const options(*nopass) dGetUsrInfo pr extpgm('QSYRUSRI') d Receiver 1 options(*varsize) d LengthRcv 10i 0 const d Format 8 const d ProfileName 10 const d QUSEC likeds(QUSEC) dReceiver ds likeds(QSYU0100) d based(ListEntryPtr) dReceiverPtr s * dCount s 10i 0 dWait s 1 /free // Set error code to signal exceptions QUSBPRV = 0; // Get the size of receiver variable needed to get all user // profiles that are not a group GetUsrList( QSYU0100 :0 :QSYUTUFI :'AUTU0100' :'*USER' :'*FIRST' :'1' :'*NONE' :QUSEC); // Allocate the needed size ReceiverPtr = %alloc(QSYBAVL03); // Address where the first entry should be returned ListEntryPtr = ReceiverPtr; // Get the list of user profiles that are not in a group GetUsrList( Receiver :QSYBAVL03 :QSYUTUFI :'AUTU0100' :'*USER' :'*FIRST' :'1' :'*NONE' :QUSEC); // Display the number of profiles returned dsply (%char(QSYPNBR) + ' entries returned.'); // Process each returned entry for Count = 1 to QSYPNBR; // Get user profile information GetUsrInfo( QSYI0100 :%size(QSYI0100) :'USRI0100' :Receiver.QSYPN02 :QUSEC); // If enabled display the user profile name if QSYUS01 = '*ENABLED'; dsply QSYUP01; endif; // Address the next returned entry ListEntryPtr += QSYEL; endfor; // Show that we're done and exit dsply 'End of List.' ' ' Wait; dealloc ReceiverPtr; *inlr = *on; return; /end-free Thanks to Bruce Vining

Back

Retrieving an IFS object owner Q: If I use the stat() API it gives the User ID of the Owner as a numeric field. How do I convert this to the Owner name ? A: The getpwuid() API will give you the username. There's also a getgrgid() API for the group profile that owns the file (you didn't ask about that, but it might also be of interest). Here's an excerpt from one of my programs: D owner s 10a D groupx s 10a D info ds likeds(statds64) D own ds likeds(passwd) D based(p_own) D grp ds likeds(group) D based(p_grp) path = %trim(dirname) + '/' + filename; if (lstat64(path: info) = -1); // handle error endif; p_own = getpwuid(info.st_uid); if (p_own = *null); owner = %char(info.st_uid); else; owner = %str(own.pw_name); endif; p_grp = getgrgid(info.st_gid); if (p_grp = *null); groupx = %char(info.st_gid); else; groupx = %str(grp.gr_name); endif; Thanks to Scott Klement

Back

Ifs shares and mapped drives Q: I have been asked to have a folder on the IFS available to one of our departments via a Mapped Drive. I have created the file share and mapped the drive, however, probably 80-90 % of the users do not have the same pwd for network and Iseries signons. So, the mapping of the drive does not seem to work for them. Apart from having a single signon solution(we don't currently have plans for doing this) is there a simple way to get around this. A: have an idea... I don't know if it's a "simple solution" (it's conceptually simple, but might not be easy to implement) Windows has a command called 'NET USE' that you can use to map a drive letter. The command has the ability to supply a userid and password. So you can do this: NET USE I: \\myi5\myshare mypassword This will map the I: drive on the PC to the NetServer on the i5, and it will use the Windows userid, but not the standard windows password. Instead, it'll use "mypassword" as the password. Similarly, I can do this: NET USE I: \\myi5\myshare mypassword /USER:sillyguy and it will not only use the password from the command line, it'll also use the userid from the command-line. Once the drive has been mapped this way, it'll continue to work (using the supplied userid/password) until Windows is rebooted. You could put this NET USE command in your user's logon script, or in a batch file in the "Startup" folder on the PC to map the drive, and it'd happen automatically at each boot. The tricky part is where do you get the userid/password? Do you hard-code it in a batch file? If so, this could become a security nightmare. I suppose you could ask the user for it (write a program that asks the user, then runs the NET USE command) with the appropriate values... But, maybe you can make it work... A: We do this for all of our Users, but just for a one-time run when they are first setup. The following command will make it permanent. They won't have to rerun it every time they reboot, which "should" be every time they come in to work. net use x: \\192.168.10.25\QDLS YOUR PASSWORD /user:YOUR USERNAME /persistent:yes The '/persistent:yes' parm is what makes it permanent. Thanks to Scott Klement and Nick Radich

Back

Where is TCP/IP Config Data Stored Q: Does anyone know where the TCP config data (especially the host table and interface data) are stored? We're going to be making some changes and I'd like to be able to save off the info instead of just saving print screens. A: IP configuration you are talking about is stored in QUSRSSYS/QATO* database files. Host file is QATOCHOST, interface file is QATOCIFC. You may find other configuration files in /QIBM/UserData/OS400 directory. Saving QUSRSYS library and /QIBM/UserData/OS400 saves these configuration items. Thanks to Marc Rauzier

Back

iSeries Netserver API's Something about Netserver API's This fast-path document is designed to get your iSeries NetServer configured and running quickly in your network. Use iSeries NetServer to share integrated file system directories as well as output queues to your networked Windows or Linux computers for file and print access. OS/400 setup Note: In current releases of OS/400, iSeries NetServer is configured to start automatically with TCP/IP. In that case you can connect your clients to iSeries NetServer right out-of-the-box, using the default properties configuration. The following steps are helpful for basic customization and verification of your server. General setup TCP/IP Support - Verfiy that TCP/IP support has been configured on your iSeries system. You must have at least one external TCP/IP interface configured and active to use iSeries NetServer. Use the Configure TCP/IP (CFGTCP) command to check and/or modify interfaces, routes, set up host table and domain name services, etc. Once the configuration is complete use the Start TCP/IP (STRTCP) command to activate the support. QSERVER Subsystem - The QSERVER subsystem must be started. Confirm that it is started using the Work with Subsystems (WRKSBS) command. If the QSERVER subsystem is not started, use the Start Subsystem (STRSBS QSERVER) command. Network Print Server - In order for iSeries NetServer print shares to function properly, the Network Print Server (NPS) must be started. To determine the status of NPS, use the Work with Active Job (WRKACTJOB) command to ensure that there is a QNPSERVD job active in the QSYSWRK subsystem. If there is no QNPSERVD job, then you must start the NPS using the Start Host Server (STRHOSTSVR *NETPRT) command. iSeries NetServer setup Note: If you use iSeries Navigator (a part of iSeries Access) for administration, then that is the preferred method for configuring iSeries NetServer. See this document for more information on GUI administration and using the configuration wizard for first-time setup. Otherwise, read on for command line configuration without iSeries Navigator. iSeries NetServer Name and Domain - Verify that the iSeries NetServer name is unique on the network and that the iSeries NetServer domain (workgroup) is appropriate for the majority of the clients accessing the iSeries file and print services (in many cases it can be the same domain or workgroup as the PC clients). You must have *IOSYSCFG authority to modify any part of the iSeries NetServer configuration. To change the iSeries NetServer default server and domain name, use the following: CALL QZLSCHSN PARM(server-name domain-name 'Server description' X'00000000') Once the name has been changed, it should be added to the Domain Name Service, and/or Windows Internet Name Service, if used at your location. Notes: If you still use the old Client Access/400 product, then the iSeries NetServer should be configured to use a different name so as not to conflict with Client Access. The name would be recognized by both and the first one to retrieve the name wins, leading to inconsistent results seen by the client. In this case, it is recommended that the iSeries NetServer use a different name in the network by using a "Q" plus the system name. For example, QAS400A would be used for the iSeries NetServer on an iSeries system with the name AS400A. If Client Access/400 is not being used (or you have all Client Access Express or iSeries Access installations), then the iSeries NetServer name can be the same as the system name. To display the current value of the iSeries system name, use the Display Network Attributes (DSPNETA) command. If you choose to configure the iSeries NetServer name different than the TCP/IP name of OS/400, modern Windows workstations (e.g. Microsoft Windows 2000/XP) may still be able to find the iSeries NetServer by the system TCP/IP name or TCP/IP address. Guest iSeries NetServer User Profile - Guest support is needed for those iSeries NetServer users requiring only file and print sharing support that do not have an iSeries user profile. If you do not change the default setting (no guest support), then unknown users will not have access to iSeries resources through iSeries NetServer. This is the most secure option. You must have *IOSYSCFG and *SECADM authority to modify iSeries NetServer guest support. To modify the iSeries NetServer guest support use the following: CALL QZLSCHSG (guest-user-profile x'00000000') Note: The Guest User Profile should have a password if it is being used for print sharing, and MUST not have any special authority. Sharing Directories and Printers - Only a couple of directories are shared in the initial configuration. Sharing additional resources is not hard. Use the QZLSADFS API to add file shares and the QZLSADPS to add printer shares. For example, the following command adds the share name MYDATA for sharing the "/Data" directory with a 5 character pathname, job CCSID, text description, read-write permissions (2), no maximum users (ffffffff), and no error code structure: CALL QZLSADFS PARM(MYDATA '/Data' x'00000005' x'00000000' 'NetServer Data share' x'00000002' x'ffffffff' x'00000000')For more information on using these APIs (and others) to share resources, see the online API Mini-guide. Current Configuration - From the green screen command line, you cannot easily tell the current settings of iSeries NetServer since the API interface was designed to be used from an administration application like iSeries Navigator. Starting in V5R2, command line wrappers to many of the iSeries NetServer configuration APIs have been provided in a QUSRTOOL library component, including the ability to display current and pending properties for iSeries NetServer. See the GO NETS page for information on using these commands. Starting and Ending iSeries NetServer - Any configuration changes made to iSeries NetServer, with the exception of share and session administration, do not take effect until the you stop and then start the server. You must have *IOSYSCFG authority to use the following to end and start iSeries NetServer: CALL QZLSENDS PARM(X'00000000') CALL QZLSSTRS PARM('0' X'00000000') Determining if iSeries NetServer is Running - Use the Work with Active Job (WRKACTJOB) command to verify that there is a QZLSSERVER job running under the QSERVER subsystem. If the QZLSSERVER job is not active, you must start iSeries NetServer. iSeries NetServer Connections - Using the Work with TCP/IP Network Status (NETSTAT *CNN) command you should see the following entries. If these connections do not exist, restart iSeries NetServer. * * netbios > 001:27:44 Listen * * netbios > 000:00:01 *UDP * * netbios > 000:00:00 *UDP * * netbios > 000:30:57 Listen For OS/400 releases that support CIFS (Common Internet File System) protocol over TCP/IP, you will also see the following entry: * * cifs 001:27:32 Listen Note: The NETSTAT command output may be many pages in length. PC setup Properly networked PC and Linux clients may not need additional configuration to connect to iSeries NetServer. If you are experiencing trouble, please verify the settings described below. Windows 98 Click Start-->Settings-->Control Panel-->Network-->Configuration and verify that you have Client for Microsoft Networks and TCP/IP added and configured. Go to the Identification tab and verify that you have a unique Computer Name on the network and a valid Workgroup name configured (preferably the same one as the iSeries NetServer). Windows NT Click Start-->Settings-->Control Panel-->Network-->Identification and verify that you have a unique Computer Name on the network and a valid Workgroup name configured (preferably the same one as the iSeries NetServer). Go to the Protocols tab and verify that the TCP/IP Protocol has been added and is configured properly. Windows 2000 Click Start-->Settings-->Control Panel-->Network and Dial-up Connections-->Local Area Connection. Verify that Client for Microsoft Networks and Internet Protocol (TCP/IP) are both in the list and checked. Select Internet Protocol (TCP/IP) and click Properties. Click Advanced. Click the WINS tab and verify that NetBIOS over TCP/IP is not disabled. Check other TCP/IP settings. Click Start-->Settings-->Control Panel-->System-->Network Identification tab. Verify that you have a unique Computer Name on the network and a valid Workgroup/Domain name configured. Other Clients - See appropriate documentation in the Information Center or the Linux pages for Samba clients. Check TCP/IP Support - Test the support by PINGing the iSeries system from a DOS window as follows: PING iSeries-NetServer-server-name Resolving iSeries NetServer Name - Ensure that an entry for the iSeries NetServer is in the Domain Name Server (DNS). If DNS is not being used or backup resolution mechanisms are needed, then use the PC's local LMHOSTS, or set up a Windows Internet Name Server (WINS) to resolve the iSeries NetServer server name. The quickest way is to add an entry to the LMHOSTS file located in the \Windows directory on a Windows 98 PC, or the \WINNT\system32\drivers\etc directory on Windows NT/2000/XP/2003. If you cannot find an LMHOSTS file in the specified directory it might not have been created yet. Rename LMHOSTS.SAM in that same directory to LMHOSTS and then add a line with the following format: TCP/IP-address iSeries-NetServer-server-name #PRE For example: 9.5.10.1 QNETSERVER #PRE Finding iSeries NetServer and Shared Resources - iSeries NetServer may also appear in the Windows Network Neighborhood but this depends on your network TCP/IP configuration. Find Computer is more likely to work in all environments. In order to display iSeries NetServer shares double click on iSeries NetServer accessed through either Find Computer or Windows Network Neighborhood (a.k.a. My Network Places). Remember that Windows Network Neighborhood is also available through Windows Explorer, so iSeries NetServer shares can be explored as well. To find computers on Windows 2000/XP, click Start-->Search-->For Files and Folders. In the lower left pane of the search dialog, click Comuters. Now, enter the iSeries NetServer name (or IP address) in the field provided. Installing iSeries Access - You can use the iSeries NetServer to easily install iSeries Access on your Windows 98/Me/NT/2000/XP client PC. Administrating iSeries NetServer from a PC client requires the use of iSeries Navigator. iSeries NetServer automatically shares the QIBM directory with clients for the purpose of allowing iSeries users who already have user profiles to install iSeries Access on client PCs. For example, to install iSeries Access on a Windows 2000 PC, use Setup.exe from \\iSeries-NetServer-server-name\QIBM\ProdData\CA400\Express\Install\Image. The 'mini' API guide: iSeries NetServer is normally administered through the user interface provided in iSeries Navigator. However, you can also access the administration functions by calling the iSeries NetServer APIs. This page contains brief reference information to get you started. You may also visit the Information Center for complete API documentation in order to build your own administration interface. Note: Starting in V5R2, you have the option of installing a green screen command menu of iSeries NetServer function. Click here for details. Following is a partial list of the APIs available for administration of the iSeries NetServer. They do not include the latest parameter options, however, they demonstrate the use for all the required parameters. The error code structure is always the last parameter and in these examples x'00000000' is being used instead of the actual structure. For more information about the error code structure reference the iSeries System API guide, SC41-4801-00. Note: Server configuration changes will take place the next time iSeries NetServer is started. All share addition, changes and removal, will take place immediately. Start/Stop iSeries NetServer CALL QZLSSTRS PARM('0' x'00000000') Start iSeries NetServer. See the QZLSSERVER job under the QSERVER subsystem. The QZLSSERVER is automatically started every time the QSERVER subsystem is started. Parameters: '0' - Reset (0 indicated no reset) x'00000000' - used in lieu of error code structure CALL QZLSENDS PARM(x'00000000') End iSeries NetServer. Parameters: x'00000000' - used in lieu of error code structure Add/change a file share CALL QZLSADFS PARM(MYSHARE '/Data' x'00000005' x'00000000' 'My shared data folder' x'00000001' x'ffffffff' x'00000000') CALL QZLSCHFS PARM(MYSHARE '/Data' x'00000005' x'00000000' 'My shared data folder' x'00000002' x'ffffffff' x'00000000') The first command adds the file share MYSHARE, which shares the /Data folder read-only. The second command changes the file share properties to be read-write. Parameters: MYSHARE - share name '/Data' - path name x'00000005' - length of path name x'00000000' - CCSID encoding of path name (0 indicates same as job) 'My shared data folder' - text description x'00000002' - permissions (2 indicates r/w, 1 is read-only) x'ffffffff' - maximum users (-1 indicates no max) x'00000000' - used in lieu of error code structure Add/change a printer share CALL QZLSADPS PARM(LASEROQ 'QPRINT QGPL ' 'Default iSeries outq' x'00000001' 'IBM 4039 LaserPrinter' x'00000000') CALL QZLSCHPS PARM(LASEROQ 'QPRINT QGPL ' 'LASEROQ iSeries outq' x'00000001' 'IBM 4039 LaserPrinter' x'00000000') Add or change a print server share. Takes effect immediately. Parameters: LASEROQ - share name 'QPRINT QGPL ' - qualified output queue (10 spaces needed for queue, and 10 for library) 'Default iSeries outq' - text description (changed in the QZLSCHPS call) x'0000001' - spool file type (1 indicates *USERASCII, 2 *AFP, 3 *SCS) 'IBM 4039 LaserPrinter' - print driver type (indentifes appropriate print driver for share) x'00000000' - used in lieu of error code structure Remove share CALL QZLSRMS PARM(MYSHARE x'00000000') Remove a server share. Takes effect immediately. Parameters: MYSHARE - share name x'00000000' - used in lieu of error code structure Change Guest CALL QZLSCHSG PARM(NETGUEST x'00000000') Change server guest profile. The initial configuration is to disallow guest users from accessing shares. Note: The requested changes will take place the next time iSeries NetServer is started. NETGUEST - name of guest user profile x'00000000' - used in lieu of error code structure Change server information CALL QZLSCHSI PARM(RequestVar x'00000112' ZLSS0100 x'00000000') Change iSeries NetServer information/properties. Parameters: RequestVar - variable holding input data structure x'00000112' - length of variable data ZLSS0100 - format requested for change (ZLSS0100 indicates server information) x'00000000' - used in lieu of error code structure Change server name CALL QZLSCHSN PARM(AWESERVE SMBMANIA 'demo server' x'00000000') Change server name. Note: The requested changes will take place the next time iSeries NetServer is started. Parameters: AWESERVE - server name SMBMANIA - domain name 'demo server' - text description x'00000000' - used in lieu of error code structure List server information CALL QUSCRTUS PARM('OUTDATA QGPL ' PF 2048 X'00' *ALL 'API output space') CALL QZLSLSTI PARM('OUTDATA QGPL ' ZLSL0100 *ALL x'00000000') DSPF STMF('/qsys.lib/qgpl.lib/outdata.usrspc') List server information. Data is dumped to a user space. A program could be written to interpret the data. QUSCRTUS Parameters: 'OUTDATA QGPL ' - name of user space to create (10 spaces needed for space name, 10 for library) PF - extended attribute (PF = physical file) 2048 - initial size for user space X'00' - initial value to clear user space with *ALL - public authority 'API output space' - text description QZLSLSTI Parameters: 'OUTDATA QGPL ' - name of user space to receive information (10 spaces needed for space name, 10 for library) ZLSL0100 - format of data requested ZLSL0100 - Share information ZLSL0200 - dump configuration information ZLSL0300 - Session information *ALL - information qualifier x'00000000' - used in lieu of error code structure DSPF Parameter: '/qsys.lib/qgpl.lib/outdata.usrspc' - stream file path name of the user space End session CALL QZLSENSS PARM(BUCKY x'00000000') End server session(s) from workstation BUCKY. Parameters: BUCKY - workstation name x'00000000' - used in lieu of error code structure Thanks to iSeries Information Center

Back

My CCSID is set to 65535 !! Many systems can change the CCSID from 65535 to the CCSID associated with their language ID without experiencing adverse effects. But "many" is definitely not the same as all :) If the system is configured with all I/O devices using the same language and the applications in use are home grown (or at least developed using the same language environment) then you are most likely safe. It however gets a lot more interesting when either or both of these assertions are not true. Let's say you have a system in the UK, using UK terminals, running an application developed in the United States. Let us further assume that the application has a control field in one file where values such as $ and # might be used (not necessarily "seen" by an end user, but used to control processing within the application) and that this file is tagged with CCSID 37 (US). When the job (or system) is running with a CCSID of 65535 and the application program read the file, the "$" control value is read as x'5B' and the "#" as x'7B'. The application program compares the control field to a constant within the program (x'5B' and x'7B' respectively) and happily goes on its way. Now lets change the job (or system) CCSID to 285 (UK). When the application opens the file data managements will detect the difference between the file CCSID (37) and the job CCSID (285) and automatically convert the data from 37 to 285 on Reads and from 285 to 37 on Writes or Updates This conversion will cause the "$" control value to be read into the application program as x'4A' (the code point for the "$" character in CCSID 285) and the poor application program (compiled using the CCSID 37 constant of x'5B' for the "$" sign) will no longer compare equal. This, in many cases would be a definite problem :) The "#" however would be OK as it is x'7B' in both CCSIDs. To further complicate though, if the application reads a "#" and then writes a "$" due to a status change in the record (or just writes a "$" for some new record), data management will see the program constant x'5B' being written to the updated (or new) record, realize that x'5B' in CCSID 285 is the "£" and convert that to the "£" sign in CCSID 37 - x'B1'. This value will work OK on subsequent reads from the application program, but will look like the character "[" to anyone looking at the file using a command such as DSPPFM. And if you now switch the job or system CCSID back to 65535 (due to the bad comparisions for existing records) you will find that now any records written or updated while you were in CCSID 37 are now messed up. You now have a very, very bad situation... I will point out though that this could have been avoided if the application file had had the decency to define the control field as Hex and not Character. Hex fields do not get converted by data management on IO operations. Most applications however, that I've seen anyway, do not utilize this capability. Now one might say that the problem here is that we switched from CCSID 65535 to CCSID 285. What we "should" have done was switched from CCSID 65535 to CCSID 37. Work station data management, like data base data management, will also do CCSID converions on your behalf. While the "control" field is now being correctly interpreted under CCSID 37, user data in the file is now being read into the application program under CCSID 37 even though it is really 285. WS data management can detect this difference and again provide automatic conversion on writes to the display file (or UIM panel) from 37 to 285, and on reads from the display from 285 to 37. So the "£" that the user entered (and saw) yesterday, today is displaying as a "$". The users may not like this... :) This conversion can be turned off (and in fact the default is for it to be off), but if you decide in the future to install (or develop) an application that truely is CCSID aware (and utilizes the WS data management capabilities to support a multi-lingual environment) you will find yourself with difficulties when trying to move into that environment -- as you've been somewhat lying to the system since you changed the CCSID to 37... You really, really need to understand the application and system configuration environment in order to change the system CCSID from 65535 to a non-65535 value. Though as I mentioned at the start of this note, this can be a no brainer for some environments. If it was simple to change for all systems IBM would have changed the default years ago. But IBM has no way of knowing what all mischief might be happening in that 65535 environment. Thanks to Bruce Vining Pretend for a moment that there is no system-wide definition of CCSID. The goal is to ensure that each user profile is specifically associated with the language [and regional characteristics] representing what the human actually types and reads. It is only because the default settings defer to *SYSVAL, that the system value QCCSID is so often mentioned as a way to establish the CCSID [for the users and thus the jobs of the users] for the system. However any specific user may more appropriately have their own specific language settings, different than the system value settings. The LANGuage IDentifier and Coded Character Set IDentifier should be set to appropriately identify the operating defaults for the user. The parameters are the first two of the following list, which includes other language and regional settings: LANGID CCSID CNTRYID CHRIDCTL SETJOBATR LOCALE SRTSEQ These parameters are available on CRTUSRPRF & CHGUSRPRF, each with default of *SYSVAL for create, and thus each parameter has a corresponding system value -- with naming Qparameter So instead of being concerned with "CHGSYSVAL QCCSID A_Value", change can be limited by changing each user by requesting to CHGUSRPRF UsrPrf() LANGID(as_appropriate) CCSID (as_appropriate). In an environment where the user profile sees in WRKJOB OPTION(*DFNA) the CCSID and Default CCSID as noted below, 65535 and 37 respectively, then the language environment resolution by the system [in response to a defaulted CCSID(*HEX) environment], inferred that the user (job) should run with a US English CCSID 37. Typically the inference is from the QLANGID. I believe the QLANGID is established according to the installed Primary Language; see GO LICPGM, option 20. If a user had established LANGID(ESP) CCSID(*SYSVAL) to identify themselves with Spanish language while the system value was 65535, then jobs for that user would have been established with a /Default/ CCSID of 284. If the system value were later changed to 37, then that user would experience a change to their default job CCSID for new jobs, to the new value of 37. Given the language settings are setup appropriately, more things will /start working/ than stop working. However what is corrected, could easily have some functions appear to be broken. That is, a correction could be perceived as a defect, because that which is inconsistent is often more problematic than being consistently incorrect. However the sooner the appropriate language settings are established across the system, the sooner the situations of /consistently incorrect/ can be addressed. And such a _proactive_ approach to establish the appropriate CCSID can prevent having to deal in a _reactive_ approach later, to data issues that resulted from not having already done so. However the bigger issue is [not the user & job CCSID, but] that the data being typed and displayed is properly reflected across multiple language environments. Whereas many systems will not have any such concern for differences in the spoken & written languages amongst a homogeneous group of individual users, the concern still remains for the /encoded characters/ stored as data on a computer. The encoding is defined by the CCSID. The most pervasive issue is for transfer of data between an ASCII system and the EBCDIC i5/OS; i.e. different encoding, and a difference more obvious to most. If a file for example is defined [tagged] with the CCSID (*HEX) [AKA CCSID(65535)] that indicates to the system that /no character conversion/ should occur. The data after a transfer between disparate system encoding defaults, could be generally unreadable Some functions like ODBC had implemented a special [IMO horrible] feature to /translate irrespective of tagging/ to ask the code to _assume_ that the CCSID of the data reflects the job [default] CCSID. As more lies are told to the system code, and more transfers of data with such _assumptions_ based on such lies occur, the more likely the data will have lost its fidelity. Or one day when fidelity is required, for the lack of proper tagging with a CCSID, the true meaning of the data is lost transferring outside of the original language-specific encoding. The most typical example is when a UK pound sign is presented where the US dollar sign was intended to be manifest to the viewer of the data. So not only get the system\user\job CCSID established, but get any files and other data properly tagged. Thanks to Chuck Pence

Back

Pointer in ILE CL for getenv() A simple example of pointer usage in V5R4 ILE CL -- the example retrieves and extracts the environment variable 'MyEnvVar'. The value returned from getenv() is a pointer. The pointer becomes the basing address for &EnvVarVal. Once the pointer is returned, the storage pointed to is scanned with QCLSCAN for the null-terminator. The substring up to (and including) the null-terminator is copied into &MyEnvVar. Execute ADDENVVAR ENVVAR('MyEnvVar') VALUE('Some useless value to return...') before calling program to see the 'useless' value that's returned. Or run the program without executing ADDENVVAR to see the result of the null pointer from the API. Note that (1) V5R4 is required and (2) PTFs must be recent enough to get decent *PTR handling (there were various bugs early on). pgm /* General working variables: */ /* The name of the ENVVAR to retrieve... */ dcl &EnvVar *char 32 /* The extracted ENVVAR value... */ dcl &MyEnvVar *char 256 value( '*****' ) /* Used as a null-terminator constant... */ dcl &x00 *char 1 value( x'00' ) /* Null-terminator */ /* A couple pointers: */ /* Used whenever a comparison to a *NULL pointer is needed... */ dcl &pNull *ptr /* Auto-initialized to *null */ /* Pointer to be returned from getenv()... */ dcl &pEnvVar *ptr /* The "based" variable: */ dcl &EnvVarVal *char 256 stg( *BASED ) + basptr( &pEnvVar ) /* Variables for QCLSCAN API */ dcl &STRLEN *dec ( 3 0 ) value( 256 ) dcl &STRPOS *dec ( 3 0 ) value( 1 ) dcl &PATLEN *dec ( 3 0 ) value( 1 ) dcl &TRANSLATE *char 1 value( '0' ) dcl &TRIM *char 1 value( '0' ) dcl &WILD *char 1 value( ' ' ) dcl &RESULTS *dec ( 3 0 ) value( 0 ) /* Set the ENVVAR name to retrieve -- null-terminated...*/ chgvar &EnvVar ( 'MyEnvVar' *cat &x00 ) /* Retrieve the chosen ENVVAR... */ callprc 'getenv' ( + &EnvVar + ) + rtnval( &pEnvVar ) /* Pointer is returned */ /* Test for *null pointer returned -- "not found"... */ if ( &pEnvVar *eq &pNull ) do sndpgmmsg msgid( CPF9898 ) msgf( QCPFMSG ) + msgdta( 'Not found' ) msgtype( *ESCAPE ) return enddo /* Scan for null-terminator -- end of string... */ call QCLSCAN ( + &EnvVarVal + &STRLEN + &STRPOS + &x00 + &PATLEN + &TRANSLATE + &TRIM + &WILD + &RESULTS + ) /* If we get a positive &RESULTS: */ /* Grab substring up to/including null-terminator... */ /* Use &RESULTS-1 if we don't want the null... */ if ( &RESULTS *gt 0 ) + chgvar &MyEnvVar %sst( &EnvVarVal 1 &RESULTS ) /* ...otherwise note that we found no null... */ else + chgvar &MyEnvVar 'No null-terminator found' /* If no null-terminator was found, we could have done */ /* any number of things including just grabbing the */ /* entire 256 bytes... */ /* Dump the results to verify... */ dmpclpgm return endpgm Thanks to Tom Liotta

Back

Page #4     Page #6