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