iSeries & System i

#5 Tips & Tricks - Table of Contents #7

Number of jobs running in subsystem
Cleanup Diskspace
Upgraded to V6R1, and now run STROBJCVN
Unix timestamps vs. RPG timestamps
File CCSID of 13488 - unreadable
Active Jobs in a Pool
Random Character String Generator
Print a list of commands that users with limited capabilities can use
ODBC exit point removed -- by whom?
Start all FAX devices
Command: AUTORPY -- Auto reply message by message id
Web Server - Kill a job immediately
Searching Multi-Member Files without PDM
What's With These ASCII, EBCDIC, Unicode CCSIDs
Suppress display in STRQSH
iSeries Ops Navigator auto-start...?
Difference between CCSID 65535 and CCSID 37
Testing the Qshell QzshSystem API
Basic CGIDEV2 problem
WRKENVVAR - have you checked it today ??
CRTSRVPGM with zero signature (EXPORT SYMBOL)
Journal Tutorial
Extract the PCML info with QBNRPII (api)
Reference for what various combinations of msg type and msg queue will do
International Support with UTF-8 - Considerations and Setup
Need an RPG pgm that returns Days Until Password Expires
sFTP vs FTPs



Number of jobs running in subsystem

Q: Does anyone know of a quick way to count the number of jobs running in a subsystem?

A: Here is a simple CL I wrote: /* This program demonstates the QWDRSBSD API */ /* When called with a subsystem name */ /* CALL #JOBSBS PARM(QINTER) */ /* it returns some info about the subsystem */ /* mainly the number of jobs active and the */ /* status of the subsystem */ /* comments to bryandietz@yahoo.com */ PGM PARM(&SBS ) DCL &NBR *CHAR 4 DCL &TOT *CHAR 4 DCL &SBS *CHAR 10 DCL &LIB *CHAR 10 VALUE('*LIBL ') DCL &LEN *CHAR 4 DCL &ACT *CHAR 10 DCL &SPACE *CHAR 100 DCL &SBSLIB *CHAR 20 DCL &ERROR *CHAR 8 (X'0000000000000000') CHGVAR %SST(&SBSLIB 1 10) &SBS CHGVAR %SST(&SBSLIB 11 10) &LIB CHGVAR VAR(%BIN(&LEN)) VALUE('100') CALL PGM(QWDRSBSD) PARM(&SPACE &LEN SBSI0100 + &SBSLIB &ERROR) MONMSG MSGID(CPF1608) EXEC(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('The + subsystem ' || &SBS *BCAT 'in *LIBL is + not found') GOTO CMDLBL(END) ENDDO CHGVAR VAR(&NBR) VALUE(%SST(&SPACE 73 4)) CHGVAR VAR(&TOT) VALUE(%BIN(&NBR)) CHGVAR VAR(&ACT) VALUE(%SST(&SPACE 29 10)) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('The + number of jobs active in ' || &SBS *BCAT + 'is ' || &TOT || ' & the sbs is ' || &ACT) END: ENDPGM Thanks to Bryan Dietz
Back

Cleanup Diskspace

Q: Almost a year after our new i5 was installed. Secondary storage on my partition is
350 G and is 99% full - shown with WRKSYSSTS.

What with all these "cool" tips for iseries navigator being regularily churned out recently,
I thought I'd ask is there a "cool" way of finding who or what is using up all the disk space ?

A: You should Run the command: QSYS/RTVDSKINF This retrieves the objects sizes of the entire system. Please let the command above finish before the following commands are executed (takes up to 2 hours) Retrieve size of entire system (per library) PRTDSKINF RPTTYPE(*LIB) Retrieve object sizes within a library: PRTDSKINF RPTTYPE(*LIB) LIB(QRPLOBJ) OBJ(*ALL) OBJTYPE(*ALL) Use the reports to "Clean Up". While you are waiting for the report to complete - delete all the spoolfiles on the system which are no longer needed. (Use operations navigator to find the oldest spoolfiles, and the largest spoolfiles, and delete those). After deleting the spoolfiles - cleanup the space used by spoolfiles running the command: QSYS/RCLSPLSTG DAYS(*NONE)
Thanks to Jesper Juul Fjeldgaard
Back

Upgraded to V6R1, and now run STROBJCVN

Ok, so, you've passed ANZOBJCVN, upgraded to V6R1, and now run STROBJCVN so your
users do not pay the "first touch" penalty.  I think we discussed this on a thread
but I can't remember.  Anyway, when you run STROBJCVN you might want to change your
system value QMAXSPLF first.  In fact, due to an issue I had, the redpiece on
STROBJCVN will be upgraded to suggest this.

Apparently IBM opens a spool file for each object they convert, but rarely (if ever)
writes to the spool file.  The spool file gets closed and immediately goes to a FIN
state.  However, it still counts as one of the spool files controlled by QMAXSPLF.
Another suggestion is to submit a STROBJCVN for each user library instead of one big
job for *ALLUSR.
I wrote a program(*) that determines if a library is a *ALLUSR and fires off a STROBJCVN
for that library (giving the library name as the job name, etc). If you still have enough
objects in a single library you still may have to modify QMAXSPLF.

IBM will not change the logic to only generate the spool file if needed. They are still
working on the issue that a particular message id doesn't "trim" one of the parameters
passed to the message and thus ties up over a whole page of blank space in the joblog in
the middle of the message.

Failure to change QMAXSPLF, or break down STROBJCVN into manageable pieces may result in
erroneous messages that numerous objects would not convert. When the only real problem was
that it couldn't generate the false spool file.

Note:  Even Domino recommends you run STROBJCVN on the IBM Domino LPP libraries after the
upgrade to avoid the first touch penalty when firing up Domino.

Gosh, I hope IBM isn't doing something real stupid like
DSPOBJD OUTPUT(*PRINT)
CPYSPLF...
DLTSPLF
But something made me think it was more of a SQL issue because of some other message in the
joblog that I can't remember.

(*) Here's his program: H ActGrp(*CALLER) H DftActGrp(*NO) H Bnddir('ROUTINES/SRVPGM':'QC2LE') D/COPY ROUTINES/QAPISRC,QCMDEXC D/COPY ROUTINES/QRPGLESRC,PSDS D OpenCursor PR n D FetchCursor PR n D CloseCursor PR n D DltWorkFile PR D UsrLibrary s 10a /free *inlr=*on; if not OpenCursor(); // perform error routine to alert the troops // ... Else; Dow FetchCursor(); // putting the fetchcursor on the do loop allows the user of // iter, and thus iter will not perform an infinite loop cmd='SBMJOB CMD(STROBJCVN LIB(' + UsrLibrary + ')) JOB(' + UsrLibrary + ')'; cmdlen=%len(%trimr(cmd)); qcmdexc(cmd:cmdlen); EndDo; CloseCursor(); EndIf; return; /end-free P OpenCursor B D OpenCursor PI like(ReturnVar) D ReturnVar s n C/EXEC SQL C+ Set Option C+ Naming = *Sys, C+ Commit = *None, C+ UsrPrf = *User, C+ DynUsrPrf = *User, C+ Datfmt = *iso, C+ CloSqlCsr = *EndMod C/END-EXEC /free DltWorkFile(); cmd='DSPOBJD *ALLUSR *LIB DETAIL(*FULL) OUTPUT(*OUTFILE) ' + 'OUTFILE(QTEMP/MYOUTFILE)'; cmdlen=%len(%trimr(cmd)); qcmdexc(cmd:cmdlen); /end-free C/EXEC SQL C+ Declare C1 cursor for C+ Select odobnm C+ From qtemp/myoutfile C/END-EXEC C/EXEC SQL C+ Open C1 C/END-EXEC /free Select; When SqlStt='00000'; return *on; Other; return *off; EndSl; /end-free P OpenCursor E /eject P FetchCursor B D FetchCursor PI like(ReturnVar) D ReturnVar s n C/EXEC SQL C+ Fetch C1 into :UsrLibrary C/END-EXEC /free Select; When sqlstt='00000'; // row was received, normal ReturnVar=*on; When sqlstt='02000'; // same as %eof, sooner or later this is normal ReturnVar=*off; Other; // alert the troops! ReturnVar=*off; EndSl; return ReturnVar; /end-free P FetchCursor E /eject P CloseCursor B D CloseCursor PI like(ReturnVar) D ReturnVar s n C/EXEC SQL C+ Close C1 C/END-EXEC /free Select; When sqlstt='00000'; // cursor was closed, normal ReturnVar=*on; Other; // alert the troops! ReturnVar=*off; EndSl; DltWorkFile(); return ReturnVar; /end-free P CloseCursor E /eject P DltWorkFile B D DltWorkFile PI /free exec sql drop table qtemp/myoutfile; return; /end-free P DltWorkFile E Attn: You need to remove one BNDDIR and change the two /COPY's and add your own code - if you want to use this program - - - nah.... Rob sent me the two /COPY's (see below).
Comments from others..... Rob - thank you for going to so much detail in testing the impact and specifics of this process (and thank you particularly for taking the time to be so vocal about it on the listserv). It will be a big help to alot of us as we get further into the process over the next year or so! /Chad
Last week after upgrading to 6.1 I ran STROBJCVN on each library instead of doing one for the entire system. It was a quick cl to submit one STROBJCVN for each library. I submitted them into a job queue with 6 active jobs into the *SBSD. ANZOBJCVN said it would take 33 hours to do the conversion, and doing it this way took about 14 hours. A good savings, and then I could see for each library if it ended abnormally. This was so much better than doing one STROBJCVN command and having to look through a mess of information. /Pete
Pete, Those were two more good reasons to do it that way. - multithreading - job ended abnormally... handling. Rob Berendt
A later mail from Rob..... 1 - May not need that first binding directory. Might have just inserted our standard line. 2 - /copy routines QCMDEXC /if defined(QCMDEXC) /eof /endif /define QCMDEXC * QCMDEXC - Execute Command (better served by QCAPCMD) D qcmdexc PR EXTPGM('QCMDEXC') D cmd 32702A CONST OPTIONS(*VARSIZE) D cmdlen 15P 5 CONST D /if defined(PrototypesOnly) /eof /endif D Cmd S 32702A VARYING D CmdLen S 15P 5 /endif PSDS /if not defined(PSDS) /define PSDS DMYPSDS SDS D PROC_NAME *PROC * Procedure name D PGM *PROC Program name D PGM_STATUS *STATUS * Status code D PRV_STATUS 16 20S 0 * Previous status D LINE_NUM 21 28 * Src list line num D ROUTINE *ROUTINE * Routine name D PARMS *PARMS * Num passed parms D EXCP_MSG 40 46 D EXCP_TYPE 40 42 * Exception type D EXCP_NUM 43 46 * Exception number D PGM_LIB 81 90 * Program library D EXCP_DATA 91 170 * Exception data D EXCP_ID 171 174 * Exception Id D PGM_DATE 191 198 * Date (*DATE fmt) D PGM_YEAR 199 200S 0 * Year (*YEAR fmt) D LAST_FILE 201 208 * Last file used D FILE_INFO 209 243 * File error info D JOB_NAME 244 253 * Job name D WSID 244 253 Workstation ID D USER 254 263 * User name D JOB_NUM 264 269S 0 * Job number D JOB_NUMA 6A overlay(JOB_NUM) * Job number, alpha D JOB_DATE 270 275S 0 * Date (UDATE fmt) D RUN_DATE 276 281S 0 * Run date (UDATE) D RUN_TIME 282 287S 0 * Run time (UDATE) D CRT_DATE 288 293 * Create date D CRT_TIME 294 299 * Create time D CPL_LEVEL 300 303 * Compiler level D SRC_FILE 304 313 * Source file D SRC_LIB 314 323 * Source file lib D SRC_MBR 324 333 * Source file mbr D PROC_PGM 334 343 * Pgm Proc is in D PROC_MOD 344 353 * Mod Proc is in D Src_id_a 354 355i 0 * see pos 21-28 D Src_id_b 356 357i 0 * see pos 228-235 D Curr_User 358 367a * Current user D* * see profile handle D* * api's /endif
Thanks to Rob Berendt
Back

Unix timestamps vs. RPG timestamps

Q: I am attempting to get the change date from the stat procedure. Can anyone
tell me how to translate the value received from stat into a date and/or time?

A: The following code demonstrates this. It contains two procedures... Unix2Rpg converts from the st_atime, st_mtime, st_ctime fields into the timestamp format that we typically use in RPG. There's also a Rpg2Unix in this sample code that translates the other direction.... Which you didn't ask for, but I'm including it just to be complete. H DFTACTGRP(*NO) /copy ifsio_h D Unix2Rpg PR Z D UnixTime 10U 0 value D Rpg2Unix PR 10U 0 D RpgTime Z const D myfile s 5000a varying D st ds likeds(statds) D ts s Z D Uts s like(st_atime) /free myfile = '/home/klemscot/aaron.mbr'; if stat( %trimr(myfile): st ) = -1; // check errno, handle error endif; // to convert into RPG's Z format: ts = Unix2Rpg(st.st_atime); dsply ('atime = ' + %char(ts:*ISO) ); ts = Unix2Rpg(st.st_mtime); dsply ('mtime = ' + %char(ts:*ISO) ); ts = Unix2Rpg(st.st_ctime); dsply ('ctime = ' + %char(ts:*ISO) ); // to convert back: uts = Rpg2Unix(ts); *inlr = *on; /end-free *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * Unix2Rpg(): Convert Unix timestamp -> RPG timestamp * * UnixTime = (input) timestamp in Unix format * (seconds from epoch, UTC) * * Returns the RPG timestamp *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ P Unix2Rpg B export D Unix2Rpg PI Z D UnixTime 10U 0 value D CEEUTCO PR D Hours 10I 0 D Mins 10I 0 D Secs 8F D fc 12A options(*omit) D Epoch c z'1970-01-01-00.00.00' D offset s 10I 0 static inz(-1) D Hours s 10I 0 static D Mins s 10I 0 static D Secs s 8F static D retval s Z /free if (offset = -1); CEEUTCO(Hours: Mins: Secs: *omit); offset = secs; endif; retval = Epoch + %seconds(UnixTime) + %seconds(offset); return retval; /end-free P E *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ * Rpg2Unix(): Convert RPG timestamp -> Unix timestamp * * RpgTime = (input) RPG timestamp field to convert. * * Returns the Unix timestamp (seconds from epoch in UTC) *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ P Rpg2Unix B export D Rpg2Unix PI 10U 0 D RpgTime Z const D CEEUTCO PR D Hours 10I 0 D Mins 10I 0 D Secs 8F D fc 12A options(*omit) D Epoch c z'1970-01-01-00.00.00' D Hours s 10I 0 static D Mins s 10I 0 static D Secs s 8F static D Offset s 10i 0 static inz(-1) D UnixTime s 10U 0 /free if (offset = -1); CEEUTCO(Hours: Mins: Secs: *omit); offset = secs; endif; Unixtime = %diff( RpgTime : Epoch + %seconds(offset) : *SECONDS ); return UnixTime; /end-free P E Thanks to Scott Klement
Back

File CCSID of 13488 - unreadable

Q: I have a file (httpd.conf) that has a CCSID of 13488. I can open the file from WRKLNK and it looks fine.
If I open it with WDSc 7, every character is preceded by a square.

Is there some setting that will allow WDSc to open the file correctly?

A: It's not being recognized as UTF-8. Here is how to fix this problem: * On your PC, create a file called httpd.conf. * Go to the admin HTTP server and edit the configuration file * Copy everything from that screen into the httpd.conf file you just created. * Make a note of the permissions on httpd.conf on the server and delete the file. * Copy the httpd.conf file from your PC to the server and fix the permissions as needed. This will create the file in CCSID 819 which will resolve this issue.
A: Another approach is to fire up qsh: mv httpd.conf httpd.conf.bad touch -C 819 httpd.conf cat httpd.conf.bad >> httpd.conf rm httpd.conf.bad That should leave you with a new httpd.conf in codepage 819. Note that it is ">>" and not ">".
A: I think you meant UCS-2, right? (13488 is UCS-2, it's not UTF-8 -- plus, UTF-8 would not create this symptom, as it uses single-byte characters for basic ASCII characters.) Perhaps a simpler way is to do the following from CL: CPY OBJ('/path/to/httpd.conf') TOOBJ('/path/to/httpd.conf2') + DTAFMT(*TEXT) TOCCSID(819) RMVLNK ('/path/to/httpd.conf') RNM OBJ('/path/to/httpd.conf2') NEWOBJ('httpd.conf')
Thanks to Matt Haas, Thorbjørn Ravn Andersen and Scott Klement
Back

Active Jobs in a Pool

Q: Is there a relatively easy way to retrieve the number of active jobs in a pool?
(in my case I want to track number of jobs in *SHRPOOL1)

A: I took one of the suggestions and hacked up some code IBM had in the infocenter. Yes this loops thru all jobs but ran pretty fast for me:
/* ***************************************************************** */ /* APIs USED: QUSCRTUS, QUSLJOB, QUSRTVUS, QUSRJOBI */ /* ***************************************************************** */ PGM PARM(&pool) DCL VAR(&pool) TYPE(*DEC) LEN(15 5) DCL VAR(&poolnbr) TYPE(*DEC) LEN(5 0) DCL VAR(&totpool) TYPE(*DEC) LEN(5 0) DCL VAR(&USRSPC) TYPE(*CHAR) LEN(20) + VALUE('MEMPOOL QTEMP ') DCL VAR(&EUSRSPC) TYPE(*CHAR) LEN(10) DCL VAR(&BIN4) TYPE(*CHAR) LEN(4) DCL VAR(&LOOP) TYPE(*DEC) LEN(8 0) DCL VAR(&DEC8) TYPE(*DEC) LEN(8 0) DCL VAR(&ELEN) TYPE(*DEC) LEN(8 0) DCL VAR(&ELENB) TYPE(*CHAR) LEN(4) DCL VAR(&LJOBE) TYPE(*CHAR) LEN(52) DCL VAR(&INTJOB) TYPE(*CHAR) LEN(16) DCL VAR(&JOBI) TYPE(*CHAR) LEN(200) DCL VAR(&poolnbrC) TYPE(*CHAR) LEN(5) DCL VAR(&NUMBER) TYPE(*CHAR) LEN(6) DCL VAR(&JOBNAME) TYPE(*CHAR) LEN(26) + VALUE(' *ALL ') RTVJOBA NBR(&NUMBER) CHGVAR VAR(%SST(&USRSPC 5 6)) VALUE(&NUMBER) CHGVAR VAR(&EUSRSPC) VALUE(%SST(&USRSPC 1 10)) DLTUSRSPC USRSPC(QTEMP/&EUSRSPC) MONMSG CPF0000 CALL QUSCRTUS (&USRSPC 'COUNTPOOLS' X'00000100' ' ' + '*ALL ' 'Temp user space') CHGVAR VAR(%SST(&JOBNAME 1 10)) VALUE('*ALL') CHGVAR VAR(%SST(&JOBNAME 11 10)) VALUE('*ALL') CALL QUSLJOB (&USRSPC 'JOBL0100' &JOBNAME '*ACTIVE ') CALL QUSRTVUS (&USRSPC X'00000085' X'00000004' &BIN4) CHGVAR &LOOP %BINARY(&BIN4) IF COND(&LOOP = 0) THEN(GOTO CMDLBL(NOJOBS)) CALL QUSRTVUS (&USRSPC X'00000089' X'00000004' &ELENB) CHGVAR &ELEN %BINARY(&ELENB) CALL QUSRTVUS (&USRSPC X'0000007D' X'00000004' &BIN4) CHGVAR &DEC8 %BINARY(&BIN4) CHGVAR VAR(&DEC8) VALUE(&DEC8 + 1) STARTLOOP: IF COND(&LOOP = 0) THEN(GOTO CMDLBL(MSG)) CHGVAR %BINARY(&BIN4) &DEC8 CALL QUSRTVUS (&USRSPC &BIN4 &ELENB &LJOBE) CHGVAR VAR(&INTJOB) VALUE(%SST(&LJOBE 27 16)) CALL QUSRJOBI (&JOBI X'000000C8' 'JOBI0150' + '*INT ' &INTJOB) MONMSG MSGID(CPF3C52) EXEC(GOTO CMDLBL(ENDLOOP)) CHGVAR VAR(&poolnbr) VALUE(%bin(&JOBI 101 4)) IF COND(&POOLNBR = &POOL) THEN(do) CHGVAR VAR(&TOTPOOL) VALUE(&TOTPOOL + 1) enddo ENDLOOP: CHGVAR VAR(&DEC8) VALUE(&DEC8 + &ELEN) CHGVAR VAR(&LOOP) VALUE(&LOOP - 1) GOTO CMDLBL(STARTLOOP) msg: chgvar &poolnbrC &totpool SNDPGMMSG MSG(&POOLNBRC) goto alldone NOJOBS: SNDPGMMSG MSG('No jobs found.') ALLDONE: DLTUSRSPC USRSPC(QTEMP/&EUSRSPC) MONMSG CPF0000 ENDPGM
Thanks to Bryan Dietz
Back

Random Character String Generator

Q: I need to generate a random string of characters....
Best way to do this in RPGLE? Thanks!

A: Best is a matter of opinion. Here is a 10 character random password generator
d randPwd pr 10a d random pr ExtProc('CEERAN0') d 10u 0 d 8f d 12 Options(*Omit) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... generate random password ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p randPwd b d pi 10a d seed s 10u 0 Inz(0) d floater s 8f d fc s 12a d pwd s 10a d $I s 3s 0 d alpha s 26a Inz('ABCDEFGHIJKLMNOPQRSTUVWXYZ') /free For $I = 1 to 10; random( seed: floater : fc ); %SubSt( pwd : $I : 1 ) = %SubSt( alpha : %Int(floater * 26 + 1) : 1 ); EndFor; Return pwd; /end-free p randPwd e A call looks like: rndPwd = randPwd();
Thanks to Chris Pando
Back

Print a list of commands that users with limited capabilities can use

Command: PRTLMTCMD (Print allow limit user command)
File : QRPGLESRC Member : PRTLMTCMD Type : RPGLE Usage : CRTBNDRPG PGM(PRTLMTCMD) TGTRLS(V5R1M0)
** ** Program . . : PrtLmtCmd ** Description : Print Allow Limit User Command ** Author . . : Vengoal Chang ** ** Input parameters ** Description Type Size How Used ** ----------- ---- ---- -------- ** InLibary Char 10 Library to search for objects ** ** ** Compile options: ** ** CrtBndRpg Pgm( PrtLmtCmd ) ** DbgView( *LIST ) TgtRls(V5R1M0) ** ** **-- Header Specifications: --------------------------------------------** H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*NEW) FQSYSPRT O F 132 Printer * * Program Info * d SDS d @PGM 1 10 d @PARMS 37 39 0 d @JOB 244 253 d @USER 254 263 d @JOB# 264 269 0 * * Field Definitions. * d AllText s 10 Inz('*ALL') d CmdString s 256 d CmdLength s 15 5 d Count s 4 0 d Format s 8 d GenLen s 8 d InLibrary s 10 d InType s 10 inz('*CMD') d ObjectLib s 20 d SpaceVal s 1 inz(*BLANKS) d SpaceAuth s 10 inz('*CHANGE') d SpaceText s 50 inz(*BLANKS) d SpaceRepl s 10 inz('*YES') d SpaceAttr s 10 inz(*BLANKS) d UserSpaceOut s 20 * * Data structures * d GENDS ds d OffsetHdr 1 4i 0 d NbrInList 9 12i 0 d SizeEntry 13 16i 0 * * Create userspace datastructure * d DS d StartPosit 10i 0 d StartLen 10i 0 d SpaceLen 10i 0 * * Date structure for retriving userspace info * d InputDs DS d UserSpace 1 20 d SpaceName 1 10 d SpaceLib 11 20 d InpFileLib 29 48 d InpFFilNam 29 38 d InpFFilLib 39 48 d InpRcdFmt 49 58 * d ObjectDs ds d Object 10 d Library 10 d ObjectType 10 d InfoStatus 1 d ExtObjAttrib 10 d Description 50 **-- API Error Data Structure: D ERRC0100 Ds Qualified Inz D BytPrv 10i 0 Inz( %Size( ERRC0100 )) D BytAvl 10i 0 D MsgId 7a D 1a D MsgDta 1024a **-- Global constants: D OFS_MSGDTA c 16 **-- Command information: D CMDI0100 Ds 10240 Qualified Inz D BytRtn 10i 0 D BytAvl 10i 0 D CmdNam_q 20a D CmdNam 10a Overlay( CmdNam_q: 1 ) D CmdLib 10a Overlay( CmdNam_q: 11 ) D CmdPgm_q 20a D PgmNam 10a Overlay( CmdPgm_q: 1 ) D PgmLib 10a Overlay( CmdPgm_q: 11 ) D SrcFil 10a D SrcLib 10a D SrcMbr 10a D VcpNam 10a D VcpLib 10a D ModeInf 10a D AlwInf 15a D AlwLmtUsr 1a D MaxPos 10i 0 D PmtMsfNam 10a D PmtMsfLib 10a D MsgFilNam 10a D MsgFilLib 10a D HlpPngNam 10a D HlpPngLib 10a D HlpId 10a D SchIdxNam 10a D SchIdxLib 10a D CurLib 10a D PrdLib 10a D PopNam 10a D PopLib 10a D RstTgtRls 6a D TxtDsc 50a D CppCalStt 2a D VcpCalStt 2a D PopCalStt 2a D OfsHlpBks 10i 0 D LenHlpBks 10i 0 D CcsId 10i 0 D EnbGui 1a D ThdSafInd 1a D MltJobAcn 1a D PxyCmdInd 1a D 14a **-- Retrieve command information: D RtvCmdInf Pr ExtPgm( 'QCDRCMDI' ) D RcvVar 65535a Options( *VarSize ) D RcvVarLen 10i 0 Const D FmtNam 10a Const D CmdNam_q 20a Const D Error 32767a Options( *VarSize ) **-- Send program message: D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' ) D MsgId 7a Const D MsgFil_q 20a Const D MsgDta 128a Const D MsgDtaLen 10i 0 Const D MsgTyp 10a Const D CalStkE 10a Const Options( *VarSize ) D CalStkCtr 10i 0 Const D MsgKey 4a D Error 32767a Options( *VarSize ) **-- Send completion message: D SndCmpMsg Pr 10i 0 D PxMsgId 7a Const D PxMsgFil 10a Const D PxMsgDta 512a Const Varying **-- Parameter definitions: D ObjNam_q Ds Qualified D ObjNam 10a D ObjLib 10a D ERRMSGID S 7a D firstRcd S N INZ('1') D matchRcd S N * * Create a userspace * c exsr $QUSCRTUS * c eval ObjectLib = AllText + InLibrary * * List all the objects to the user space * c eval Format = 'OBJL0200' * c call(e) 'QUSLOBJ' c parm Userspace UserSpaceOut c parm Format c parm ObjectLib c parm '*CMD' InType * * Retrive header entry and process the user space * c eval StartPosit = 125 c eval StartLen = 16 * * Retrive header entry and process the user space * c call 'QUSRTVUS' c parm UserSpace UserSpaceOut c parm StartPosit c parm StartLen c parm GENDS * c eval StartPosit = OffsetHdr + 1 c eval StartLen = %size(ObjectDS) * * * Do for number of fields * c if NbrInList > 0 c Do NbrInList * c call(e) 'QUSRTVUS' c parm UserSpace UserSpaceOut c parm StartPosit c parm StartLen c parm ObjectDs * c eval ObjNam_q.ObjLib = Library c eval ObjNam_q.ObjNam = Object c c callp RtvCmdInf( CMDI0100 c : %Size( CMDI0100 ) c : 'CMDI0100' c : ObjNam_q c : ERRC0100 c ) c If ERRC0100.BytAvl > *Zero c c If ERRC0100.BytAvl < OFS_MSGDTA c eval ERRC0100.BytAvl = OFS_MSGDTA c EndIf c eval ErrMsgId = ERRC0100.MsgId c If ErrMsgId <> 'CPF6250' c except error c EndIf c Else c If (CMDI0100.AlwLmtUsr = '1') c If firstRcd c except head c eval firstRcd = *Off c eval matchRcd = *On c EndIf c except detail c EndIf c EndIf c eval StartPosit = StartPosit + SizeEntry c EndDo c EndIf c If matchRcd c callp SndCmpMsg( 'CPF9898' c :'QCPFMSG' c :'Print allow limit user command' + c ' on library ' + %trim(InLibrary)+ c ' completed' c ) c Else c callp SndCmpMsg( 'CPF9898' c :'QCPFMSG' c :'Library ' + %trim(InLibrary) + c ' no any allow limit user command' c ) c EndIf * c eval *Inlr = *On *=============================================== * $QUSCRTUS - API to create user space *=============================================== c $QUSCRTUS begsr * * Create a user space named ListObjects in QTEMP. * c movel(p) 'LISTOBJECTS' SpaceName c movel(p) 'QTEMP' SpaceLib * * Create the user space * c call(e) 'QUSCRTUS' c parm UserSpace UserSpaceOut c parm SpaceAttr c parm 4096 SpaceLen c parm SpaceVal c parm SpaceAuth c parm SpaceText c parm SpaceRepl c parm ERRC0100 * c endsr *================================================= * *Inzsr - One time run House keeping subroutine *================================================= c *Inzsr begsr * c *entry plist c parm InLibrary * c endsr *============================================== OQSYSPRT E HEAD 1 O 28 'Allow Limit User Command' O E HEAD 1 O 12 'Library' O 24 'Command' O E detail 1 O Library B 15 O Object B 27 O E error 1 O Library B 15 O Object B 27 O ERRMSGID B 37 **-- Send completion message: P SndCmpMsg B D Pi 10i 0 D PxMsgId 7a Const D PxMsgFil 10a Const D PxMsgDta 512a Const Varying ** D MsgKey s 4a /Free SndPgmMsg( PxMsgId : PxMsgFil + '*LIBL' : PxMsgDta : %Len( PxMsgDta ) : '*COMP' : '*PGMBDY' : 1 : MsgKey : ERRC0100 ); If ERRC0100.BytAvl > *Zero; Return -1; Else; Return 0; EndIf; /End-Free P SndCmpMsg E File : QCMDSRC Member : PRTLMTCMD Type : CMD Usage : CRTCMD CMD(PRTLMTCMD) PGM(PRTLMTCMD)
/* =============================================================== */ /* = Command....... PrtLmtCmd = */ /* = CPP........... PrtLmtCmd = */ /* = Description... Print allow limit user command = */ /* = = */ /* = CrtCmd Cmd( PrtLmtCmd ) = */ /* = Pgm( PrtLmtCmd ) = */ /* = SrcFile( YourSourceFile ) = */ /* = = */ /* =============================================================== */ /* = Date : 2008/07/18 = */ /* = Author: Vengoal Chang = */ /* =============================================================== */ Cmd Prompt( 'Print Allow Limit User Command' ) PARM KWD(LIB) TYPE(*CHAR) LEN(10) MIN(1) + EXPR(*YES) PROMPT('Library')

Thanks to Vengoal Chang
Back

ODBC exit point removed -- by whom?

After I went through all the malarkey a couple of years ago, repeatedly losing exit points
(due to an IBM API bug), I wrote the following CL program:
PGM DCL VAR(&YYYYMMDD) + TYPE(*CHAR) + LEN(8) DCL VAR(&SAVF) + TYPE(*CHAR) + LEN(10) RTVDAT CCYYMMDD(&YYYYMMDD) CHGVAR VAR(&SAVF) + VALUE('EP' *CAT &YYYYMMDD) CRTSAVF FILE(JEFF/&SAVF) + TEXT('Save of QUSRSYS/QUSEXRGOBJ *EXITRG') SAVOBJ OBJ(QUSEXRGOBJ) + LIB(QUSRSYS) + DEV(*SAVF) + OBJTYPE(*EXITRG) + SAVF(JEFF/&SAVF) + DTACPR(*MEDIUM) ENDPGM
It simply creates a save file (EPyyyymmdd) in my private test library and saves the exit points there. The job scheduler runs it every Thursday at 9am. Since I'm continually in that library, I regularly notice these and delete all but the last couple of them. Since writing this program, I've never lost the exit points.
Thanks to Jeff Crosby
Back

Start all FAX devices

I wrote a CL program that would do a STRFAXSPT *ALL since IBM didn't have
that option in the first parameter on the STRFAXSPT command.

/* Start all fax devices. */ /* Adds *ALL as an option in FAXD on the STRFAXSPT command. */ /* */ /* No rights reserved at all. Feel free to modify code and comments as */ /* desired. */ /* Thanks to Guy Vig of IBM for assistance with handling pointers in CL */ /* For information on handling Application Program Interfaces or APIs + please see the Infocenter at: + http://publib.boulder.ibm.com/iseries/ + Studying: + - API concepts + - QUSPTRUS - Retrieve pointer to userspace + - QUSCRTUS - Create user space + - QUSMBRL - List Members + Or buy the book by the former IBMer Bruce Vining + "IBM System i APIs at Work" available at http://store.midrange.com */ /* Modification log: */ /* 08/21/08 by R.Berendt */ /* Created */ /* */ /* */ PGM DCL &UserSpace *CHAR 20 /* Qualified user space */ DCL &SpaceObj *CHAR 10 STG(*DEFINED) DEFVAR(&UserSpace 1) DCL &SpaceLib *CHAR 10 STG(*DEFINED) DEFVAR(&UserSpace 11) DCL &USExtAttr *CHAR 10 VALUE('MEMBERLIST') /* Extended Attr of userspace */ DCL &USSize *INT 4 VALUE(0001) /* Initial size of user space */ DCL &USInit *CHAR 1 VALUE(X'00') /* Initial value of user space */ DCL &USAuth *CHAR 10 VALUE('*ALL') /* Public authority of user space */ DCL &USText *CHAR 50 VALUE('QUSLMBR') /* Text of user space */ DCL &Format *CHAR 8 VALUE('MBRL0100') DCL &DataBase *CHAR 20 /* Qualified database name */ DCL &DBObj *CHAR 10 STG(*DEFINED) DEFVAR(&DataBase 1) DCL &DBLib *CHAR 10 STG(*DEFINED) DEFVAR(&DataBase 11) DCL &MbrSelect *CHAR 10 VALUE('*ALL') /* Which members to retrieve info */ DCL &Overrides *CHAR 1 VALUE('0') /* No override processing */ DCL &USPtr *PTR /* Pointer to user space */ DCL &GHPtr *PTR /* Pointer to generic header information */ DCL &GHInfo *CHAR 256 STG(*BASED) BASPTR(&GHPtr) /* Generic header information */ DCL &GHHOffset *INT 4 STG(*DEFINED) DEFVAR(&GHInfo 117) /* offset to header */ DCL &GHHSize *INT 4 STG(*DEFINED) DEFVAR(&GHInfo 121) /* header size */ DCL &GHLOffset *INT 4 STG(*DEFINED) DEFVAR(&GHInfo 125) /* offset to list */ DCL &GHLSize *INT 4 STG(*DEFINED) DEFVAR(&GHInfo 129) /* list size */ DCL &GHLNbr *INT 4 STG(*DEFINED) DEFVAR(&GHInfo 133) /* Number of list entries */ DCL &GHLEntSize *INT 4 STG(*DEFINED) DEFVAR(&GHInfo 137) /* Size of each entry */ DCL &pListEntry *PTR /* Pointer to list entry. */ DCL &ListEntry *CHAR 10 STG(*BASED) BASPTR(&pListEntry) /* Current fax configuration */ DCL &EntryNbr *INT 4 /* DOFOR VAR(&ENTRYNBR) FROM(1) TO(&GHLNBR) */ DCL &EnhSrv *CHAR 4 VALUE('*YES') /* Initially flag Enhanced services to start */ DCL &FAXD *CHAR 220 VALUE(X'00') /* List of fax devices */ DCL &Cmd *CHAR 512 VALUE(X'00') /* Command to execute */ DCL &CmdLen *DEC (15 5) VALUE(512) /* Length of command to execute */ /* Create a user space to hold the list of members holding the fax devices */ CHGVAR &SpaceObj 'QFAXDEV' CHGVAR &SpaceLib 'QTEMP' CALL QUSCRTUS PARM(&UserSpace &USExtAttr &USSize &USInit &USAuth &USText) /* MONMSG CPF9870 User space already exists */ CHGVAR &DBObj 'QAFFCFG' CHGVAR &DBLib 'QUSRSYS' CALL QUSLMBR PARM(&UserSpace &Format &DataBase &MbrSelect &Overrides) /* For debugging purposes only + DSPF '/QSYS.LIB/QTEMP.LIB/QFAXDEV.USRSPC' + */ /* Retrieve pointer to user space */ CALL QUSPTRUS PARM(&UserSpace &USPtr) /* Header information */ CHGVAR &GHPtr &USPtr /* Any list entries? ie: Are there any fax devices at all? */ if (&GHLNbr>0) Then(Do) /* Initialize pListEntry to some valid entry to allow the %offset to work shortly */ chgvar &pListEntry &USPtr DOFOR VAR(&EntryNbr) FROM(1) TO(&GHLNbr) CHGVAR VAR(%offset(&pListEntry)) + VALUE(%offset(&USPtr) + &GHLOffset + + ((&EntryNbr - 1) * &GHLEntSize)) IF (&EntryNbr = 1) then(do) CHGVAR VAR(&FAXD) VALUE(&ListEntry) EndDo Else Do CHGVAR VAR(&FAXD) VALUE(&FAXD *BCAT &ListEntry) EndDo EndDo /* Cycling through each list entry */ /* Using QCMDEXC because, if you have more than one fax device you'll get + STRFAXSPT FAXD('FAXD01 FAXD02')... + while it should be + STRFAXSPT FAXD(FAXD01 FAXD02) ... */ CHGVAR VAR(&Cmd) VALUE('STRFAXSPT FAXD(' *TCAT &FAXD *TCAT ') ENHSRV(' + *TCAT &EnhSrv *TCAT ')') CALL QCMDEXC PARM(&Cmd &CmdLen) EndDo /* At least one list entry */ CleanUp: /* Delete user space when done */ DLTUSRSPC USRSPC(&SPACELIB/&SPACEOBJ) END: ENDPGM

Thanks to Rob Berendt
Back

AUTORPY -- Auto reply message by message id

I use message handling APIs. Wrote a command AUTORPY to share to everyone.

File : QRPGLESRC Member : AUTORPY Type : RPGLE Usage : CRTBNDRPG PGM(AUTORPY) TGTRLS(V5R1M0)
** ** Program . . : AUTORPY ** Description : Auto Reply Message - CPP ** Author . . : Vengoal Chang ** Date . . . : 2008/09/09 ** ** ** ** Program summary ** --------------- ** ** Message handling API: ** QMHLSTM List Nonprogram Messages ** ** QMHSNDRM Send Reply Message ** ** QMHRTVM Retrieve message ** ** QMHSNDPM Send program message ** ** ** ** Compile options: ** CrtBndRpg Pgm( AUTORPY ) ** TgtRls( V5R1M0 ) ** ** **-- Header specifications: --------------------------------------------** H Debug Option(*Srcstmt:*NoDebugIO) DftActGrp(*NO) ActGrp(*Caller) **-- Retrieve message: ------------------------------------------ D GetMsg Pr ExtPgm( 'QMHRTVM' ) D RtRcvVar 32767a Options( *VarSize ) D RtRcvVarLen 10i 0 Const D RtFmtNam 10a Const D RtMsgId 7a Const D RtMsgFq 20a Const D RtMsgDta 512a Const Options( *VarSize ) D RtMsgDtaLen 10i 0 Const D RtRplSubVal 10a Const D RtRtnFmtChr 10a Const D RtError 32767a Options( *VarSize ) D GetSize ds D GetBytRtn 10i 0 D GetBytAvl 10i 0 D Fmt0400 ds based(FmtPtr) D BytRtn 10i 0 D BytAvl 10i 0 D OffDftRpy 53 56i 0 D LenDftRpyR 57 60i 0 D RpyType 105 114 D MaxRpyLen 117 120i 0 D OffVldRpy 125 128i 0 D NbrVldRpyR 129 132i 0 D LenVldRpyR 133 136i 0 D LenVldRpyA 137 140i 0 D LenVldRpyE 141 144i 0 D Upper C 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' D Lower C 'abcdefghijklmnopqrstuvwxyz' D DftRpy S 32 D DftRpyE S 32 based(DftRpyPtr) D VldRpyE S 32 based(VldRpyPtr) D VldRpyAryStr S 320 D VldRpyAry S 32 Dim(10) D VldRpyAryIdx S 3i 0 D ErrorNull Ds D BytesProv 10i 0 inz(0) D BytesAvaile 10i 0 inz(0) **-- Send escape message: D SndEscMsg Pr 10i 0 D PxMsgId 7a Const D PxMsgF 10a Const D PxMsgDta 512a Const Varying **-- Send completion message: D SndCmpMsg Pr 10i 0 D PxMsgDta 512a Const Varying **-- Send program message: D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' ) D MsgId 7a Const D MsgFq 20a Const D MsgDta 128a Const D MsgDtaLen 10i 0 Const D MsgTyp 10a Const D CalStkE 10a Const Options( *VarSize ) D CalStkCtr 10i 0 Const D MsgKey 4a D Error 1024a Options( *VarSize ) * Prototypes D CrtUsrSpc PR ExtPgm( 'QUSCRTUS' ) D QlSpcName 20 Const D ExtAttr 10 Const D SizeInBytes 10I 0 Const D InitVal 1 Const D PublicAut 10 Const D TextDesc 50 Const D Replace 10 Const D ReplaceYes C '*YES' D ReplaceNo C '*NO' D ApiErrInfo Like( ApiErr ) D ChgUsrSpcAttr PR ExtPgm( 'QUSCUSAT' ) D RetdLibName 10 D QlUsrSpcName 20 Const D AttrToChg Like( EnableAutoExtendDs ) D Const D ApiErrInf Like( ApiErr ) D DltUsrSpc PR ExtPgm( 'QUSDLTUS' ) D QlUsrSpcName 20 Const D ApiErrInfo Like( ApiErr ) D AddrOfUsrSpc PR ExtPgm( 'QUSPTRUS' ) D QlUsrSpcName 20 Const D PtrToUsrSpc * D ApiErrInfo Like( ApiErr ) D As400ObjFound PR N D QlObjName 20 Value D ObjType 10 Value D SndRpyMsg PR ExtPgm( 'QMHSNDRM' ) D SndMsgKey 4 Const D SndQualMsgq 20 Const D SndRpyMsgTxt 100 Const D SndRpyMsgLen 10I 0 Const D SndRmvMsg 10 Const D ApiErrInf Like( ApiErr ) D LstMsgsFrmQ PR ExtPgm( 'QMHLSTM' ) D QlUsrSpcName 20 Const D FmtName 8 Const D LSTM0100 C 'LSTM0100' D MsgSltInf Like( MsgSltInfo ) D Const D SizeOfMsgSltInf... D 10I 0 Const D FmtOfMsgSltInf... D 8 Const D MSLT0100 C 'MSLT0100' D ApiErrInf Like( ApiErr ) * Other program data D RetdLibName S 10 D EnableAutoExtendDs... D DS D NumFlds 10I 0 Inz( 1 ) D KeyForAutoExtend... D 10I 0 Inz( 3 ) D LengthOfData 10I 0 Inz( 1 ) D AutoExtendVal 1 Inz( '1' ) D ApiErr DS D AeBytesProv 10I 0 Inz( %Size( ApiErr ) ) D AeBytesAvl 10I 0 D AeMsgId 7 D 1 D AeMsgDta 256 D MsgSltInfo DS D MsiMaxMsgsReq 10I 0 Inz( -1 ) D MsiListDirection... D 10 Inz( '*NEXT' ) D MsiSelectionCriterion... D 10 Inz( '*MNR' ) D MsiSevCriterion... D 10I 0 Inz( *Zero ) D MsiMaxMsgLen 10I 0 Inz( 112 ) D MsiMaxHlpLen 10I 0 Inz( 4 ) D MsiOffstToQlMsgqName... D 10I 0 D MsiOffstToStrMsgKey... D 10I 0 D MsiNumMsgQs 10I 0 Inz( 1 ) D MsiOffstToFldRetdId... D 10I 0 D MsiNumFldsToReturn... D 10I 0 Inz( 3 ) D MsiQlMsgqName 20 D MsiStrMsgKey 4 Inz( X'00000000' ) D MsiFldRetdId 10I 0 Inz( 302 ) D MsiFldRetdId1 10I 0 Inz( 601 ) D MsiFldRetdId2 10I 0 Inz(1001 ) D UsrSpcHdr DS Based( SpcPtr ) D OffstTo1stSpcEntry... D 125 128I 0 D NumberOfMsgs 133 136I 0 D UsrSpcEntry DS Based( UsePtr ) D UseOffstToNxtEntry... D 1 4I 0 D UseOffstToFldsReturned... D 5 8I 0 D UseMsgId 17 23 D UseMsgType 24 25 D UseMsgKey 26 29 D UseMsgF 30 39 D UseMsgFLib 40 49 D UseMsgQ 50 59 D UseMsgQLib 60 69 D RetdFldsDs DS Based( RetdFldsDsPtr ) D NextFldRtnOfs 1 4I 0 D Rf1stLvlTxtLen... D 29 32I 0 D Rf1stLvlTxt 33 144 D ScMsgId S 7 D ScMsgType S 2 D ScMsgKey S 4 D ScJob S 10 D ScUsr S 10 D ScNbr S 6 D ScJobSts S 10 D ScRpySts S 1 D Sc1stLvl S 112 D dftRpyValueErr S N D main PR ExtPgm('AUTORPY') D qualMsgqName 20 D rpyMsgid 7 D rpyMsgValue 32 D rpyToJob 10 D main PI D qualMsgqName 20 D rpyMsgid 7 D rpyMsgValue 32 D rpyToJob 10 C Eval MsiQlMsgqName = qualMsgQName C CallP As400ObjFound( MsiQlMsgqName: C '*MSGQ' ) * Set offset fields in the Msi data structure C Eval MsiOffstToQlMsgqName C = %Addr( MsiQlMsgqName ) C - %Addr( MsgSltInfo ) C Eval MsiOffstToStrMsgKey C = %Addr( MsiStrMsgKey ) C - %Addr( MsgSltInfo ) C Eval MsiOffstToFldRetdId C = %Addr( MsiFldRetdId ) C - %Addr( MsgSltInfo ) C ExSr LoadUsrSpc C ExSr ProcessMsgs C Eval *INLR = *On * = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * LoadUsrSpc - Creates and then loads the user space with the * 1st level text of all messages in the specified * message queue. C LoadUsrSpc BegSr * Just to be on the safe side, delete the user space before * attempting to create it. C CallP DltUsrSpc( 'MSGSPC QTEMP': ApiErr ) C CallP CrtUsrSpc( 'MSGSPC QTEMP': C *Blank: C 25000: C X'00': C '*ALL': C *Blank: C ReplaceYes: C ApiErr ) * If there was an error in the API, terminate the subroutine C If AeBytesAvl > *Zero C CallP SndEscMsg( AeMsgId C : 'QCPFMSG' C : %Subst( AeMsgDta: 1: AeBytesAvl-16 ) C ) C LeaveSr C EndIf * Turn on the autoextend attribute for this user space C CallP ChgUsrSpcAttr( RetdLibName: C 'MSGSPC QTEMP': C EnableAutoExtendDs: C ApiErr ) * If there was an error in the API, terminate the subroutine C If AeBytesAvl > *Zero C LeaveSr C EndIf * Populate the user space with the messages C CallP LstMsgsFrmQ( 'MSGSPC QTEMP': C LSTM0100: C MsgSltInfo: C %Size( MsgSltInfo ): C MSLT0100: C ApiErr ) * If there was an error in the API, terminate the subroutine C If AeBytesAvl > *Zero C CallP SndEscMsg( AeMsgId C : 'QCPFMSG' C : %Subst( AeMsgDta: 1:AeBytesAvl- 16 ) C ) C LeaveSr C EndIf * Get a pointer to the user space C CallP AddrOfUsrSpc( 'MSGSPC QTEMP': C SpcPtr: C ApiErr ) * If there was an error in the API, terminate the subroutine C If AeBytesAvl > *Zero C CallP SndEscMsg( AeMsgId C : 'QCPFMSG' C : %Subst( AeMsgDta: 1: AeBytesAvl-16 ) C ) C LeaveSr C EndIf C EndSr * = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * ProcessMsgs -- Process messages in the specified message queue C ProcessMsgs BegSr * Set the basing pointer for the User Space Entry for the first * message in the subfile. C Eval UsePtr C = SpcPtr + OffstTo1stSpcEntry C Do NumberOfMsgs * move user space values to screen C Eval ScMsgId = UseMsgId C Eval ScMsgType = UseMsgType C Eval ScMsgKey = UseMsgKey C* ScMsgId dsply * get Message Text C Eval RetdFldsDsPtr C = SpcPtr + UseOffstToFldsReturned C Eval Sc1stLvl C = %Subst( Rf1stLvlTxt: 1: C Rf1stLvlTxtLen ) * get Sender Qualjob C Eval RetdFldsDsPtr C = SpcPtr + NextFldRtnOfs C Eval SCJob C = %Subst( Rf1stLvlTxt: 1: 10) C Eval SCUsr C = %Subst( Rf1stLvlTxt:11: 10) C Eval SCNbr C = %Subst( Rf1stLvlTxt:21: 6) * get message reply status C Eval RetdFldsDsPtr C = SpcPtr + NextFldRtnOfs C Eval SCRpySts C = %Subst( Rf1stLvlTxt: 1: 10) C* ScRpySts dsply C If UseMsgType = '05' and C SCRpySts = 'W' C If UseMsgId = rpyMsgId C ExSr ChkRpyValue C If rpyToJob = *blanks or C (rpyToJob <> *blanks and C ScJob = rpyToJob ) C ExSr RpyMsg C EndIf C EndIf C EndIf C Eval UsePtr = SpcPtr C + UseOffstToNxtEntry C EndDo C EndSr * = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * ChkRpyValue - Check reply value valid or not C ChkRpyValue BegSr c eval dftRpyValueErr = *Off C* How much storage is needed for everything? C callp GetMsg( GetSize :%size(GetSize) C :'RTVM0400' :UseMsgId C : UseMsgF + UseMsgFLib C :' ' :0 C :'*NO' :'*NO' C :ErrorNull) c* Allocate it and then call the API again c eval FmtPtr = %alloc(GetBytAvl) c callp GetMsg( Fmt0400 :GetBytAvl c :'RTVM0400' :UseMsgID c :UseMsgF + UseMsgFLib c :' ' :0 c :'*NO' :'*NO' c :ErrorNull) c* Default replies returned c if rpyMsgValue = '*DFT' c if LenDftRpyR > 0 c eval DftRpyPtr = FmtPtr + OffDftRpy c eval DftRpy = %SubSt(DftRpyE:1:LenDftRpyR) c* DftRpy dsply c eval rpyMsgValue = DftRpy c else c eval dftRpyValueErr = *On c endif c endif c* Any valid replies returned c if NbrVldRpyR > 0 c eval VldRpyPtr = FmtPtr + OffVldRpy c eval VldRpyAryIdx = 1 c reset VldRpyAry c do NbrVldRpyR c* VldRpyE dsply c eval VldRpyAryStr = %trim(VldRpyAryStr) + c ' ' + %trim(VldRpyE) c eval VldRpyAry(VldRpyAryIdx) = VldRpyE c eval VldRpyAryIdx = VldRpyAryIdx + 1 c eval VldRpyPtr = VldRpyPtr + LenVldRpyE c enddo c if Not dftRpyValueErr c lower:upper xlate rpyMsgValue rpyMsgValue c if %lookup(rpyMsgValue: VldRpyAry) = 0 C CallP SndEscMsg( 'CPF9898' C : 'QCPFMSG' C : 'MsgId: ' + UseMsgId + C ' reply value ' + %trim(rpyMsgValue) + C ' is not valid, valid reply value is '+ C %trim(VldRpyAryStr) C ) c endif c else C CallP SndEscMsg( 'CPF9898' C : 'QCPFMSG' C : 'MsgId: ' + UseMsgId + C ' reply value ' + %trim(rpyMsgValue) + C ' is not valid, no default reply' + C ' setting, valid reply value is '+ C %trim(VldRpyAryStr) C ) c endif C endif C EndSr * = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * C RpyMsg BegSr C C CALLP SndRpyMsg ( SCMsgKey : C MsiQlMsgqName : C %trim(rpyMsgValue): C %len(%trim(rpyMsgValue)): C '*NO' : C ApiErr) * If there was an error in the API, terminate the subroutine C If AeBytesAvl > *Zero C* AeMsgId DSPLY C CallP SndEscMsg( AeMsgId C : 'QCPFMSG' C : %Subst( AeMsgDta: 1 ) C ) C Else C Callp SndCmpMsg( C 'MsgId:' + rpyMsgId + ' replied to job'+ C ' ' + %trim(SCNbr) + '/' + %trim(SCUSr)+ C '/' + %trim(SCJob) + ' with value ' + C %trim(rpyMsgValue) + '.' C ) C EndIf C C EndSr * = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * = * As400ObjFound - Attempts to locate an AS/400 object P As400ObjFound B D As400ObjFound PI N D QlObjName 20 Value D ObjType 10 Value * Local variables and prototypes D RtvObjDesc PR ExtPgm( 'QUSROBJD' ) D RcvrVar 8 D LenRcvrVar 10I 0 Const D FmtName 8 Const D QlObjName 20 Const D ObjType 10 Const D ApiErrInf Like( ApiErr ) D ApiErr DS D AeBytesProv 10I 0 Inz( %Size( ApiErr ) ) D AeBytesAvl 10I 0 D AeMsgId 7 D 1 D AeMsgDta 256 D Rcvr S 8 * Invoke the QUSROBJD API to attempt to locate the object C CallP RtvObjDesc( Rcvr: C %Size( Rcvr ): C 'OBJD0100': C QlObjName: C ObjType: C ApiErr ) * If the API returns any error at all, I assume we were unable to * locate the object. C If AeBytesAvl > *Zero C CallP SndEscMsg( AeMsgId C : 'QCPFMSG' C : %Subst( AeMsgDta: 1:AeBytesAvl- 16 ) C ) C Return *Off C Else C Return *On C EndIf P As400ObjFound E **-- Send escape message: ----------------------------------------------** P SndEscMsg B D Pi 10i 0 D PxMsgId 7a Const D PxMsgF 10a Const D PxMsgDta 512a Const Varying ** D MsgKey s 4a C Callp SndPgmMsg( PxMsgId C : PxMsgF + '*LIBL' C : PxMsgDta C : %Len( PxMsgDta ) C : '*ESCAPE' C : '*PGMBDY' C : 1 C : MsgKey C : ApiErr C ) C If AeBytesAvl > *Zero C Return -1 C C Else C Return 0 C EndIf P SndEscMsg E **-- Send completion message: ------------------------------------------** P SndCmpMsg B D Pi 10i 0 D PxMsgDta 512a Const Varying D MsgKey s 4a C Callp SndPgmMsg( 'CPF9897' C : 'QCPFMSG *LIBL' C : PxMsgDta C : %Len( PxMsgDta ) C : '*COMP' C : '*PGMBDY' C : 1 C : MsgKey C : ApiErr C ) C If AeBytesAvl > *Zero C Return -1 C C Else C Return 0 C EndIf ** P SndCmpMsg E
File : QCMDSRC Member : AUTORPY Type : CMD Usage : CRTCMD CMD(AUTORPY) PGM(AUTORPY)
/* =============================================================== */ /* = Command....... AutoRpy = */ /* = CPP........... AutoRpy RPGLE = */ /* = Description... Auto reply to the sender of an inquiry = */ /* = message. = */ /* = = */ /* = CrtCmd Cmd( AutoRpy ) = */ /* = Pgm( AutoRpy ) = */ /* = SrcFile( YourSourceFile ) = */ /* =============================================================== */ /* = Date : 2008/09/09 = */ /* = Author: Vengoal Chang = */ /* =============================================================== */ CMD PROMPT('Auto Reply') PARM KWD(MSGQ) TYPE(QUAL2) MIN(1) PROMPT('Message + queue') PARM KWD(MSGID) TYPE(*CHAR) LEN(7) PROMPT('Reply + message id') PARM KWD(REPLY) TYPE(*CHAR) LEN(32) DFT(*DFT) + SPCVAL((*DFT)) PROMPT('Reply') PARM KWD(LMTRPYJOB) TYPE(*NAME) LEN(10) + PROMPT('Reply to job') QUAL2: QUAL TYPE(*NAME) EXPR(*YES) QUAL TYPE(*NAME) DFT(*LIBL) SPCVAL((*LIBL) + (*CURLIB)) EXPR(*YES) PROMPT('Library') Test Step: 1. CRTMSGF QGPL/TESTMSGF /* Add message id with no default reply value */ ADDMSGD MSGID(TST0001) MSGF(QGPL/TESTMSGF) MSG(TEST_001) SEV(99) VALUES(C D R I) /* Add message id with default reply value */ ADDMSGD MSGID(TST0002) MSGF(QGPL/TESTMSGF) MSG(TEST_001) SEV(99) VALUES(C D R I) DFT(C) 2. AUTORPYT1 CLP: PGM DCL &CURUSR *CHAR 10 RTVJOBA USER(&CURUSR) SNDUSRMSG MSGID(TST0001) MSGF(QGPL/TESTMSGF) + TOUSR(&CURUSR) ENDPGM AUTORPYT2 CLP: PGM DCL &CURUSR *CHAR 10 RTVJOBA USER(&CURUSR) SNDUSRMSG MSGID(TST0002) MSGF(QGPL/TESTMSGF) + TOUSR(&CURUSR) ENDPGM 3. Compile AUTORPYT1, AUTORPYT2 4. for example use USER01 subbmit job SBMJOB CMD(CALL AUTORPYT1) JOB(JOB1) SBMJOB CMD(CALL AUTORPYT2) JOB(JOB2) 5. DSPMSG USER01 Display Messages System: DDSC810 Queue . . . . . : USER01 Program . . . . : *DSPMSG Library . . . : QUSRSYS Library . . . : Severity . . . : 00 Delivery . . . : *HOLD Type reply (if required), press Enter. Job 690946/USER01/JOB2 completed normally on 09/09/08 at 15:17:58. Job 690962/USER01/JOB1 completed normally on 09/09/08 at 15:17:58. TEST 0001 Reply . . . Waiting for reply to message on message queue USER01. TEST_002 Reply . . . Waiting for reply to message on message queue USER01. 6. AUTORPY MSGQ(USER01) MSGID(TST0001) MSGID TST001 does not set default reply value,so we got following message : Additional Message Information Message ID . . . . . . : CPF9898 Severity . . . . . . . : 40 Message type . . . . . : Information Date sent . . . . . . : 09/09/08 Time sent . . . . . . : 15:19:26 Message . . . . : MsgId: TST0001 reply value *DFT is not valid, no default reply setting, valid reply value is C D E F. Cause . . . . . : This message is used by application programs as a general escape message. 7. AUTORPY MSGQ(USER01) MSGID(TST0001) REPLY(C) Got following message: Additional Message Information Message ID . . . . . . : CPF9897 Severity . . . . . . . : 40 Message type . . . . . : Information Date sent . . . . . . : 09/09/08 Time sent . . . . . . : 15:22:06 Message . . . . : MsgId:TST0001 replied to job 690963/USER01/JOB1 with value C. Cause . . . . . : No additional online help information is available. 7.1 DSPMSG USER01 Display Messages System: DDSC810 Queue . . . . . : USER01 Program . . . . : *DSPMSG Library . . . : QUSRSYS Library . . . : Severity . . . : 00 Delivery . . . : *HOLD Type reply (if required), press Enter. Job 690946/USER01/JOB2 completed normally on 09/09/08 at 15:17:58. Job 690962/USER01/JOB1 completed normally on 09/09/08 at 15:17:58. TEST 0001 Reply . . : C Waiting for reply to message on message queue USER01. TEST_002 Reply . . . Waiting for reply to message on message queue USER01. Job 690963/VENGOAL/JOB1 completed normally on 09/09/08 at 15:22:06. 8. AUTORPY MSGQ(USER01) MSGID(TST0002) REPLY(RR) <== Reply TST002 message with wrong value Got following message: Additional Message Information Message ID . . . . . . : CPF9898 Severity . . . . . . . : 40 Message type . . . . . : Information Date sent . . . . . . : 09/09/08 Time sent . . . . . . : 15:26:54 Message . . . . : MsgId: TST0002 reply value RR is not valid, valid reply value is C D R I. Cause . . . . . : This message is used by application programs as a general escape message. 9. AUTORPY MSGQ(USER01) MSGID(TST0002) JOB(JOB3) Because we just submitted JOB1,JOB2, the TST0002 still isn't replied. DSPMSG USER01 will got same step 7.1 result. 10. AUTORPY MSGQ(USER01) MSGID(TST0002) LMTRPYJOB(JOB2) Got following message: Additional Message Information Message ID . . . . . . : CPF9897 Severity . . . . . . . : 40 Message type . . . . . : Information Date sent . . . . . . : 09/09/08 Time sent . . . . . . : 15:34:13 Message . . . . : MsgId:TST0002 replied to job 690965/USER01/JOB2 with value C. Cause . . . . . : No additional online help information is available. 10.1 DSPMSG USER01 Display Messages System: DDSC810 Queue . . . . . : USER01 Program . . . . : *DSPMSG Library . . . : QUSRSYS Library . . . : Severity . . . : 00 Delivery . . . : *HOLD Type reply (if required), press Enter. Job 690946/USER01/JOB2 completed normally on 09/09/08 at 15:17:58. Job 690962/USER01/JOB1 completed normally on 09/09/08 at 15:17:58. TEST 0001 Reply . . : C Waiting for reply to message on message queue USER01. TEST_002 Reply . . : C Waiting for reply to message on message queue USER01. Job 690963/USER01/JOB1 completed normally on 09/09/08 at 15:22:06. Job 690965/USER01/JOB2 completed normally on 09/09/08 at 15:34:13.


Thanks to Vengoal Chang
Back

Web Server - Kill a job immediately

I found it useful enough to write a little cmd KILLJOB JOB(XXX) (an API can retrieve
the PID of any job).
This comes in handy when needing to reboot the server when promoting a application or
when there's trouble.
Since the ENDTCPSVR cmd won't complete if it's on a msg wait, this is a way to end it
unilaterally from an automated job.

CMD PROMPT('Kill a job immediately') PARM KWD(JOB) TYPE(*NAME) PROMPT('Job name') _________________________________________________________ PGM (&JOBNAM) DCL VAR(&JOBNAM) TYPE(*CHAR) LEN(10) DCL VAR(&USRNAM) TYPE(*CHAR) LEN(10) DCL VAR(&JOBNBR) TYPE(*CHAR) LEN(6) DCL VAR(&JOBVAR) TYPE(*CHAR) LEN(26) DCL VAR(&JOBSTS) TYPE(*CHAR) LEN(10) DCL VAR(&SPCNAM) TYPE(*CHAR) LEN(10) DCL VAR(&SPCLIB) TYPE(*CHAR) LEN(10) DCL VAR(&USRSPC) TYPE(*CHAR) LEN(20) DCL VAR(&BIN4) TYPE(*CHAR) LEN(4) DCL VAR(&SPCTXT) TYPE(*CHAR) LEN(50) DCL VAR(&APIERR) TYPE(*CHAR) LEN(256) + VALUE(X'0000000000000000') DCL VAR(&LENDTA) TYPE(*CHAR) LEN(4) DCL VAR(&STRPOS) TYPE(*CHAR) LEN(4) DCL VAR(&KEYCNT) TYPE(*CHAR) LEN(4) DCL VAR(&KEYFLD) TYPE(*CHAR) LEN(4) DCL VAR(&LSTPOS) TYPE(*DEC) LEN(9) DCL VAR(&LSTSIZ) TYPE(*DEC) LEN(9) DCL VAR(&S) TYPE(*DEC) LEN(9) DCL VAR(&COUNT) TYPE(*DEC) LEN(9) DCL VAR(&LSTCNT) TYPE(*DEC) LEN(9) DCL VAR(&RCVAPI) TYPE(*CHAR) LEN(140) DCL VAR(&LIST) TYPE(*CHAR) LEN(256) DCL VAR(&QJOBL) TYPE(*CHAR) LEN(26) DCL VAR(&DEC9) TYPE(*DEC) LEN(9) DCL VAR(&PID) TYPE(*CHAR) LEN(11) DCL VAR(&NOT1ST) TYPE(*LGL) MONMSG CPF0000 EXEC(GOTO ERROR) CHGVAR %SST(&JOBVAR 01 10) &JOBNAM CHGVAR %SST(&JOBVAR 11 10) '*ALL' CHGVAR %SST(&JOBVAR 21 6) '*ALL' CHGVAR &JOBSTS '*ACTIVE' /* Create 2K user space using the create space API QUSCRTUS */ CHGVAR VAR(&SPCNAM) VALUE(QUSLJOB) CHGVAR VAR(&SPCLIB) VALUE(QTEMP) CHGVAR VAR(&USRSPC) VALUE(&SPCNAM *CAT &SPCLIB) CHGVAR VAR(&SPCTXT) VALUE(&SPCNAM) CHGVAR %BIN(&BIN4) 2000 CALL PGM(QUSCRTUS) PARM( + &USRSPC /* NAME OF SPACE */ + &SPCNAM /* EXTENDED NAME ATTRIBUTE */ + &BIN4 /* SIZE OF SPACE */ + ' ' /* INITIAL FILL CHARACTER */ + '*ALL' /* PUBLIC AUTHORITY */ + &SPCTXT /* SPACE TEXT DESCRIPTION */ + '*YES' /* REPLACE CURRENT SPACE */ + &APIERR) /* ERROR RETURN FIELD */ CHGVAR %BIN(&KEYCNT) 1 CHGVAR %BIN(&KEYFLD) 1608 /* Fill user space with job information using list API QUSLJOB */ CALL PGM(QUSLJOB) PARM( + &USRSPC /* NAME OF SPACE */ + 'JOBL0200'/* FORMAT OF JOB INFORMATION */ + &JOBVAR /* QUALIFIED JOB NAME */ + &JOBSTS /* JOB STATUS SELECTION */ + &APIERR /* ERROR RETURN FIELD */ + '*' /* JOB TYPE SELECTION */ + &KEYCNT /* NBR OF FIELDS RETURNED */ + &KEYFLD) /* NBR OF FIELDS RETURNED */ /* Get API list structure using retrieve API QUSRTVUS */ /* This data structure extends 140 bytes from position 1 */ CHGVAR &S 1 CHGVAR %BIN(&STRPOS) &S CHGVAR %BIN(&LENDTA) 140 CALL PGM(QUSRTVUS) PARM( + &USRSPC /* NAME OF SPACE */ + &STRPOS /* RETRIEVE FROM POSITION IN SPACE */ + &LENDTA /* LENGTH OF STRUCTURE RETRIEVED */ + &RCVAPI) /* RECEIVING FIELD */ /* Retrieve each list entry using the retrieve API QUSRTVUS */ CHGVAR &LSTPOS %BIN(&RCVAPI 125 4) /* Offset to 1st list entry */ CHGVAR &LSTCNT %BIN(&RCVAPI 133 4) /* No. of list entries */ CHGVAR &LSTSIZ %BIN(&RCVAPI 137 4) /* Size of each list entry */ /* Increment start position by offset to 1st list entry */ CHGVAR &S (&S + &LSTPOS) CHGVAR %BIN(&LENDTA) &LSTSIZ RTVLIST: CHGVAR VAR(&COUNT) VALUE(&COUNT + 1) IF (&COUNT *GT &LSTCNT) GOTO ENDLIST CHGVAR %BIN(&STRPOS) &S CALL PGM(QUSRTVUS) PARM( + &USRSPC /* NAME OF SPACE */ + &STRPOS /* RETRIEVE FROM POSITION IN SPACE */ + &LENDTA /* LENGTH OF STRUCTURE RETRIEVED */ + &LIST) /* RECEIVING FIELD */ CHGVAR &DEC9 %BIN(&LIST 81 4) CHGVAR &PID &DEC9 CHGVAR &USRNAM %SST(&LIST 11 10) CHGVAR &JOBNBR %SST(&LIST 21 6) SNDPGMMSG MSGID(CPI8859) MSGF(QCPFMSG) MSGDTA('Kill + job' *BCAT &JOBNBR *TCAT '/' *CAT &USRNAM + *TCAT '/' *CAT &JOBNAM *BCAT 'PID=' *CAT + &PID) TOPGMQ(*EXT) MSGTYPE(*STATUS) CALL QP2SHELL2 ('/QOpensys/usr/bin/kill' '-s' 'kill' &PID) /* Increment start position by length of list entry */ CHGVAR &S (&S + &LSTSIZ) GOTO RTVLIST ENDLIST: /* Delete user space using space API QUSDLTUS */ CALL PGM(QUSDLTUS) PARM( + &USRSPC /* NAME OF SPACE */ + &APIERR) /* ERROR RETURN FIELD */ /* Move pgm messages to previous pgm message queue */ CALL PGM(QMHMOVPM) PARM(' ' '*COMP ' + X'00000001' '*' X'00000001' X'0000000000000000') RETURN ERROR: IF &NOT1ST RETURN CHGVAR &NOT1ST '1' /* Move pgm messages to previous pgm message queue */ CALL PGM(QMHMOVPM) PARM(' ' '*DIAG *ESCAPE ' + X'00000002' '*' X'00000001' X'0000000000000000') ENDPGM

Thanks to Peter Connell
Back

Searching Multi-Member Files without PDM

Q: I tried using Grep through Qshell, but that only seems to work with IFS and Source
Physical Files and not "ordinary" multi-member files.

Does anybody have any ideas on how I can find the member containing the invoice number?
As it's a clients production machine I don't have access to compilers, etc, to write any programs.


A: Easy! Use the CPYF command. Here is an example using JDE file F4211. I know that the invoice number is an 8-digit signed numeric, found in position 696. I just created a copy of this file in QTEMP with two members. To find invoice number 13, I executed the following command: CPYF FROMFILE(QTEMP/F4211) TOFILE(*PRINT) FROMMBR(*ALL) INCCHAR(*RCD 696 *EQ X'F0F0F0F0F0F0F1F3') The output is not pretty, but it shows me the two records (one from each member) that have invoice # 13...


Thanks to "sjl"
Back

What's With These ASCII, EBCDIC, Unicode CCSIDs

Bruce Vining made this PDF document. Take a view or download the document here:

The PDF document


Thanks to Bruce Vining
Back

Suppress display in STRQSH

Q:
How do I suppress the "Press ENTER to end terminal session." when I do the following?
STRQSH CMD('DB2 "update rob.aaakey set coname=''c'' where loc=''a''"')

A: 1) ADDENVVAR ENVVAR(QIBM_QSH_CMD_OUTPUT) VALUE(NONE) I think that will do it...

2) Try: CRTPF FILE(QTEMP/TEMP) RCDLEN(80) OVRDBF FILE(STDOUT) TOFILE(QTEMP/TEMP)

3) With this example your output will be disabled: PGM DCL VAR(&QSHCMD) TYPE(*CHAR) LEN(1000) DCL VAR(&CLASSP) TYPE(*CHAR) LEN(1000) CHGVAR VAR(&CLASSP) + VALUE(".:/:/QIBM/ProdData/Http/Public/jt400+ /lib/jt400Access.zip:/QIBM/ProdData/Http/Pu+ blic/jt400/lib/jt400.jar") ADDENVVAR ENVVAR(CLASSPATH) VALUE(&CLASSP) MONMSG MSGID(CPFA980) EXEC(DO) CHGENVVAR ENVVAR(CLASSPATH) VALUE(&CLASSP) ENDDO ADDENVVAR ENVVAR(QIBM_QSH_CMD_OUTPUT) VALUE(NONE) MONMSG MSGID(CPFA980) EXEC(DO) CHGENVVAR ENVVAR(QIBM_QSH_CMD_OUTPUT) VALUE(NONE) ENDDO ADDENVVAR ENVVAR(QIBM_MULTI_THREADED) VALUE('Y') MONMSG MSGID(CPFA980) EXEC(DO) CHGENVVAR ENVVAR(QIBM_MULTI_THREADED) VALUE('Y') ENDDO CHGVAR VAR(&QSHCMD) VALUE('java -Djava.version=1.2 + xvr.app.sip.ba.poolspa.data.as400.APIProduc+ cionPedido') QSH CMD(&QSHCMD) END: ENDPGM
Thanks to Crispin Bates, Sean McGovern and "unknown"

Back

iSeries Ops Navigator auto-start...?

Q:
We have a need [ok, maybe more of a pressing desire] to be able to auto-open
ISeries Navigator to a specific IFS folder.  Is it possible?
I don't see where I can use any command-line options/switches to get us there.
It was easy to have a scheduled job auto-run cwbunnav.exe, but we'd love to take
it a step or two further.  Thanks.

A: I'm using following VB script you also can copy the same to TEXT file and save it as VBS change the necessary places as needed. ' -------------------------------------------------------------------------- ' Script to create a shortcut for Western Union data upload ' By : Chamara Withanachchi ' date : 2009/03/16 ' This use the WSHShell object to create a shortcut on the desktop. ' -------------------------------------------------------------------------- L_Welcome_MsgBox_Message_Text = "This script will create a shortcut to Western Union Upload." L_Welcome_MsgBox_Title_Text = "CHAMARA" L_Message = "Please enter Branch Code" Call Welcome() Dim Result ' * ' * Shortcut related methods. ' * Dim WSHShell Dim objNetwork Dim strDriveLetter, strRemotePath,user,pass Set WSHShell = WScript.CreateObject("WScript.Shell") Dim MyShortcut, MyDesktop, DesktopPath ' Read desktop path using WshSpecialFolders object DesktopPath = WSHShell.SpecialFolders("Desktop") strDriveLetter = "J:" strRemotePath = "\\10.10.13.200\wupload" user = "ABCD" pass = "ABCD" Set objNetwork = CreateObject("WScript.Network") ' Create a shortcut object on the desktop Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & "\Western Union " + result + ".lnk") ' Map Network On Error Resume Next objNetwork.MapNetworkDrive strDriveLetter, strRemotePath, FALSE, user, pass If (Err.Number <> 0) Then On Error GoTo 0 objNetwork.RemoveNetworkDrive strDriveLetter, True, True objNetwork.MapNetworkDrive strDriveLetter, strRemotePath, FALSE, user, pass End If On Error GoTo 0 ' Set shortcut object properties and save it MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings("\\10.10.13.200\wupload\WU_" + result) MyShortcut.WorkingDirectory = WSHShell.ExpandEnvironmentStrings("\\10.10.13.200\wupload\WU_" + result) MyShortcut.WindowStyle = 4 MyShortcut.Save WScript.Echo "A shortcut to WU now exists on your Desktop." ' Welcome Subroutine to display main Screen Sub Welcome() Dim intDoIt intDoIt = MsgBox(L_Welcome_MsgBox_Message_Text, _ vbOKCancel + vbInformation, _ L_Welcome_MsgBox_Title_Text ) If intDoIt = vbCancel Then WScript.Quit End If Result = InputBox(L_Message,L_Welcome_MsgBox_Title_Text," ") If result = "" Then WScript.Quit End If End Sub
Thanks to Chamara Withanachchi

Back

Difference between CCSID 65535 and CCSID 37

Q:
If someone who uses a different CCSID (such as someone using
a German, British, French, Russian, etc, terminal) needs this
data, automatically translate it from the USA type of EBCDIC
to the one they need.

A: Here are a few scenarios: 1. System A has sent System B a *SAVF containing a file CCSID tagged 37 (United States). System B restores the file and a job running under CCSID 297 (France) reads a record containing the CCSID 37 encoded character # (x'7B'). The system will automatically convert the CCSID 37 encoded x'7B' to x'B1' - the # in France. 2. System A has sent System B a *SAVF containing a file CCSID tagged 37 (United States). System B restores the file and a job running under CCSID 65535 (Hex) reads a record containing the CCSID 37 encoded character # (x'7B'). The system will not automatically convert the CCSID 37 encoded x'7B' due to the 65535 CCSID being involved. The user, if using a terminal configured with CCSID 297, will "see" the £ character (x'7B' in CCSID 297). 3. A user on System B, with a terminal configured using CCSID 297, passes through to System A to run an interactive application. The application on System A runs with a job CCSID of 297 while using CCSID 37 tagged databases. The user reads a record containing the # of scenario 1 above. The user "sees" the # correctly on their terminal. 4. A user on System B, with a terminal configured using CCSID 297, passes through to System A to run an interactive application. The application on System A runs with a job CCSID of 65535 while using CCSID 37 tagged databases. The user reads a record containing the # of scenario 1 above. The user "sees" the £ on their terminal. 5. A user on System B, with a terminal configured using CCSID 297, passes through to System A to run an interactive application. The application on System A runs with a job CCSID of 37 and the *DSPF is created with the default CHRID(*DEVD) which is essentially a *DSPF's way of saying 65535. The user reads a record containing the # of scenario 1 above. The user "sees" the £ on their terminal. 6. A user on System B, with a terminal configured using CCSID 297, passes through to System A to run an interactive application. The application on System A runs with a job CCSID of 37 and the *DSPF is created with CHRID(*JOBCCSID) or equivalent. The user reads a record containing the # of scenario 1 above. The user "sees" the # correctly on their terminal. You might notice that with 65535 involved the user consistently "sees" the wrong character in a multi-lingual environment if the character happens to be variant.
Thanks to Bruce Vining

Back

Testing the Qshell QzshSystem API

Q:
What I see is using an API to initiate QSH instead of just running QSH directly.
I can see the incredible usefulness of this from within RPG or C.  But, what is
the advantage from within CLE?

A: I'm not good at explanation. And being so much an IBM RPG/COBOL kind of programmer, the world of Unix and C is often foreign to me. File descriptors, library functions, shell operations -- they're like speaking a foreign language during the time before learning to think in the language. So, I'll post a basic example in the Midrange code repository-- The example code is all ILE CL. A service program is used for the procs to open and close the file descriptors used by the API, to make the example API code stay focused on the API itself. The program itself makes three consecutive calls to the API for three different uses. The code is kept pretty simple. It's also written at V5R3 since I won't be able to upgrade my system to V5R4 for a while, so it doesn't go as far as it could. The purpose is to investigate the meaning of the file descriptors used for the API and how they relate to the /concepts/ of stdin, stdout & stderr. The file descriptors are used by the API, but they're shown to be not quite the same as "STDIN", "STDOUT" & "STDERR". This is demonstrated by the overrides to STDOUT & STDERR, and the different program outputs that result -- into the streamfiles within the API, but into the QPRINT printer files by the C library functions even while they intermix with the API. The program runs as ACTGRP(*NEW) just to make the printer file output more accessible when run interactively. Multiple calls to the API continue to use the same descriptors in the example. This isn't required -- each call can have a new set if desired. The example doesn't do anything useful; it simply shows how to call the API while creating a couple forms of output. STRQSH can be much easier to use; the API helps make some stuff more visible on how it works on System i.
Thanks to Tom Liotta

Back

Basic CGIDEV2 problem

Q:
I wish I fully understood all those Alias and ScriptAliasMatch lines, though.

A: Alias, AliasMatch, ScriptAlias and ScriptAliasMatch aren't too hard to understand. I'll try to explain them, but please ask questions if you still don't understand. BACKGROUND ---------- When you configure Apache, you give it a DocumentRoot. This is an IFS pathname to the start of your web server. In the simplest configuration, everything on your server would be under DocumentRoot. So you might have this: DocumentRoot /www/myserver/htdocs HTTP was designed for fetching documents (originally, that's all you could do, just fetch a document, nothing else). So a browser would code something like this: http://www.example.com/mydir/mydoc.html This tells the browser (a) use the http protocol. (b), connect to www.example.com, and (c) ask for the document named /mydir/mydoc.html Apache will get that request, but it'll add the DocumentRoot to it. So the actual IFS path to the document will be /www/myserver/htdocs/mydir/mydoc.html That's the simplest behavior. It lets you designate some part of your IFS (DocumentRoot) where all subfolders will be accessible via URLs. That's the basic configuration. ALIAS ----- What if you want something OUTSIDE of that area to be accessible to the browser? How would you do it? You declare an Alias. DocumentRoot /www/myserver/htdocs Alias /foo /home/scott/bar This says that all URLs go under /www/myserver/htdocs, just as in the previous example... EXCEPT for /foo. Any URL starting with /foo will point to /home/scott/bar So this works just as it did before: http://www.example.com/mydir/mydoc.html But this works differently. http://www.example.com/foo/mydir/mydoc.html In this second case, the /foo is an alias for /home/scott/foo, so the URL points to /home/scott/bar/mydir/mydoc.html. That's all an alias does. It provides a way to specify directories in the URL that are "redirected" to another area of the IFS, outside of the document root. ALIASMATCH ---------- AliasMatch does the same thing that Alias does, except it allows "wildcards" (technically... Regular Expressions.) For example, I could do something like this: AliasMatch /foo/(.*jpg) /images/jpg/foo/$1 In a regular expression, a single dot matches any one character. An asterisk says "zero or more of the preceding character". So when you have .* it matches any number of any character. In this example, any URL that begins with /foo/ and ends with jpg will match the alias. In Apache, the parenthesis designate a section of the URL o be copied to the resulting URL. So in this example, the /foo/ is not in parenthesis, but the .*jpg is. So whatever matches the wildcard of .*jpg will be considered "variable number 1". You'll notice the result is /images/jpg/foo/$1 -- that $1 will be replaced at runtime with whatever matched the .*jpg pattern. Example: http://www.example.com/foo/goofy/scott_dancing.jpg Once the hostname is removed, it starts with /foo/ and ends with jpg, so it matches the Alias. The (.*jpg) part will match goofy/scott_dancing.jpg, so Apache will access the /images/jpg/foo/goofy/scott_dancing.jpg file in the IFS FWIW, I tend to avoid AliasMatch (or ScriptAliasMatch) since they run slower, and IMHO, they're more complicated than I need for my projects. SCRIPTALIAS ----------- If you understood Alias, then ScriptAlias should be easy. There's really only one difference. Alias is for fetching a document... it tells Apache which document in the IFS to fetch. By contrast, ScriptAlias is for running a script or program. Instead of downloading the program object to the browser (that's what Alias would do), ScriptAlias tells Apache to run the program. The output of the program will be sent to the browser, instead of downloading the program object itself. Without ScriptAlias: DocumentRoot /www/myserver/htdocs http://www.example.com/qgpl/pmu010.pgm This tells Apache to go to the /www/myserver/htdocs/qgpl directory and download a program named pmu010.pgm to the browser. With ScriptAlias: DocumentRoot /www/myserver/htdocs ScriptAlias /qgpl /QSYS.LIB/QGPL.LIB http://www.example.com/qgpl/pmu010.pgm Hopefully you already understand that /QSYS.LIB in the IFS provides access to your traditional libraries and their contents. With that in mind, Apache will build the IFS pathname of /QSYS.LIB/QGPL.LIB/PMU010.PGM and it will therefore be equivalent of CALL PGM(QGPL/PMU010) SCRIPTALIASMATCH ---------------- Same as ScriptAlias, except it now has regular expressions ("wildcards") available. ScriptAliasMatch is to ScriptAlias what AliasMatch is to Alias. The installer for CGIDEV2 likes to set things up like this: ScriptAliasMatch /mylibp(.*).pgm /qsys.lib/mylib.lib/$1.pgm AliasMatch /mylibh/(.*)\.htm /QSYS.LIB/MYLIB.LIB/HTMLSRC.FILE/$1.mbr Alias /mylibh/ /QSYS.LIB/MYLIB.LIB/HTMLSRC.FILE/ Alias /mylib/ /mylib/ The ScriptAliasMatch at the top says that any URL that begins with /mylibp and ends with .pgm should be run as a program in /qsys.lib/mylib.lib. Contrast these two statements: ScriptAlias /mylibp /qsys.lib/mylib.lib ScriptAliasMatch /mylibp(.*).pgm /qsys.lib/mylib.lib/$1.pgm In the first case, anything that starts with /mylibp (including files, data areas, queues, user spaces, etc) will be run as a program from the /QSYS.LIB/MYLIB.LIB library. Of course, if you list a program object, no problem, it'll run it. If you list a non-program object, however, Apache will still try to call it (though, it'll fail with an error.) In the second case, only URLs that end in .PGM are called. Apache will forcibly add the .pgm extension to it when it tries to call it. Therefore, non-programs will not match this script alias. Instead, they'll match this one (also from the configs, above) Alias /mylib/ /mylib/ This tells it to go to the /mylib/ folder of the IFS instead of the library. So program objects go to the library, non-program objects go to an IFS folder. If you left off this extra Alias, it would go to the DocumentRoot instead -- and go to /www/myserver/htdocs/mylib. Shrug... I personally prefer to go in and delete the CGIDEV2 provided instructions and insert my own. I don't like the instructions they provide. They're more complicated than they need to be, IMHO. But, anyway... hope this all made sense.
Thanks to Scott Klement

Back

WRKENVVAR - have you checked it today ??

      Prompt WrkEnvVar and select LEVEL(*SYS) and you will see a
      display somewhat like the one from my production system below.
      From there you can add or update your CLASSPATH and it does
      indeed persist. Hope this helps...  Java rocks... ;)

                        Work with Environment Vars (*SYS)

Type options, press Enter.
  1=Add   2=Change   4=Remove   5=Display details   6=Print

Opt  Name                        Value
     JWSDP_HOME                  '/QIBM/UserData/jwsdp-1.6'
     JWSDP_LIBS                  '/QIBM/UserData/jwsdp-1.6/jwsdp-sha' >
     JAXP_LIBS                   '/QIBM/UserData/jwsdp-1.6/jaxp/lib;' >
     JAXR_HOME                   '/QIBM/UserData/jwsdp-1.6/jaxr'
     JAXRPC_HOME                 '/QIBM/UserData/jwsdp-1.6/jaxrpc'
     JAXB_HOME                   '/QIBM/UserData/jwsdp-1.6/jaxb'
     ANT_HOME                    '/QIBM/UserData/jwsdp-1.6/apache-an' >
     ANT_LIBS                    '/QIBM/UserData/jwsdp-1.6/apache-an' >
     CLASSPATH                   '/QIBM/ProdData/OS400/jt400/lib/jt4' >
     PATH                        '/usr/bin:/home/jakarta-tomcat-5.5.' >
                                                                       More...


Thanks to Rick DuVall
Back

CRTSRVPGM with zero signature (EXPORT SYMBOL)

K:
I don't think anyone has been driven crazy by it. In fact, I bet if I
took a poll of all the things that do drive them crazy in their
programming lives it wouldn't register very highly (if at all).

A single hard coded signature works just as well for backward
compatibility as long as you don't mess with the procedure sequence.

S: Maybe it's just me, then. It drove me absolutely bonkers. It was very cumbersome. Just to add to that (because I think this is a common point of confusion) *CURRENT/*PRV _also_ requires that you don't mess with procedure sequence. If you make a mistake with your procedure sequence with _either_ a hard-coded signature _or_ *CURRENT/*PRV the ILE environment won't catch it. I'm sure you already know how this works, Kevin, but I suspect there are others on this list that do not, so I'm going to give a more detailed example: STRPGMEXP PGMLVL(*CURRENT) EXPORT SYMBOL(startSomething) EXPORT SYMBOL(doSomething) EXPORT SYMBOL(finishSomething) ENDPGM The important thing to understand is that ILE calls things by NUMBER. It looks at the above set of procedures, and assigns a number to each (based on the order they are listed in the binder source). So startSomething=1, doSoemthing=2, finishSomething=3. Under the covers, your programs will be calling them by number... call export#1, call export#2, etc. As a side note: The sequence of the procedures in your RPG source member doesn't matter AT ALL. The export numbers are calculated purely from the binder source (above), not from the source member. Now you decide to add a new procedure, and WHOOPS, you add it in the middle instead of the end: STRPGMEXP PGMLVL(*CURRENT) EXPORT SYMBOL(startSomething) EXPORT SYMBOL(doSomething) EXPORT SYMBOL(doSomethingMore) <--- WHOOPS! it's in the middle. EXPORT SYMBOL(finishSomething) ENDPGM STRPGMEXP PGMLVL(*PRV) EXPORT SYMBOL(startSomething) EXPORT SYMBOL(doSomething) EXPORT SYMBOL(finishSomething) ENDPGM IMHO, if ILE were designed correctly, the CRTSRVPGM command would detect that finishSomething has changed from position #4 to position #3 and would warn you. But it doesn't. Existing programs that previously called finishSomething were doing "call export#3". And unless you run UPDPGM or UPDSRVPGM or recreate them completely, they will continue to do "call export#3" -- the problem is, export#3 is no longer the "finishSomething" routine, now it's "doSomethingMore" and you're calling it by mistake! WHOOPS! You're probably thinking "shouldn't I get a signature violation error?" no. you won't, because of the *PRV group. The *PRV group will have the signature you were previously using... so it will let you call it without error. However, *only* the *CURRENT group is used to determine the export numbers. So the fact that finishSomething *used* to be #3 doesn't matter, the system won't detect that it has changed, and it'll let you keep calling #3. So using *CURRENT/*PRV didn't protect you. I'm still wondering under what situation using *CURRENT/*PRV *would* protect you? I haven't found any situation where it would. The *ONLY* way for this to work properly is to do this: STRPGMEXP PGMLVL(*CURRENT) EXPORT SYMBOL(startSomething) EXPORT SYMBOL(doSomething) EXPORT SYMBOL(finishSomething) EXPORT SYMBOL(doSomethingMore) <--- HURRAY! it's on the end. ENDPGM STRPGMEXP PGMLVL(*PRV) EXPORT SYMBOL(startSomething) EXPORT SYMBOL(doSomething) EXPORT SYMBOL(finishSomething) ENDPGM This way, your existing exports aren't renumbered, finishSomething is still export#3. As long as you know this and do it consistently, this will give you backward compatibility. But if you mess it up, it won't catch it. So you're doing the (admittedly minor) work of copying the signature block, and getting no protection for your efforts. My problem is that after I've done this 500 or so times (I'm not exaggerating -- I really do this 500+ times in some srvpgms) you end up with a large, unwieldy source member. That is the part that "drives me crazy." That's perhaps too strong of a term -- but it was deterring me from adding more subprocedures. It didn't make sense to "add just one more procedure" because I'd have to copy the block, so I'd end up putting it off until I had lots of them to add so I could do it all at once and have fewer signature blocks. This wasn't good because it was holding me back. Let's look at a hard-coded signature (my recommendation): Back to the original example, before the change you have the following, the only difference now is that I've added a hard-coded signature: STRPGMEXP SIGNATURE('SRVPGM SIG 1.0 ') EXPORT SYMBOL(startSomething) EXPORT SYMBOL(doSomething) EXPORT SYMBOL(finishSomething) ENDPGM (I'm careful to make my signature 16 chars long, otherwise I get annoying warning messages when I build my srvpgm. It's not required -- I just do it to avoid the extra warning messages. If, WHOOPS, I make a mistake (just as I did with *CURRENT/*PRV) and put it in the middle, I still have the same problem STRPGMEXP SIGNATURE('SRVPGM SIG 1.0 ') EXPORT SYMBOL(startSomething) EXPORT SYMBOL(doSomething) EXPORT SYMBOL(doSomethingMore) <--- WHOOPS! it's in the middle. EXPORT SYMBOL(finishSomething) ENDPGM This creates the exact same problem it did with *CURRENT/*PRV, and exactly like *CURRENT/*PRV the system won't detect it. So I haven't lost anything by switching to a hard coded signature. The only thing I've gained is that I don't have to copy/paste my signature block. Just as with the *CURRENT/*PRV method, if I want to do it correctly, I have to put it on the end: STRPGMEXP SIGNATURE('SRVPGM SIG 1.0 ') EXPORT SYMBOL(startSomething) EXPORT SYMBOL(doSomething) EXPORT SYMBOL(finishSomething) EXPORT SYMBOL(doSomethingMore) <--- HURRAY! it's on the end. ENDPGM Now i've achieved compatibility. My existing callers will work. I don't have to run UPDSRVPGM or UPDPGM, since the export numbers didn't change, and the signature didn't change. Complete backward compatibility. Exactly the same as the *CURRENT/*PRV solution, except that I don't have to copy the signature block. Now what happens if I *want* to break compatibility? Let's say I'm making a change to my service program that I know won't be compatible, and I want make sure that every caller gets recreated. If it doesn't get recreated, I *want* it to fail with a signature error. With *CURRENT/*PRV, you'd do that by deleting all of the *PRV blocks. Simply eliminate every single *PRV block so all you have is a *CURRENT block. STRPGMEXP PGMLVL(*CURRENT) EXPORT SYMBOL(startSomething) EXPORT SYMBOL(doSomething) EXPORT SYMBOL(doSomethingMore) EXPORT SYMBOL(finishSomething) ENDPGM Now it doesn't matter that I put doSomethingMore in the middle, because all callers are going to be rebuilt anyway. Again, the system didn't *detect* this for me, I had to TELL IT that I wanted to break compatibility by deleting the *PRV blocks. IMHO, that's not a very intuitive way of telling the system I want to force callers to re-bind -- but it does work. To do the same thing with a hard-coded signature, I just change the version number in the signature. STRPGMEXP SIGNATURE('SRVPGM SIG 1.0a ') EXPORT SYMBOL(startSomething) EXPORT SYMBOL(doSomething) EXPORT SYMBOL(doSomethingMore) EXPORT SYMBOL(finishSomething) ENDPGM That's (very slightly) simpler than deleting all of the *PRV blocks, and achieves the same thing. But to me, changing a version number is more intuitive... I'm not sure it would've occurred to me to delete all of the *PRV blocks if someone hadn't told me -- but changing the version I might've thought of on my own. Also, when you use DSPPGM or DSPSRVPGM on the caller, you'll be able to see exactly which version it's using in a human-readable string. Ugh.. I've turned this e-mail into an article. Sorry for the length.
Thanks to Kevin and Scott

Back

Journal Tutorial

Q:
Jerry asked about Journaling .....

A: Rob answered ..... Do these steps: CRTLIB ROBJERRY CRTJRNRCV JRNRCV(ROBJERRY/JERRY0001) CRTJRN JRN(ROBJERRY/JERRY) JRNRCV(ROBJERRY/JERRY0001) MNGRCV(*SYSTEM) DLTRCV(*NO) Create a file in ROBJERRY. Use DDS or one of the following: CRTPF FILE(ROBJERRY/TEST) RCDLEN(10) STRSQL: CREATE TABLE ROBJERRY/TESTTWO (MYCHAR CHAR (10 ), MYNBR DEC (15 ,5)) Journal the file: STRJRNPF FILE(ROBJERRY/TEST) JRN(ROBJERRY/JERRY) IMAGES(*BOTH) Use UPDDTA, STRSQL or something to add several records to TEST. DSPJRN JRN(ROBJERRY/JERRY) FILE((ROBJERRY/TEST)) FROMTIME(...) TOTIME(...) Pick a "PT" entry and use option 5 to see what was written to the record. Now hit F10 and you can tell what: - job - date/time - user - and even the program used that updated that row. Let's say you ran the SQL from hell and forget the where clause and now all your rows are deleted. STRSQL: delete from robjerry/test DSPPFM ROBJERRY/TEST Yep, they're gone. DSPJRN JRN(ROBJERRY/JERRY) FILE((ROBJERRY/TEST)) FROMTIME(...) TOTIME(...) I see some "DL" types in there from that sql statement. In my case, sequence 13-15. RMVJRNCHG JRN(ROBJERRY/JERRY) FILE((ROBJERRY/TEST)) FROMENTLRG(15) TOENTLRG(13) Notice from 15 to 13? Seems weird until you understand it. DSPPFM ROBJERRY/TEST Hey, the records are back! Now I save the file. CRTSAVF FILE(ROBJERRY/JERRYSAVF) SAVOBJ OBJ(TEST) LIB(ROBJERRY) DEV(*SAVF) SAVF(ROBJERRY/JERRYSAVF) Then I slung several more records in the file. Then somebody deleted the file DLTF ROBJERRY/TEST DSPJRN JRN(ROBJERRY/JERRY) Had to leave the file off since it no longer exists. Ho! What's this? Code Type D DT Sequence . . . . . . : 32 Code . . . . . . . . : D - Database file operation Type . . . . . . . . : DT - Delete file F10=Display only entry details Date . . . . . . . . : 08/20/09 Time . . . . . . . . : 16:09:51 Job . . . . . . . . : 554181/ROB/ROBS1 User profile . . . . : ROB (Helps in case of profile handles and C/S type jobs.) Program . . . . . . : QCMD I'm gonna kick his tail... But first let's get the data back. RSTOBJ OBJ(TEST) SAVLIB(ROBJERRY) DEV(*SAVF) OBJTYPE(*FILE) SAVF(ROBJERRY/JERRYSAVF) DSPJRN JRN(ROBJERRY/JERRY) FILE((ROBJERRY/TEST)) Sequence . . . . . . : 23 Code . . . . . . . . : F - Database file member operation Type . . . . . . . . : MS - Member saved Date . . . . . . . . : 08/20/09 Time . . . . . . . . : 16:08:52 But it gets better, I can use the *LASTSAVE instead of having to find the above entry. APYJRNCHG JRN(ROBJERRY/JERRY) FILE((ROBJERRY/TEST)) RCVRNG(*LASTSAVE) FROMENTLRG(*LASTSAVE) TOENTLRG(31) 3 entries applied to 1 objects. Entry 31 was the entry just prior to the DLTF. Make sure that you check the journal receiver for related operations like member delete (MD) , etc which are all part of delete file (DT). DSPPFM ROBJERRY/TEST Yep, I now have all my data. That's the quick and dirty. Adding commitment control and stuff on this is gravy. Then you go into the philosophy of storing your receivers in a different library in a different ASP. Or do you just count on RAID and mirroring to CYA? We store all of our journals and receivers in a separate library that starts with a # to encourage that library to be restored prior to any other user data. Restoring data prior to restoring journals is a big no-no. Now, if you journal stuff in QUSRSYS or QGPL you might want to put them in there. IBM now restores those "user" libraries before all other user libraries. I believe that Al had them made that change. Our library name is #MXJRN for Mimix. Everything is in one ASP. Somewhere there's a mathematical formula for ideal journal size based on the number of disk arms you have - no kidding. Check this out: STRSQL F13=Services Commitment control . . . . . . *ALL INSERT INTO ROBJERRY/TEST VALUES('Q') F3=Exit with no COMMIT Changes waiting for COMMIT or ROLLBACK. (Last chance to go back in and commit them.) DSPPFM ROBJERRY/TEST "Q" is in there. SIGNOFF Sign back on. DSPPFM ROBJERRY/TEST Hey, where the heck is "Q"? I never committed the transaction. Therefore it get's backed out. Assumed a system crash. DSPJRN JRN(ROBJERRY/JERRY) FILE((ROBJERRY/TEST)) Code . . . . . . . . : R - Operation on specific record Type . . . . . . . . : DR - Record deleted for rollback Another way of automatically backing out from the query from heck, huh? Just signoff before a commit. Although I think there's a limit to the number of uncommitted transactions you can have. Which, if you have a tendency to use a DELETE (a million rows) FROM MYTABLE sql statement at year end you may have an issue. You can always open that up with no commitment control. It's not like you have to turn journalling off/on to do it. That's an appropriate time for CRTSQLRPGI ... COMMIT(*NONE). Not because you're too stubborn to start journalling your files. Then again, a WITH NC on the DELETE is more granular. See the CL commands COMMIT and ROLLBACK. Gee, put that in your default error trapping? You can also COMMIT with RPG and SQL > INSERT INTO ROBJERRY/TEST VALUES('Q') 1 rows inserted in TEST in ROBJERRY. > COMMIT Commit completed. F3 SIGNOFF sign back on DSPPFM ROBJERRY/TEST "Q" is in there.
Thanks to Rob Berendt

Back

Extract the PCML info with QBNRPII (API)

Q:
Has anybody used this Api to extract the PCML info from the module ?
Would they be willing to share the code ?

A: Command to display the PCML in an program, and the RPGLE command processing program. The RPG program calls the QBNRPII API to get the information. (To get PCML into an RPG or COBOL program, specify PGMINFO(*YES *MODULE) on the compile command.) cmd ('Display the PCML in a module') PARM KWD(OBJ) TYPE(QUALOBJ) PROMPT('Object + containing module') PARM KWD(MODULE) TYPE(QUALMOD) DFT(*ALLBNDMOD) + SNGVAL((*ALLBNDMOD *ALLBNDMOD)) + PROMPT('Module') PARM KWD(OBJTYPE) TYPE(*CHAR) LEN(10) RSTD(*YES) + DFT(*PGM) VALUES(*PGM *SRVPGM) + SPCVAL((*PGM *PGM) (*SRVPGM *SRVPGM)) + PROMPT('Object type') CHOICE('*PGM *SRVPGM') PARM KWD(STATSONLY) TYPE(*CHAR) LEN(10) RSTD(*YES) + DFT(*NO) VALUES(*NO *YES) + SPCVAL((*NO *NO) (*YES *YES)) + PROMPT('Show stats only') CHOICE('*NO *YES') QUALOBJ: QUAL TYPE(*NAME) + EXPR(*YES) + LEN(10) QUAL TYPE(*NAME) + EXPR(*YES) + LEN(10) + DFT(*LIBL) + SPCVAL((*CURLIB *CURLIB) + (*LIBL *LIBL)) + PROMPT('Library') QUALMOD: QUAL TYPE(*NAME) + EXPR(*YES) + LEN(10) QUAL TYPE(*NAME) + EXPR(*YES) + LEN(10) + DFT(*ANY) + SPCVAL((*ANY *ANY)) + PROMPT('Library') ----------------------------------------------------------------------- /if defined(*crtbndrpg) H dftactgrp(*No) actgrp(*NEW) /endif H bnddir('QC2LE') D psds sds D errmsg 7a overlay(psds:40) D qualname ds qualified based(template) D obj 10a D lib 10a * Prints the value of the module's PCML, or "***NOTFOUND***" if * the PCML was not in the module. D dspPcmlFromModule... D pr extpgm('DSPPCMLMD') D objQual likeds(qualname) const D modQual likeds(qualname) const D objType 10a const D statsOnly 10a const D dspPcmlFromModule... D pi D objQual likeds(qualname) const D modQual likeds(qualname) const D objType 10a const D statsOnly 10a const D buffer s 65535a based(bufPtr) D Qbn_Interface_Entry_t... D ds qualified based(template) * Offset from start of receiver D Offset_Next_Entry... D 10i 0 D Module_Name... D 10a D Module_Library... D 10a D Interface_Info_CCSID... D 10i 0 D Interface_Info_Type... D 10i 0 * Offset from start of receiver D Offset_Interface_Info... D 10i 0 D Interface_Info_Length_Ret... D 10i 0 D Interface_Info_Length_Avail... D 10i 0 D Qbn_PGII0100_t ds qualified based(template) D Bytes_Returned... D 10i 0 D Bytes_Available... D 10i 0 D Obj_Name... D 10a D Obj_Lib_Name... D 10a D Obj_Type... D 10a D Reserved3... D 2a D Offset_First_Entry... D 10i 0 D Number_Entries... D 10i 0 D errcode ds qualified D bytesprov 10i 0 inz(0) D bytesavail 10i 0 * Define the initial storage for the first call to the API D tempRcvr ds likeds(Qbn_PGII0100_t) D rcvr ds likeds(Qbn_PGII0100_t) D based(pRcvr) D pRcvr s * inz(*null) D entry ds likeds(Qbn_Interface_Entry_t) D based(pEntry) D pEntryData s * D data s 50a based(pData) D line s 80a varying D off s 6p 0 D lenRemaining s 10i 0 D len s 10i 0 D memcpy pr * extproc('__memcpy') D rcvr * value D src * value D len 10u 0 value D print pr D msg * value options(*string) * Prototype for QBNRPII (Retrieve Program Interface Information) * The receiver might be larger than the RPG limit of 64K * so we'll just define it as the structure header, but actually * pass a larger receiver D QBNRPII pr extpgm('QBNRPII') D Receiver_variable... D likeds(Qbn_PGII0100_t) D Length_of_receiver_variable... D 10i 0const D Format_name... D 8a const D Qualified_object_name... D likeds(qualname) const D Object_Type... D 10a const D Qualified_bound_module_name... D likeds(qualname) const D Error_code... D likeds(errcode) /free // print parms print ('Printing PCML info'); print (' Object: ' + %trim(objQual.lib) + '/' + objQual.obj + objType); if (modQual.lib = *blank); print (' Module: ' + modQual.obj); else; print (' Module: ' + %trim(modQual.lib) + '/' + modQual.obj); endif; // call the API once, to see how much storage to allocate callp(e) QBNRPII (tempRcvr : %size(tempRcvr) : 'RPII0100' : objQual : objType : modQual : errcode); if %error; print (' Error ' + errmsg + ' retrieving info'); exsr cleanup; return; endif; print (' Length of information: ' + %char(tempRcvr.Bytes_Available)); if statsOnly = '*YES'; exsr cleanup; return; endif; if tempRcvr.Bytes_Available <= tempRcvr.Bytes_Returned; pRcvr = %addr(tempRcvr); else; pRcvr = %alloc(tempRcvr.Bytes_Available); callp(e) QBNRPII (rcvr : tempRcvr.Bytes_Available : 'RPII0100' : objQual : objType : modQual : errcode); endif; if %error or rcvr.Number_Entries = 0; print (' Information not found'); exsr cleanup; return; endif; pEntry = pRcvr + rcvr.offset_First_Entry; pEntryData = pRcvr + entry.Offset_Interface_Info; lenremaining = entry.Interface_Info_Length_Ret; print (' Length of data: ' + %char(entry.Interface_Info_Length_Ret)); if lenRemaining = 0; exsr cleanup; return; endif; off = 0; dow lenRemaining > 0; len = lenRemaining; if len > %size(data); len = %size(data); endif; pData = pEntryData + off; line = %editc(off:'N') + ': ' + %subst(data : 1: len); print (line); off = off + len; lenRemaining = lenRemaining - len; enddo; exsr cleanup; return; //--------------------------------------- // S U B R O U T I N E S //--------------------------------------- begsr cleanup; if pRcvr <> *null and pRcvr <> %addr(tempRcvr); dealloc(n) pRcvr; endif; endsr; /end-free P print b D print pi D msg * value options(*string) D printf pr extproc('printf') D template * value options(*string) D msg * value options(*string : *nopass) D newline c x'15' /free printf ('%s' + newline : msg); /end-free P print e Thanks to Barbara Morris

Back

Reference for what various combinations of msg type
and msg queue will do

I found some old test code of mine. Three CL programs that send each
kind of message to various targets:

PGM
/* This message type will cause the *EXT message queue to display */
              SNDPGMMSG  MSG('This is an *INFO message') TOPGMQ(*EXT) +
                           MSGTYPE(*INFO)

/* This message type will cause the *EXT message queue to display */
              SNDPGMMSG  MSG('This is an *INQ message') TOPGMQ(*EXT) +
                           MSGTYPE(*INQ)

/* This message type will not cause the *EXT message queue to display */
/* but will become a command to be processed later by QCMD or other   */
/* request processor.                                                 */
              SNDPGMMSG  MSG('This is an *RQS message') TOPGMQ(*EXT) +
                           MSGTYPE(*RQS)

/* This message type will not cause the *EXT message queue to display */
              SNDPGMMSG  MSG('This is an *COMP message') TOPGMQ(*EXT) +
                           MSGTYPE(*COMP)

/* This message type will not cause the *EXT message queue to display */
              SNDPGMMSG  MSG('This is an *DIAG message') TOPGMQ(*EXT) +
                           MSGTYPE(*DIAG)

/* This message type will display on the last line of the screen */
              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('This is +
                           an *STATUS message') TOPGMQ(*EXT) +

MSGTYPE(*STATUS)
/* This message type will cause the *EXT message queue to display */
              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('This is +
                           an *NOTIFY message') TOPGMQ(*EXT) +
                           MSGTYPE(*NOTIFY)

/* This message type will cause the job to end                    */
/*           SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('This is +
                           an *ESCAPE message') TOPGMQ(*EXT) +
                           MSGTYPE(*ESCAPE)            */
ENDPGM

PGM
/* This message type will cause the *EXT message queue to display */
              SNDPGMMSG  MSG('This is an *INFO message') +
                           TOUSR(*REQUESTER) MSGTYPE(*INFO)

/* This message type will cause the *EXT message queue to display */
              SNDPGMMSG  MSG('This is an *INQ message') +
                           TOUSR(*REQUESTER) MSGTYPE(*INQ)

/* This message type will not cause the *EXT message queue to display */
              SNDPGMMSG  MSG('This is an *RQS message') +
                           TOUSR(*REQUESTER) MSGTYPE(*RQS)

/* This message type will not cause the *EXT message queue to display */
              SNDPGMMSG  MSG('This is an *COMP message') +
                           TOUSR(*REQUESTER) MSGTYPE(*COMP)

/* This message type will not cause the *EXT message queue to display */
              SNDPGMMSG  MSG('This is an *DIAG message') +
                           TOUSR(*REQUESTER) MSGTYPE(*DIAG)

/* This message type cannot be sent to the requester
*/                     SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('This is +
                           an *STATUS message') TOPGMQ(*EXT) +
                           MSGTYPE(*STATUS)

/* This message type will cause the *EXT message queue to display */
              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('This is +
                           an *NOTIFY message') +
                           TOUSR(*REQUESTER) MSGTYPE(*NOTIFY)

/* This message type will cause the job to end                    */
/*           SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('This is +
                           an *ESCAPE message') +
                           TOUSR(*REQUESTER) MSGTYPE(*ESCAPE)      */
ENDPGM

PGM
/* This message type will cause the following to be displayed:    */
/* From  . . . :   SHC            03/03/94   14:45:51             */
/* This is an *INFO message                                       */
              SNDPGMMSG  MSG('This is an *INFO message') +
                           TOUSR(*SYSOPR) MSGTYPE(*INFO)

/* This message type will cause the following to be displayed:    */
/* From  . . . :   SHC            03/03/94   14:45:51             */
/* This is an *INQ message                                        */
/*   Reply . . .   ______________________________________________ */
              SNDPGMMSG  MSG('This is an *INQ message') +
                           TOUSR(*SYSOPR) MSGTYPE(*INQ)

/* This message type will cause the following to be displayed:    */
/* From  . . . :   SHC            03/03/94   14:45:51             */
/* This is an *RQS message                                        */
              SNDPGMMSG  MSG('This is an *RQS message') +
                           TOUSR(*SYSOPR) MSGTYPE(*RQS)

/* This message type will cause the following to be displayed:    */
/* From  . . . :   SHC            03/03/94   14:45:51             */
/* This is an *COMP message                                       */
              SNDPGMMSG  MSG('This is an *COMP message') +
                           TOUSR(*SYSOPR) MSGTYPE(*COMP)

/* This message type will cause the following to be displayed:    */
/* From  . . . :   SHC            03/03/94   14:45:51             */
/* This is an *DIAG message                                       */
              SNDPGMMSG  MSG('This is an *DIAG message') +
                           TOUSR(*SYSOPR) MSGTYPE(*DIAG)

/* This message type can only be sent to a program message queue */
/**          SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('This is +
                           an *STATUS message') TOPGMQ(*EXT) +
                           MSGTYPE(*STATUS)   ***/

/* This message type will cause the following to be displayed:    */
/* This is an *NOTIFY message.                                    */
              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('This is +
                           an *NOTIFY message') +
                           TOUSR(*SYSOPR) MSGTYPE(*NOTIFY)

/* This message type will cause the following to be displayed:    */
/* This is an *ESCAPE message.                                    */
              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('This is +
                           an *ESCAPE message') +
                           TOUSR(*SYSOPR) MSGTYPE(*ESCAPE)
ENDPGM


Thanks to Simon Coulter
Back

International Support with UTF-8 - Considerations and Setup

Setting up your environment for UTF-8
-------------------------------------

I write this to you because I have been work a lot with
UTF-8 during the years and because the CCSID problem
seems pup-up rather frequently in this group.

The world is moving towards UTF-8 and ... if you don't believe
me just take a look at this google graph:

http://www.w3.org/QA/2008/05/utf8-web-growth.html

The obvious reson for that is that the world is more
global than ever and webpages and software should be
able to run in many languages and not only in languages
supported by latin-1(iso-8859-1 or 1252).


When running CGIDEV2 it's rater simple to set the apache
server up to translate from EBCDIC and respond correctly
in UTF-8.

There are two server directives

CGIConvMode %%EBCDIC/EBCDIC%%
DefaultNetCCSID 1208

The first tells the Apache that it has to communicate
with the CGI program in EBCDIC in the CCSID the program
is running under (job CCSID).

The second tells the Apache to always translate the EBCDIC
to UTF-8 when it sends out anything from the CGI programs.

However there is a problem. In all our communication in CGI
HTTP we have to tell in the first line what is comming so
the client knows what to do:

Content-type: text/html

What actual happens is that the Apache will append the
encoding, so what is send is:

Content-type: text/html; charset=UTF-8

If you already has appended the charset attribute
in your code things will go wrong if the charset specified
isn't corresponding to the server setting !

So don't put chatset attributes in your CGI html documents
content-type header.

Another thing is that many tends to think that iso-8859-1
(that are the apache default CCSID) is the same as CCSID 1252.

It's NOT ! This is a table of unsupported char's in iso-8859-1
vs. 1252:

(Because your browser renders this table to something useless the
siteowner has changed the table to a text file) Table of unsupported char's

Other text types of IFS files that is simply referred to in the
IFS will be added a content-type according to the filetype and
for some a charset according to the IFS file's CCSID.


When a client recieves the header, the characterset specified
there is the one that is used and you can write whatever you
want in meta tags, it is ignorred by most.


What do you achive by shifting to UTF-8, well, several things:

1. Any EBCDIC (also ccsid 37) will always be encoded
correctly in the browser, no more work arounds to try to
fit something into latin-1. Hebrew and arabic char's is
also supported.

2. More and more pages is served out with javascript
included in the CGI script. Javascript must have UTF-8
encoding in any constant strings that are passed, this
means that any special characters that dosn't have the
same binary value in iso-8859-1 and UTF-8 has to be
encoded in \u0000 sequences. By chosing UTF-8 this
encoding problem will go away.

3. Forms submitted back is encoded in UTF-8, so there
will be no problem of translating a form to the corres-
ponding EBCDIC code page.


But here is also a little problem .... AJAX !!!

AJAX works differently not only from browser to browser,
but also from version to version.

If you set the Content-type in the request header, there
is no way to know what charset that is appended, if any.

Sometimes the charset=UTF-8 is forced and sometimes
the charset=iso-8859-1/1252 is forced and sometimes the
charset is taken from the pages content-type statement.

But you have always to make the encoding to what is send:

If you want to send iso-8859-1 the best way to ensure
the the content-type header correspond to what is actual
send is to encode your URL with the encode instruction:

... var poststr = '?strXML=' + escape(xmlStr);
... poststr = poststr.replace(/\+/g,"%2B");     // Regex that handles char'+' in strings

and then set the charset in the ajax request

http_request.setRequestHeader("Content-type", "application/x-www-form-urlencoded";
charset="iso-8859-1");


If you want to send UTF-8, you use an URI instead of an URL
(an URL is actual an URI that is escaped (latin1) in stead
of UTF-8 that is the standard for URI's.

... var poststr = '?strXML=' + encodeURIComponent(xmlStr);

http_request.setRequestHeader("Content-type", "application/x-www-form-urlencoded";
charset="UTF-8");


Some other considerations in international development.
-------------------------------------------------------

EBCDIC is the worst character set in the world. While
ASCII, ANSI and UTF-8 shares binaries on the first 128
characters, you can only be sure that EBCDIC shares
binary representation on a-z A-Z 0-9 and a couple of
others (blank x'40') etc. and that only refferes to
SBCS not DBCS (#1).

So a test in a program for constant "@" will not work
if it is done in a program compiled with CCSID 277
(danish) and run on a database with CCSID 37 (us).
because the have two different binary representations.

And because the program's CCSID is set by the CCSID
of the sourcefile it isn't just enough to recompile.

Fortunately a CCSID translation is done when a
sourcemember is copied from one source file to
another and most packages (CGIDEV2 etc.) does this
copying in the installation procedure.

But is alway a good thing to check that the source
file has the CCSID that corresponds to the database
and other programs it has to run with.


Dragging and dropping text files from your PC to
the IFS with Windows XP and Client Access.

Many international javascript (like Ext JS) comes
with some language specific files. Files that are
created by many users all over the world.

Some of these files are in CCSID 1252 and some
are in CCSID 1208.

By dragging them from your PC to the IFS they will
all become CCSID 1252 but UTF-8 files will still
have the binary UTF-8 encoding inside them.

When such a file is send from the IFS and recieved
by the browser, apache has added a content-type
with the file CCSID and that gives unpredicteble
results because the CCSID don't correspond to the
actual encoding of the content.

The way to correct this is NOT to copy the file
in the IFS but just to change the CCSID:

CHGATR OBJ('/test.js') ATR(*CCSID) VALUE(1208)

The same goes for files created by ex. Notepad++
in UTF-8 (that should be without BOM (Byte Order
Mark)) on the PC and draged and dropped to the IFS.


New format's in web developing:
-------------------------------

At one time or antother the "new" format, JSON will
appear in CGIDEV2 development, and that's another
reason to shift to UTF-8, for there is no such thing
as iso-8859-1 or 1252 support in JSON.

JSON goes untranslated into javascript objects
and javascript object run's not by default but
always in UTF-8, and this cannot be changed by any
settings.

I hope I by this have given your an idear of how
easy it is to change to UTF-8 and where some of
the problems may be.

Thanks to Henrik Rützou

#1: A small program to show the "funny Hex Values" can be downloaded here: Think400.dk (Show me those funny Hex Values)

Back

Need an RPG pgm that returns Days Until Password Expires

Q:
Need an RPG pgm that returns Days Until Password Expires

A: H DFTACTGRP(*NO) ACTGRP('KLEMENT') OPTION(*SRCSTMT) D QSYRUSRI PR ExtPgm('QSYRUSRI') D RcvVar 65535a options(*varsize) D RcvVarLen 10i 0 const D Format 8a const D UsrPrf 10a const D ErrorCode 32783a options(*varsize) D QUILNGTX PR ExtPgm('QUILNGTX') D text 65535a const options(*varsize) D length 10i 0 const D msgid 7a const D qualmsgf 20a const D errorCode 32783a options(*varsize) D QMHRSNEM PR ExtPgm('QMHRSNEM') D MsgKey 4A const D ErrorCode 8000A options(*varsize) D ToEntry likeds(RSNM0100) D options(*nopass) D ToEntLen 10i 0 const options(*nopass) D ToEntFmt 8a const options(*nopass) D FromAddr * const options(*nopass) D FromCount 10i 0 const options(*nopass) D RSNM0100 ds qualified D counter 10i 0 inz(1) D module 10a inz('*NONE') D pgm 10a inz('*NONE') D entrylen 10i 0 inz(7) D entry 10a inz('*PGMBDY') D ErrorNull ds qualified D BytesProv 10i 0 inz(0) D BytesAvail 10i 0 inz(0) D USRI0100 ds qualified D DaysTil 10i 0 overlay(USRI0100:69) D msg s 200a varying /free monitor; QSYRUSRI( USRI0100 : %size(USRI0100) : 'USRI0100' : '*CURRENT' : ErrorNull ); on-error; QMHRSNEM( *blanks : ErrorNull : RSNM0100 : %len(RSNM0100) : 'RSNM0100' : *null : 0 ); endmon; select; when USRI0100.DaysTil = -1; msg = 'Your password won''t expire + in the next 7 days.'; when USRI0100.DaysTil = 0; msg = 'Your password has expired.'; other; msg = 'Your password will expire in ' + %char(USRI0100.DaysTil) + ' days.'; endsl; QUILNGTX( msg : %len(msg) : ' ' : ' ' : ErrorNull ); *inlr = *on; /end-free
Thanks to Scott Klement

Back

sFTP vs FTPs

sFTP is a highly-secure protocol, it's always encrypted from end-to-end.

FTPs is also highly-secure, but it has the ability to turn encryption
on/off at different points in the conversation.  In theory, FTPs _could_
be as secure as sFTP.  But in practice, it almost never is.

FTP is a very old protocol.  The first standard for it was published in
1971, when the Internet was only a handful of computers, and they all
trusted each other.  Some of the things that FTP does are, quite
frankly, a really bad idea in today's world.

It uses a different port for every file transfer, forcing firewalls to
have a whole range of ephemeral ports open.  Not a good idea for security.

It calculates the IP address and port number during the conversation,
and sends them over the control channel.  In order to make that work
with NAT, the NAT router has to read every packet, and change the data
in the packet.  That can't work if the data is encrypted (the NAT router
can no longer read it -- duh, it's encrypted!)

So FTPs typically uses the encryption only for the userid/password, and
then drops back to plain-text mode.  That's not nearly as secure as
sFTP, which stays encrypted throughout the conversation.

Frankly, the problem with FTPs is they tried to "put lipstick on a pig".
They took a protocol that had some serious flaws already, and tried to
add cryptography to it...  and it's just not as good as the totally
re-imagined sFTP protocol (which was designed for security from the
ground up.)

To me (someone who has spent a lot of time studying the inner workings
of these protocols) the idea that FTPs is *more* secure than sFTP is
absolutely ludicrous.

If your problem is that SSH allows interactive logins as well as file
transfers, then you should change your SSH configuration to disallow the
interactive logins for those users.


Thanks to Scott Klement
Back

Back