iSeries & System i

#4 Tips & Tricks - Table of Contents #6

Convert from Hex to Dec to Bin
Running SQL commands from CL (or elsewhere)
Display Subsystem Descriptions
Order PSP, Cum or Group PTF's
Get Installed Software Informations, ect.
Commenting out blocks of code in FF
Passing *INT2 to RPGLE
Check TCP/IP Interface Address Status with APIQtocRtvTCPA, QtocLstNetIfc
Check Active Job
CL Difference In Dates
Synchronize user ID's and System Directory
Print Debug Listing
Nightly Saves
System Name (NetServer)
Finding a file in the IFS (QSH)
Display Object Locks in the IFS
Mass replace over multiple source members
Image Catalogues
TCP goes down ...
Command to check if write protect is set for loaded tape?
License Keys.... know where you can find them ?
Iseries Time Server question
DASD CL API
Undeleting Deleted Records
API to display all users in USRPRF
Retrieving an IFS object owner
Ifs shares and mapped drives
Where is TCP/IP Config Data Stored
iSeries Netserver API's
My CCSID is set to 65535 !!!
Pointer in ILE CL for getenv()



Convert from Hex to Dec to Bin

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
Back

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

Back