如何擷取使用者的預設 home 目錄(home directory) ?
有二種方法:
1. 使用 getpwnam() API
2. 使用 RETRIEVE USER INFORMATION (QSYRUSRI) API format USRI0300，
由於此 API 所擷取的是 UCS-2 內碼，所以需要 CDRCVRT API 將 UCS-2 轉換為
EBCDIC
1. 使用 getpwnam() API
File : QCLSRC
Member: RTVUSRHOMC
Type : CLLE
Usage : CRTCLPGM yourlib/RTVUSRHOMC
OS : V5R4
Note : 此範例來自 Scott Klement
PGM PARM(&USRPRF)
DCL VAR(&USRPRF) TYPE(*CHAR) LEN(10)
DCL VAR(&NULL) TYPE(*CHAR) LEN(1 ) VALUE(x'00')
DCL VAR(&USRNULL) TYPE(*CHAR) LEN(11)
DCL VAR(&NULLPTR) TYPE(*PTR)
DCL VAR(&RESULT) TYPE(*PTR)
DCL VAR(&PASSWD) TYPE(*CHAR) LEN(64) +
STG(*BASED) BASPTR(&RESULT)
DCL VAR(&PW_DIR) TYPE(*PTR) +
STG(*DEFINED) DEFVAR(&PASSWD 33)
DCL VAR(&BUFPTR) TYPE(*PTR)
DCL VAR(&BUFFER) TYPE(*CHAR) LEN(5000) +
STG(*BASED) BASPTR(&BUFPTR)
DCL VAR(&BUFLEN) TYPE(*UINT) LEN(4)
DCL VAR(&HOMEDIR) TYPE(*CHAR) LEN(5000)
CHGVAR VAR(&NULLPTR) VALUE(*NULL)
/* Call the getpwnam() API to get a pointer to the Unix +
'passwd' structure, which contains the home directory */
CHGVAR VAR(&USRNULL) VALUE(&USRPRF *TCAT &NULL)
CALLPRC PRC('getpwnam') +
PARM(&USRNULL) +
RTNVAL(&RESULT)
IF (&RESULT *EQ &NULLPTR) DO
/* ack */
ENDDO
/* The &PW_DIR variable should now point to storage +
that contains a null-terminated home directory. +
+
The strlen() API will provide the length of that +
home directory. I've limited this length to 5000 +
chars so it fits in the &HOMEDIR variable. +
+
Finally, copy it from the memory buffer into the +
&HOMEDIR variable. */
CHGVAR VAR(&BUFPTR) VALUE(&PW_DIR)
CALLPRC PRC('strlen') +
PARM((&BUFPTR *BYVAL)) +
RTNVAL(&BUFLEN)
IF (&BUFLEN *GT 5000) DO
CHGVAR VAR(&BUFLEN) VALUE(5000)
ENDDO
CHGVAR VAR(&HOMEDIR) VALUE(%SST(&BUFFER 1 &BUFLEN))
/* Now, &HOMEDIR has the home directory that was needed. +
+
Just to prove it works, I'll send it as a *COMP msg. */
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGTYPE(*COMP) +
MSGDTA(&HOMEDIR)
ENDPGM
2. 使用 RETRIEVE USER INFORMATION (QSYRUSRI) API format USRI0300，
由於此 API 所擷取的是 UCS-2 內碼，所以需要 CDRCVRT API 將 UCS-2 轉換為
EBCDIC
File : QCLSRC
Member: RTVUSRHOME
Type : CLP
Usage : CRTCLPGM yourlib/RTVUSRHOMC
OS : ALL
Note : 此範例來自 RTVUSRHOME
RTVUSRHOME: PGM PARM(&USRPRF &HOMEDIRN)
DCL VAR(&USRPRF) TYPE(*CHAR) LEN(10) /**/
DCL VAR(&RCV) TYPE(*CHAR) LEN(9999) /**/
DCL VAR(&RCVLEN) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&ERR) TYPE(*CHAR) LEN(100) /**/
DCL VAR(&FORMAT) TYPE(*CHAR) LEN(8) +
VALUE('USRI0300') /**/
DCL VAR(&OFSHOME) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&OFSHOMED) TYPE(*DEC) LEN(9) /**/
DCL VAR(&HOMEDIR) TYPE(*CHAR) LEN(512) /*IN UCS*2*/
DCL VAR(&CCSID) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&LOHOME) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&ST1) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&L1) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&CCSIDN) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&CCSIDNN) TYPE(*DEC) LEN(5 0) /**/
DCL VAR(&ST2) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&GCCASN) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&L2) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&HOMEDIRN) TYPE(*CHAR) LEN(256) /*IN EBCDIC*/
DCL VAR(&L3) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&L4) TYPE(*CHAR) LEN(4) /**/
CHGVAR VAR(%BIN(&RCVLEN)) VALUE(9999)
IF COND(&USRPRF = '*CURRENT ') THEN(RTVJOBA +
CURUSER(&USRPRF) DFTCCSID(&CCSIDNN))
/* RETRIEVE USER INFORMATION (QSYRUSRI) API */
CALL PGM(QSYRUSRI) PARM(&RCV &RCVLEN &FORMAT +
&USRPRF &ERR)
CHGVAR VAR(&OFSHOME) VALUE(%SST(&RCV 601 4))
/* OFFSET TO HOMEDIR-BLOCK */
CHGVAR VAR(&OFSHOMED) VALUE(%BIN(&OFSHOME))
CHGVAR VAR(&OFSHOMED) VALUE(&OFSHOMED + 1)
/* CCSID OF HOMEDIR IS 61952 UCS-2 */
CHGVAR VAR(&CCSID) VALUE(%SST(&RCV &OFSHOMED 4))
CHGVAR VAR(&OFSHOMED) VALUE(&OFSHOMED +4+2+3+3+4)
/* NUMBER OF BYTES HOMEDIR UCS*2 */
CHGVAR VAR(&LOHOME) VALUE(%SST(&RCV &OFSHOMED 4))
CHGVAR VAR(&OFSHOMED) VALUE(&OFSHOMED +4+2+10)
/* HOMEDIR IN UCS*2 */
CHGVAR VAR(&HOMEDIR) VALUE(%SST(&RCV &OFSHOMED 512))
CHGVAR VAR(%BIN(&ST1)) VALUE(0)
/* NUMBER OF BYTES INPUT STRING */
CHGVAR VAR(&L1) VALUE(&LOHOME)
/* CONVERT IN DFT JOB CCSID */
RTVJOBA DFTCCSID(&CCSIDNN)
CHGVAR VAR(%BIN(&CCSIDN)) VALUE(&CCSIDNN)
/* 2 = SPACE PADDED, SO L2 = L3 */
CHGVAR VAR(%BIN(&ST2)) VALUE(2)
CHGVAR VAR(%BIN(&GCCASN)) VALUE(0)
/* ALLOCATED OUTPUT LENGTH IN BYTES */
CHGVAR VAR(%BIN(&L2)) VALUE(256)
/* CONVERT A GRAPHIC CHARACTER STRING (CDRCVRT) API */
CALL PGM(CDRCVRT) PARM(&CCSID &ST1 &HOMEDIR &L1 +
&CCSIDN &ST2 &GCCASN &L2 &HOMEDIRN &L3 +
&L4 &ERR)
SNDPGMMSG MSG(&HOMEDIRN)
ENDPGM
詳細資訊參照：
getpwnam()--Get User Information for User Name
Retrieve User Information (QSYRUSRI) API
星期三, 11月 08, 2023
2012-03-19 如何擷取使用者的預設 home 目錄(home directory) ?(getpwnam API or QSYRUSRI API)
2008-07-30 如何快速顯示 IFS 目錄或檔案的使用者權限？(Command: DSPIFSAUT with API Qp0lGetAttr)
如何快速顯示 IFS 目錄或檔案的使用者權限？(Command: DSPIFSAUT with API Qp0lGetAttr)
File : QRPGLESRC
Member : DSPIFSAUT
Type : RPGLE
Usage : CRTBNDRPG PGM(DSPIFSAUT) TGTRLS(V5R2M0)
**
** Program . . : DspIfsAut
** Description : Display IFS File Authority (CPP of command DspIfsAut)
** Author . . : Vengoal Chang
** Date . . : 2008/07/30
**
** Input parameters
** Description Type Size How Used
** ----------- ---- ---- --------
** PxIfsObj Char 5002 IFS object authority for display
**
**
** Compile options:
**
** CrtBndRpg Pgm( DspIfsAut )
** DbgView( *LIST ) TgtRls(V5R1M0)
**
**
**-- Control specification: --------------------------------------------**
H Option( *SrcStmt ) BndDir( 'QC2LE' ) DecEdit( *JOBRUN )
H DftActGrp(*NO)
**-- Printer file:
FQSYSPRT O F 132 Printer InfDs( PrtLinInf ) OflInd( *InOf )
F UsrOpn
**-- Printer file information:
D PrtLinInf Ds
D PlOvfLin 5i 0 Overlay( PrtLinInf: 188 )
D PlCurLin 5i 0 Overlay( PrtLinInf: 367 )
D PlCurPag 5i 0 Overlay( PrtLinInf: 369 )
**-- System information:
D SDs
D PsPgmNam *Proc
**-- API error information:
D ERRC0100 Ds Qualified
D BytPro 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 256a
**-- Global variables:
D LstTim s 6s 0
D IfsObj s 109a
D LinTxt s 40a
D LinVal s 50a
D LinVal2 s 105a
**
D BufSizAvl s 10u 0 Inz( 0 )
D NbrBytRtn s 10u 0 Inz( 0 )
D ApiRcvSiz s 10u 0
D rc s 10i 0
D Idx s 10i 0
D pBuffer s *
D ErrTxt s 256a
D MsgKey s 4a
**
D ObjOwn s 10a
D ObjPgp s 10a
D AutLstNam s 10a
D UsrNam s 10a
D UsrDtaAut s 10a
**
D AutObjMgm s 1a
D AutObjExs s 1a
D AutObjAlt s 1a
D AutObjRef s 1a
D AutObjOpr s 1a
D AutDtaRead s 1a
D AutDtaAdd s 1a
D AutDtaUpd s 1a
D AutDtaDlt s 1a
D AutDtaExe s 1a
D AutDtaExcl s 1a
**-- Spooled file information:
D SPRL0100 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D SplfNam 10a
D JobNam 10a
D UsrNam 10a
D JobNbr 6a
D SplfNbr 10i 0
D JobSysNam 8a
D SplfCrtDat 7a
D 1a
D SplfCrtTim 6a
**-- File attributes:
D QP0L_ATTR_AUTH c 11
**-- API path constants:
D CUR_CCSID c 0
D CUR_CTRID c x'0000'
D CUR_LNGID c x'000000'
D CHR_DLM_1 c 0
**-- General authority format:
D GenAut Ds Qualified Align Based( pGenAut )
D ObjOwn 10a
D PriGrp 10a
D AutL 10a
D 10a
D OfsUsrE 10i 0
D NbrUsrE 10i 0
D SizUsrE 10i 0
D 12a
**
D UsrAut Ds Qualified Align Based( pUsrAut )
D UsrNam 10a
D UsrDtaAut 10a
D ObjMgm 1a
D ObjExs 1a
D ObjAlt 1a
D ObjRef 1a
D 10a
D ObjOpr 1a
D DtaRead 1a
D DtaAdd 1a
D DtaUpd 1a
D DtaDlt 1a
D DtaExe 1a
D DtaExclude 1a
D 7a
**-- API path:
D Path Ds Qualified Align
D CcsId 10i 0 Inz( CUR_CCSID )
D CtrId 2a Inz( CUR_CTRID )
D LngId 3a Inz( CUR_LNGID )
D 3a Inz( *Allx'00' )
D PthTypI 10i 0 Inz( CHR_DLM_1 )
D PthNamLen 10i 0
D PthNamDlm 2a Inz( '/ ' )
D 10a Inz( *Allx'00' )
D PthNam 5000a
**
D AtrIds Ds Qualified Align
D NbrAtr 10i 0
D AtrId 10i 0 Dim( 32 )
**
D Buffer Ds Qualified Align Based( pBufferE )
D OfsNxtAtr 10i 0
D AtrId 10i 0
D SizAtr 10i 0
D 4a
D AtrDta 1024a
D AtrInt2 5i 0 Overlay( AtrDta: 1 )
D AtrInt 10i 0 Overlay( AtrDta: 1 )
D AtrUint 10u 0 Overlay( AtrDta: 1 )
D AtrUint8 20u 0 Overlay( AtrDta: 1 )
**-- Get attributes:
D GetAtr Pr 10i 0 ExtProc( 'Qp0lGetAttr' )
D GaFilNam * Value
D GaAtrLst * Value
D GaBuffer * Value
D GaBufSizPrv 10u 0 Value
D GaBufSizAvl 10u 0
D GaBufSizRtn 10u 0
D GaFlwSymLnk 10u 0 Value
D GaDots 10i 0 Options( *NoPass )
**-- Initialize memory:
D memset Pr 10i 0 ExtProc( 'memset' )
D pStg * Value
D InzVal 1a Value
D InzByt 10i 0 Value
**-- Copy memory:
D memcpy Pr * ExtProc( '_MEMMOVE' )
D MemOut * Value
D MemInp * Value
D MemSiz 10u 0 Value
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D SpMsgId 7a Const
D SpMsgFq 20a Const
D SpMsgDta 128a Const
D SpMsgDtaLen 10i 0 Const
D SpMsgTyp 10a Const
D SpCalStkE 10a Const Options( *VarSize )
D SpCalStkCtr 10i 0 Const
D SpMsgKey 4a
D SpError 32767a Options( *VarSize )
**-- Retrieve last spooled file identity:
D RtvLstSplfId Pr ExtPgm( 'QSPRILSP' )
D RsRcvVar 32767a Options( *VarSize )
D RsRcvVarLen 10i 0 Const
D RsFmtNam 8a Const
D RsError 32767a Options( *VarSize )
**-- Run system command:
D system Pr 10i 0 ExtProc( 'system' )
D command * Value Options( *String )
**-- Write attribute line:
D WrtAtrLin Pr
D PxLinTxt 40a Const
D PxLinVal 50a Const
**-- Write attribute line:
D WrtAtrLin2 Pr
D PxLinVal 100a Const
**-- Write blank line:
D WrtBlkLin Pr
**-- Write list header:
D WrtLstHdr Pr
D PxOvrFlwRel 10i 0 Const Options( *NoPass )
**-- Send escape message:
D SndEscMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- Send completion message:
D SndCmpMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- Error identification:
D errno Pr 10i 0
**
D strerror Pr 128a Varying
D DSPIFSAUT Pr
D PxIfsObj 5002a Varying
**
D DSPIFSAUT Pi
D PxIfsObj 5002a Varying
/Free
Path.PthNam = PxIfsObj;
Path.PthNamLen = %Len( PxIfsObj );
AtrIds.NbrAtr = 1;
AtrIds.AtrId = QP0L_ATTR_AUTH;
If GetAtr( %Addr( Path )
: %Addr( AtrIds )
: *Null
: *Zero
: BufSizAvl
: NbrBytRtn
: 0
) = 0;
ApiRcvSiz = BufSizAvl;
pBuffer = %Alloc( ApiRcvSiz );
memset( pBuffer: x'00': ApiRcvSiz );
If GetAtr( %Addr( Path )
: %Addr( AtrIds )
: pBuffer
: ApiRcvSiz
: BufSizAvl
: NbrBytRtn
: 0
) = 0;
pBufferE = pBuffer;
//When Buffer.AtrId = QP0L_ATTR_AUTH;
pGenAut = %Addr( Buffer.AtrDta );
ObjOwn = GenAut.ObjOwn;
ObjPgp = GenAut.PriGrp;
AutLstNam = GenAut.AutL;
Open QSYSPRT;
WrtAtrLin( 'Authorization list . . . . . . . . . . :': AutLstNam );
WrtAtrLin( 'Object primary group . . . . . . . . . :': ObjPgp );
WrtBlkLin();
WrtAtrLin( 'User authority . . . . :' : ' ');
LinVal2 = ' Data --Object Authorities-- ' +
'-------------Data Authorities------------';
WrtAtrLin2(LinVal2);
LinVal2 = 'User Authority Exist Mgt Alter Ref ' +
'Objopr Read Add Update Delete Execute';
WrtAtrLin2(LinVal2);
WrtBlkLin();
pUsrAut = pBuffer + GenAut.OfsUsrE;
For Idx = 1 to GenAut.NbrUsrE;
// Authorization entry available here
LinVal2 = ' ';
%SubSt(LinVal2:1 :10) = UsrAut.UsrNam;
%SubSt(LinVal2:13:10) = UsrAut.UsrDtaAut;
If UsrAut.ObjExs = X'01';
%SubSt(LinVal2:26: 1) = 'X';
EndIf;
If UsrAut.ObjMgm = X'01';
%SubSt(LinVal2:32: 1) = 'X';
EndIf;
If UsrAut.ObjAlt = X'01';
%SubSt(LinVal2:38: 1) = 'X';
EndIf;
If UsrAut.ObjRef = X'01';
%SubSt(LinVal2:44: 1) = 'X';
EndIf;
If UsrAut.ObjOpr = X'01';
%SubSt(LinVal2:50: 1) = 'X';
EndIf;
If UsrAut.DtaRead= X'01';
%SubSt(LinVal2:57: 1) = 'X';
EndIf;
If UsrAut.DtaAdd = X'01';
%SubSt(LinVal2:63: 1) = 'X';
EndIf;
If UsrAut.DtaUpd = X'01';
%SubSt(LinVal2:69: 1) = 'X';
EndIf;
If UsrAut.DtaDlt = X'01';
%SubSt(LinVal2:77: 1) = 'X';
EndIf;
If UsrAut.DtaExe = X'01';
%SubSt(LinVal2:86: 1) = 'X';
EndIf;
WrtAtrLin2( LinVal2 );
WrtBlkLin();
If Idx < GenAut.NbrUsrE;
pUsrAut += GenAut.SizUsrE;
EndIf;
EndFor;
Close QSYSPRT;
ExSr DspSplf;
EndIf;
Else;
SndEscMsg( %Char( Errno ) + ': ' + Strerror );
EndIf;
DeAlloc pBuffer;
*InLr = *On;
Return;
BegSr DspSplf;
RtvLstSplfId( SPRL0100: %Size( SPRL0100 ): 'SPRL0100': ERRC0100 );
system( 'DSPSPLF FILE(' + %Trim( SPRL0100.SplfNam ) + ')' +
' JOB(' + %Trim( SPRL0100.JobNbr ) + '/' +
%Trim( SPRL0100.UsrNam ) + '/' +
%Trim( SPRL0100.JobNam ) + ')' +
' SPLNBR(' + %Char( SPRL0100.SplfNbr ) + ')'
);
system( 'DLTSPLF FILE(' + %Trim( SPRL0100.SplfNam ) + ')' +
' JOB(' + %Trim( SPRL0100.JobNbr ) + '/' +
%Trim( SPRL0100.UsrNam ) + '/' +
%Trim( SPRL0100.JobNam ) + ')' +
' SPLNBR(' + %Char( SPRL0100.SplfNbr ) + ')'
);
SndCmpMsg( 'IFS authority list has been displayed and deleted.' );
EndSr;
BegSr *InzSr;
LstTim = %Int( %Char( %Time(): *ISO0));
If %Len( PxIfsObj ) > %Size( IfsObj );
EvalR IfsObj = PxIfsObj;
%Subst( IfsObj: 1: 3 ) = '...';
Else;
IfsObj = PxIfsObj;
EndIf;
EndSr;
/End-Free
**-- Printer file definition: ------------------------------------------**
OQSYSPRT EF Header 2 2
O UDATE Y 8
O LstTim 18 ' : : '
O 70 'Display IFS File Attribute-
O s'
O 107 'Program:'
O PsPgmNam 118
O 126 'Page:'
O PAGE + 1
OQSYSPRT EF LstHdr 1
O 20 'Object . . . . . . :'
O IfsObj 132
OQSYSPRT EF DtlLin 1
O LinTxt 40
O LinVal 93
OQSYSPRT EF DtlLin2 1
O LinVal2 130
OQSYSPRT EF DtlBlk 1
**
OQSYSPRT EF LstTrl 1
O 26 '* E N D O F L I S T *'
**-- Get runtime error number: -----------------------------------------**
P errno B
D Pi 10i 0
D sys_errno Pr * ExtProc( '__errno' )
**
D Error s 10i 0 Based( pError ) NoOpt
/Free
pError = sys_errno;
Return Error;
/End-Free
P Errno E
**-- Get runtime error text: -------------------------------------------**
P strerror B
D Pi 128a Varying
D sys_strerror Pr * ExtProc( 'strerror' )
D 10i 0 Value
/Free
Return %Str( sys_strerror( Errno ));
/End-Free
P strerror E
**-- Write attribute line: ---------------------------------------------**
P WrtAtrLin B
D Pi
D PxLinTxt 40a Const
D PxLinVal 50a Const
/Free
WrtLstHdr( 3 );
LinTxt = PxLinTxt;
LinVal = PxLinVal;
Except DtlLin;
/End-Free
P WrtAtrLin E
**-- Write attribute line2: ---------------------------------------------**
P WrtAtrLin2 B
D Pi
D PxLinVal2 100a Const
/Free
WrtLstHdr( 3 );
LinVal2= PxLinVal2;
Except DtlLin2;
/End-Free
P WrtAtrLin2 E
**-- Write blank line: -------------------------------------------------**
P WrtBlkLin B
D Pi
/Free
WrtLstHdr( 2 );
Except DtlBlk;
/End-Free
P WrtBlkLin E
**-- Write list header: ------------------------------------------------**
P WrtLstHdr B
D Pi
D PxOvrFlwRel 10i 0 Const Options( *NoPass )
/Free
If %Parms = *Zero;
Except Header;
Except LstHdr;
Else;
If PlCurLin > PlOvfLin - PxOvrFlwRel;
Except Header;
Except LstHdr;
EndIf;
EndIf;
/End-Free
P WrtLstHdr E
**-- Send escape message: ----------------------------------------------**
P SndEscMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
/Free
SndPgmMsg( 'CPF9897'
: 'QCPFMSG *LIBL'
: PxMsgDta
: %Len( PxMsgDta )
: '*ESCAPE'
: '*PGMBDY'
: 1
: MsgKey
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return -1;
Else;
Return 0;
EndIf;
/End-Free
P SndEscMsg E
**-- Send completion message: ------------------------------------------**
P SndCmpMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
/Free
SndPgmMsg( 'CPF9897'
: 'QCPFMSG *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 : DSPIFSAUT
Type : CMD
Usage : CRTCMD CMD(DSPIFSAUT) PGM(DSPIFSAUT)
Sample : DSPIFSAUT OBJ('/tmp')
/* =============================================================== */
/* = Command....... DspIfsAut = */
/* = CPP........... DspIfsAut = */
/* = Description... Display IFS File Authority = */
/* = = */
/* = CrtCmd Cmd( DspIfsAut ) = */
/* = Pgm( DspIfsAut ) = */
/* = SrcFile( YourSourceFile ) = */
/* = = */
/* =============================================================== */
/* = Date : 2008/07/30 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('DISPLAY IFS FILE AUTHORITY')
PARM OBJ *PNAME 5000 +
MIN( 1 ) +
VARY( *YES *INT2 ) +
CASE( *MIXED ) +
PROMPT( 'OBJECT' )
2008-07-18 如何找出允許限制使用者(ALWLMTUSR)執行的指令？(Command PRTLMTCMD by API QCDRCMDI)
如何找出允許限制使用者(ALWLMTUSR)執行的指令？(Command PRTLMTCMD by API QCDRCMDI)
於 USRPRF 指定使用者參數 LMTCPB(*YES)時，該使用者無法於命令列執行指令，除非所要執行指令的參數 ALWLMTUSR 值設定為 *YES，
否則無法執行該指令。
系統預設 ALWLMTUSR(*YES) 的指令有下列：
DSPJOB
DSPJOBLOG
DSPMSG
SIGNOFF
SNDMSG
STRPCO
WRKENVVAR
WRKMSG
所以 USRPRF 中參數 LMTCPB(*YES)的使用者可以執行上述指令，若有其他指令也要讓使用者參數 LMTCPB(*YES) 的使用者執行，就要
執行 CHGCMD CMD(your-command) ALWLMTUSR(*YES)。
利用 DSPCMD 可以顯示指令參數 ALWLMTUSR 值來判斷該指令是否允許LMTCPB(*YES)的使用者執行。但是系統指令繁多，無法一依查詢，
所以可以透過 API QUSLOBJ, QCDRCMDI 來列印指令參數 ALWLMTUSR(*YES) 的指令。
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
B1 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')
執行範例：
PRTLMTCMD LIB(QSYS) ==> 若有 ALWLMTUSR(*YES)指令，報表 QSYSPRT 狀態為 RDY
PRTLMTCMD LIB(QGPL) ==> 若無 ALWLMTUSR(*YES)指令，報表 QSYSPRT 狀態為 FIN
2007-11-30 如何設定使用者於指定天數後一定要更改密碼？(Command: ANZPWDCHG)
如何設定使用者於指定天數後一定要更改密碼？(Command: ANZPWDCHG)
設定使用者密碼的有效天數，有兩個地方可以設定：
1. 系統值 QPWDEXPITV ==> 針對全系統設定
2. 使用者設定檔(USRPRF)中參數 PWDEXPITV ==> 針對單一使用者設定
使用者設定檔(USRPRF)中參數 PWDEXPITV 預設值為 *SYSVAL，亦即參照系統值 QPWDEXPITV。
所以一般使用者都會使用系統值 QPWDEXPITV 設定使用者密碼的有效天數，但是由於系統會自動於使用者
簽入時檢核密碼是否即將於 7 天內到期，若是則會發出密碼即將於幾天候到期的通知於畫面上，常會造成
使用者往往會等到最後一天才更改密碼，這在原本 Client Access 5250 終端畫面下並不會產生問題，但
是在使用 WAS ， Tomcat 或 IIS ASP.NET 的 Web 網路連接 AS/400 系統環境下，就有可能會發生一些問
題，所以為了讓系統不要發出 "密碼是否即將於 7 天內到期" 的訊息，有必要於系統發出該訊息前，就將
使用者設定為密碼過期，較好的方式是利用密碼更改日 + 密碼有效天數來檢核是否過期，若過期就將該使
用者設定為密碼過期，密碼有效天數的計算是透過系統值 QPWDEXPITV - 10 來取得。
為因應上述需求，我提供一個指令 ANZPWDCHG(Analyze User PwdChgDate)來設定使用者是否密碼過期。
File : QRPGLESRC
Member: ANZPWDCHG
Type : RPGLE
OS : V5R1 以後(因為是使用 free form)
**
** Program . . : ANZPWDCHG
** Description : Analyze user profiles expiration by pwd changed date
** and do action
** Author . . : Vengoal Chang
**
** Date . . : 2007/11/19
**
** Modified . : 2007/11/19
** Add Expired action
**
** Compile and setup instructions:
** CrtRpgMod Module( ANZPWDCHG )
** DbgView( *LIST )
**
** CrtPgm Pgm( ANZPWDCHG )
** Module( ANZPWDCHG )
** ActGrp( *NEW )
**
**
**-- Control specification: --------------------------------------------**
H Option( *SrcStmt: *NoDebugIo ) DftActGrp(*NO)
**-- Printer file:
FQSYSPRT O F 132 Printer InfDs( PrtLinInf ) OflInd( *InOf )
**-- Printer file information:
D PrtLinInf Ds Qualified
D OvfLin 5i 0 Overlay( PrtLinInf: 188 )
D CurLin 5i 0 Overlay( PrtLinInf: 367 )
D CurPag 5i 0 Overlay( PrtLinInf: 369 )
**-- System information:
D PgmSts SDs Qualified
D PgmNam *Proc
**-- API error data structure:
D ERRC0100 Ds Qualified
D BytPrv 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 128a
**-- Global variables:
D LstTim s 6s 0
D SysNam s 8a
D TrlTxt s 32a
D Workdate s d
D ChgWrkDate s d
D CmdStr S 1024 INZ
D CmdLen S 15P 5 INZ(1024)
**-- List record:
D LstRcd Ds Qualified
D UsrPrf 10a
D PrfSts 10a
D PwdExpI 4a
D PwdExpD 8a
D InvSgo 3i 0
D GrpPrf 10a
D PwdI 4a
D LmtCap 4a
D SpcAut 4a
D UsrCls 10a
D PrvSgoD 8a
D PwdChgD 8a
**-- List API parameters:
D LstApi Ds Qualified Inz
D RtnRcdNbr 10i 0
D GrpNam 10a
D SltCri 10a
**-- List information:
D LstInf Ds Qualified
D RcdNbrTot 10i 0
D RcdNbrRtn 10i 0
D Handle 4a
D RcdLen 10i 0
D InfSts 1a
D Dts 13a
D LstSts 1a
D 1a
D InfLen 10i 0
D Rcd1 10i 0
D 40a
**-- User information:
D AUTU0100 Ds Qualified
D UsrPrf 10a
D UsrGrpI 1a
D GrpMbrI 1a
**-- User information:
D USRI0300 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D UsrPrf 10a
D PrvSgoDts 13a Overlay( USRI0300: 19 )
D PrvSgoDat 7a Overlay( USRI0300: 19 )
D PrvSgoTim 6a Overlay( USRI0300: 26 )
D InvSgo 10i 0 Overlay( USRI0300: 33 )
D PrfSts 10a Overlay( USRI0300: 37 )
D PwdChgDat 8a Overlay( USRI0300: 47 )
D NoPwdI 1a Overlay( USRI0300: 55 )
D PwdExpDat 8a Overlay( USRI0300: 61 )
D PwdExpI 1a Overlay( USRI0300: 73 )
D UsrCls 10a Overlay( USRI0300: 74 )
D SpcAut 15a Overlay( USRI0300: 84 )
D GrpPrf 10a Overlay( USRI0300: 99 )
D LmtCap 10a Overlay( USRI0300: 189 )
**-- Open list of authorized users:
D LstAutUsr Pr ExtPgm( 'QGYOLAUS' )
D LuRcvVar 65535a Options( *VarSize )
D LuRcvVarLen 10i 0 Const
D LuLstInf 80a
D LuNbrRcdRtn 10i 0 Const
D LuFmtNam 8a Const
D LuSltCri 10a Const
D LuGrpNam 10a Const
D LuError 1024a Options( *VarSize )
**-- Get list entry:
D GetLstEnt Pr ExtPgm( 'QGYGTLE' )
D GlRcvVar 65535a Options( *VarSize )
D GlRcvVarLen 10i 0 Const
D GlHandle 4a Const
D GlLstInf 80a
D GlNbrRcdRtn 10i 0 Const
D GlRtnRcdNbr 10i 0 Const
D GlError 1024a Options( *VarSize )
**-- Close list:
D CloseLst Pr ExtPgm( 'QGYCLST' )
D ClHandle 4a Const
D ClError 1024a Options( *VarSize )
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D SpMsgId 7a Const
D SpMsgFq 20a Const
D SpMsgDta 128a Const
D SpMsgDtaLen 10i 0 Const
D SpMsgTyp 10a Const
D SpCalStkE 10a Const Options( *VarSize )
D SpCalStkCtr 10i 0 Const
D SpMsgKey 4a
D SpError 32767a Options( *VarSize )
**-- Convert date & time:
D CvtDtf Pr ExtPgm( 'QWCCVTDT' )
D CdInpFmt 10a Const
D CdInpVar 17a Const Options( *VarSize )
D CdOutFmt 10a Const
D CdOutVar 17a Options( *VarSize )
D CdError 10i 0 Const
**-- Retrieve net attribute:
D RtvNetAtr Pr ExtPgm( 'QWCRNETA' )
D RnRcvVar 32767a Options( *VarSize )
D RnRcvVarLen 10i 0 Const
D RnNbrNetAtr 10i 0 Const
D RnNetAtr 10a Const Dim( 256 )
D Options( *VarSize )
D RnError 32767a Options( *VarSize )
**-- Retrieve user information:
D RtvUsrInf Pr ExtPgm( 'QSYRUSRI' )
D RuRcvVar 32767a Options( *VarSize )
D RuRcvVarLen 10i 0 Const
D RuFmtNam 10a Const
D RuUsrPrf 10a Const
D RuError 32767a Options( *VarSize )
**-- Retrieve object description:
D RtvObjD Pr ExtPgm( 'QUSROBJD' )
D RoRcvVar 32767a Options( *VarSize )
D RoRcvVarLen 10i 0 Const
D RoFmtNam 8a Const
D RoObjNamQ 20a Const
D RoObjTyp 10a Const
D RoError 32767a Options( *VarSize )
**-- Convert system DTS to date:
D CvtDtsDat Pr d
D PxSysDts 8a Value
**-- Get system name:
D GetSysNam Pr 8a Varying
**-- Get user creator:
D GetUsrCrt Pr 10a
D PxUsrPrf 10a Value
**-- Send completion message:
D SndCmpMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- Write detail line:
D WrtDtlLin Pr
**-- Write list header:
D WrtLstHdr Pr
D PxOvrFlwRel 10i 0 Const Options( *NoPass )
**-- Write list trailer:
D WrtLstTrl Pr
D PxTrlTxt 32a Const
**-- Call system command:
D QCMDEXC PR ExtPgm('QCMDEXC')
D Cmd 500A options(*varsize) Const
D CmdLen 15P 5 Const
**-- Entry parameters:
D ANZPWDCHG Pr
D PxOverDays 5 0
D PxActOpt 10a
D PxSysPrf 4a
**
D ANZPWDCHG Pi
D PxOverDays 5 0
D PxActOpt 10a
D PxSysPrf 4a
/Free
CmdStr = 'ADDLIBLE QGY' ;
CmdLen = %len(%trim(CmdStr));
Monitor;
QCMDEXC(%trim(CmdStr) : CmdLen);
On-Error;
EndMon;
LstApi.RtnRcdNbr = 1;
LstApi.SltCri = '*ALL';
LstApi.GrpNam = '*NONE';
LstAutUsr( AUTU0100
: %Size( AUTU0100 )
: LstInf
: 1
: 'AUTU0100'
: LstApi.SltCri
: LstApi.GrpNam
: ERRC0100
);
If ERRC0100.BytAvl = *Zero;
DoW LstInf.LstSts <> '2' Or LstInf.RcdNbrTot >= LstApi.RtnRcdNbr;
ExSr GetPrfInf;
LstApi.RtnRcdNbr = LstApi.RtnRcdNbr + 1;
GetLstEnt( AUTU0100
: %Size( AUTU0100 )
: LstInf.Handle
: LstInf
: 1
: LstApi.RtnRcdNbr
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Leave;
EndIf;
EndDo;
CloseLst( LstInf.Handle: ERRC0100 );
EndIf;
WrtLstTrl( '*** E N D O F L I S T ***' );
SndCmpMsg( 'List has been printed.' );
*InLr = *On;
Return;
BegSr GetPrfInf;
RtvUsrInf( USRI0300
: %Size( USRI0300 )
: 'USRI0300'
: AUTU0100.UsrPrf
: ERRC0100
);
If ERRC0100.BytAvl = *Zero;
ExSr GetChgWrkDate;
ExSr ChkPrfInf;
EndIf;
EndSr;
BegSr ChkPrfInf;
If PxSysPrf = '*YES' Or GetUsrCrt( USRI0300.UsrPrf ) <> '*IBM';
Select;
//When USRI0300.PwdExpI = 'Y';
//ExSr WrtPrfInf;
When ChgWrkDate < %Date();
If (PxActOpt = '*DISABLED') or (PxActOpt = '*EXPIRED' );
Select;
When PxActOpt = '*DISABLED';
CmdStr = 'CHGUSRPRF USRPRF(' + %trim(USRI0300.UsrPrf) +
') STATUS(*DISABLED)';
When PxActOpt = '*EXPIRED' ;
CmdStr = 'CHGUSRPRF USRPRF(' + %trim(USRI0300.UsrPrf) +
') PWDEXP(*YES)' ;
EndSl;
CmdLen = %len(%trim(CmdStr));
QCMDEXC(%trim(CmdStr) : CmdLen);
ExSr WrtPrfInf;
Else;
ExSr WrtPrfInf;
EndIf;
EndSl;
EndIf;
EndSr;
BegSr WrtPrfInf;
LstRcd.UsrPrf = USRI0300.UsrPrf;
LstRcd.PrfSts = USRI0300.PrfSts;
LstRcd.InvSgo = USRI0300.InvSgo;
LstRcd.GrpPrf = USRI0300.GrpPrf;
LstRcd.LmtCap = USRI0300.LmtCap;
LstRcd.UsrCls = USRI0300.UsrCls;
If USRI0300.PwdExpDat = *Blanks;
LstRcd.PwdExpD = '*NONE';
Else;
LstRcd.PwdExpD = %Char( CvtDtsDat( USRI0300.PwdExpDat ): *JOBRUN );
EndIf;
If USRI0300.PwdChgDat = *Blanks;
LstRcd.PwdChgD = '*NONE';
Else;
LstRcd.PwdChgD = %Char( CvtDtsDat( USRI0300.PwdChgDat ): *JOBRUN );
EndIf;
If USRI0300.PrvSgoDts = *Blanks;
LstRcd.PrvSgoD = '*NONE';
Else;
LstRcd.PrvSgoD = %Char( %Date( USRI0300.PrvSgoDat: *CYMD0 )
: *JOBRUN
);
EndIf;
If USRI0300.PwdExpI = 'Y';
LstRcd.PwdExpI = '*YES';
Else;
LstRcd.PwdExpI = '*NO';
EndIf;
If USRI0300.NoPwdI = 'Y';
LstRcd.PwdI = '*NO';
Else;
LstRcd.PwdI = '*YES';
EndIf;
If USRI0300.SpcAut = 'NNNNNNNN';
LstRcd.SpcAut = '*NO';
Else;
LstRcd.SpcAut = '*YES';
EndIf;
WrtDtlLin();
EndSr;
BegSr *InzSr;
LstTim = %Int( %Char( %Time(): *ISO0));
SysNam = GetSysNam();
WrtLstHdr();
EndSr;
/End-Free
C GetChgWrkDate BegSr
C If USRI0300.PwdChgDat <> *Blanks
C eval ChgWrkDate =
C CvtDtsDat( USRI0300.PwdChgDat )
C ADDDUR PxOverDays:*D ChgWrkDate
C Else
C eval ChgWrkDate = %Date()
C EndIf
C EndSr
**-- Printer file definition: ------------------------------------------**
OQSYSPRT EF Header 2 2
O UDATE Y 8
O LstTim 18 ' : : '
O 36 'System:'
O SysNam 45
O 82 'User profile exceptions'
O 107 'Program:'
O PgmSts.PgmNam 118
O 126 'Page:'
O PAGE + 1
**
OQSYSPRT EF LstHdr 1
O 4 'User'
O 17 'Class'
O 29 'Group'
O 42 'Status'
O 53 'Limit'
O 65 'Spc.aut.'
O 75 'Inv.sign.'
O 84 'Password'
O 94 'Pwd.exp.'
O 104 'Exp.date'
O 114 'Sign-on'
O 129 'Pwd. changed'
**
OQSYSPRT EF DtlLin 1
O LstRcd.UsrPrf 10
O LstRcd.UsrCls 22
O LstRcd.GrpPrf 34
O LstRcd.PrfSts 46
O LstRcd.LmtCap 52
O LstRcd.SpcAut 62
O LstRcd.InvSgo Z 70
O LstRcd.PwdI 81
O LstRcd.PwdExpI 92
O LstRcd.PwdExpD 104
O LstRcd.PrvSgoD 115
O LstRcd.PwdChgD 126
**
OQSYSPRT EF LstTrl 1
O TrlTxt 34
**-- Write detail line: ------------------------------------------------**
P WrtDtlLin B
D Pi
/Free
WrtLstHdr( 3 );
Except DtlLin;
/End-Free
P WrtDtlLin E
**-- Write list header: ------------------------------------------------**
P WrtLstHdr B
D Pi
D PxOvrFlwRel 10i 0 Const Options( *NoPass )
/Free
If %Parms = *Zero;
Except Header;
Except LstHdr;
Else;
If PrtLinInf.CurLin > PrtLinInf.OvfLin - PxOvrFlwRel;
Except Header;
Except LstHdr;
EndIf;
EndIf;
/End-Free
P WrtLstHdr E
**-- Write list trailer: -----------------------------------------------**
P WrtLstTrl B
D Pi
D PxTrlTxt 32a Const
/Free
TrlTxt = PxTrlTxt;
Except LstTrl;
/End-Free
P WrtLstTrl E
**-- Convert system DTS to date: ---------------------------------------**
P CvtDtsDat B
D Pi d
D PxSysDts 8a Value
D MI_DTS s 20a
/Free
CvtDtf( '*DTS': PxSysDts: '*YYMD': MI_DTS: *Zero );
Return %Date( %Timestamp( MI_DTS: *ISO0 ));
/End-Free
P CvtDtsDat E
**-- Get system name: --------------------------------------------------**
P GetSysNam B
D Pi 8a Varying
**
**-- Local variables:
D Idx s 10i 0
D SysNam s 8a Varying
**
D RtnAtrLen s 10i 0
D NetAtrNbr s 10i 0 Inz( %Elem( NetAtr ))
D NetAtr s 10a Dim( 1 )
**
D RtnVar Ds Qualified
D RtnVarNbr 10i 0
D RtnVarOfs 10i 0 Dim( %Elem( NetAtr ))
D RtnVarDta 1024a
D RtnAtr Ds Qualified Based( RtnValPtr )
D AtrNam 10a
D DtaTyp 1a
D InfSts 1a
D AtrLen 10i 0
D Atr 1008a
/Free
RtnAtrLen = %Elem( NetAtr ) * 24 + ( %Size( SysNam )) + 4;
NetAtr(1) = 'SYSNAME';
RtvNetAtr( RtnVar
: RtnAtrLen
: NetAtrNbr
: NetAtr
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
SysNam = '';
Else;
For Idx = 1 to RtnVar.RtnVarNbr;
RtnValPtr = %Addr( RtnVar ) + RtnVar.RtnVarOfs(Idx);
If RtnAtr.AtrNam = 'SYSNAME';
SysNam = %SubSt( RtnAtr.Atr: 1: RtnAtr.AtrLen );
EndIf;
EndFor;
EndIf;
Return SysNam;
/End-Free
P GetSysNam E
**-- Get user creator: -------------------------------------------------**
P GetUsrCrt B Export
D Pi 10a
D PxUsrPrf 10a Value
**
D OBJD0300 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D ObjCrt 10a Overlay( OBJD0300: 220 )
/Free
RtvObjD( OBJD0300
: %Size( OBJD0300 )
: 'OBJD0300'
: PxUsrPrf + 'QSYS'
: '*USRPRF'
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return *Blanks;
Else;
Return OBJD0300.ObjCrt;
EndIf;
/End-Free
P GetUsrCrt E
**-- Send completion message: ------------------------------------------**
P SndCmpMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
/Free
SndPgmMsg( 'CPF9897'
: 'QCPFMSG *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: ANZPWDCHG
Type : CMD
/*-------------------------------------------------------------------*/
/* */
/* Compile options: */
/* */
/* CrtCmd Cmd( ANZPWDCHG ) */
/* Pgm( ANZPWDCHG ) */
/* SrcMbr( ANZPWDCHG ) */
/* */
/*-------------------------------------------------------------------*/
Cmd Prompt( 'Analyze User PwdChgDate')
PARM KWD(CHGDAYS) TYPE(*DEC) LEN(5 0) MIN(1) +
EXPR(*YES) PROMPT('Over user password change date')
PARM KWD(EXPACT) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*PRINT) VALUES(*PRINT *DISABLED +
*EXPIRED) EXPR(*YES) PROMPT('Action for +
over change days')
Parm SYSPRF *Char 4 +
Dft( *NO ) +
Rstd( *YES ) +
SpcVal(( *YES ) +
( *NO )) +
Expr( *YES ) +
Prompt( 'Include system profiles' )
File : QCLSRC
Member: ANZPWDCHGC
Type : CLP
Usage : CRTCLPGM ANZPWDCHGC
此程式範例為全系統使用系統值 QPWDEXPITV - 10 當作密碼有效期限，並列印出報表供檢覈。
若符合使用需求才修改下列原始碼編譯後再執行 ANZPWDCHG CHGDAYS( &PWDEXPITVN ) EXPACT(*EXPIRED) 設定密碼過期。
請小心使用本範例。
亦可直接執行指令 ANZPWDCHG CHGDAYS( 80 ) EXPACT(*PRINT) 產生報表。
PGM
DCL &PWDEXPITV *CHAR 6
DCL &PWDEXPITVN *DEC 5
RTVSYSVAL SYSVAL(QPWDEXPITV) RTNVAR(&PWDEXPITV)
IF (&PWDEXPITV *EQ '*NOMAX') GOTO END
CHGVAR &PWDEXPITVN &PWDEXPITV
CHGVAR &PWDEXPITVN (&PWDEXPITVN - 10)
/* 設定過期 */
/* ANZPWDCHG CHGDAYS(&PWDEXPITVN) EXPACT(*EXPIRED) */
/* 印報表 */
ANZPWDCHG CHGDAYS(&PWDEXPITVN) EXPACT(*PRINT)
MONMSG CPF0000
END:
ENDPGM
星期二, 11月 07, 2023
2007-03-13 如何針對系統中密碼過期超過指定天數的 user , 將之設定為失效(DISABLED)?(Command: ANZUSREXP API:QSYRUSRI)
如何針對系統中密碼過期超過指定天數的 user , 將之設定為失效(DISABLED)?(Command: ANZUSREXP API:QSYRUSRI)
Vengoal AS/400 日誌
張純銀 (Vengoal Chang) 的日誌
AS/400 相關資訊分享
王春元部落格 易網打勁 易經教學
Vengoal 新網頁
所有過往電子報請至 Vengoal AS/400 日誌瀏覽
若您有任何 AS/400 報表格式轉換(TXT, EXCEL, PDF, email)或報表儲存至 windows 平台及列印或難字處理需求, 請洽中菲電腦 (02)25117233 分機 609 蘇先生.
某大陸網站將我的電子報內容轉成簡體, 一字不差且未註明出處, 在此建議若欲轉載請註明來源.
如何針對系統中密碼過期超過指定天數的 user , 將之設定為失效(DISABLED)?(Command: ANZUSREXP API:QSYRUSRI)
File : QRPGLESRC
Member: ANZUSREXP
Type : RPGLE
Usage : CRTBNDPGM ANZUSREXP
OS : V5R2(含)以後
**
** Program . . : ANZUSREXP
** Description : Analyze user profiles expiration by expired date
** and do action
** Author . . : Vengoal Chang
**
** Date . . : 2007/03/13
**
**
**-- Control specification: --------------------------------------------**
H Option( *SrcStmt: *NoDebugIo ) DftActGrp(*NO)
**-- Printer file:
FQSYSPRT O F 132 Printer InfDs( PrtLinInf ) OflInd( *InOf )
**-- Printer file information:
D PrtLinInf Ds Qualified
D OvfLin 5i 0 Overlay( PrtLinInf: 188 )
D CurLin 5i 0 Overlay( PrtLinInf: 367 )
D CurPag 5i 0 Overlay( PrtLinInf: 369 )
**-- System information:
D PgmSts SDs Qualified
D PgmNam *Proc
**-- API error data structure:
D ERRC0100 Ds Qualified
D BytPrv 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 128a
**-- Global variables:
D LstTim s 6s 0
D SysNam s 8a
D TrlTxt s 32a
D Workdate s d
D CmdStr S 1024 INZ
D CmdLen S 15P 5 INZ(1024)
**-- List record:
D LstRcd Ds Qualified
D UsrPrf 10a
D PrfSts 10a
D PwdExpI 4a
D PwdExpD 8a
D InvSgo 3i 0
D GrpPrf 10a
D PwdI 4a
D LmtCap 4a
D SpcAut 4a
D UsrCls 10a
D PrvSgoD 8a
D PwdChgD 8a
**-- List API parameters:
D LstApi Ds Qualified Inz
D RtnRcdNbr 10i 0
D GrpNam 10a
D SltCri 10a
**-- List information:
D LstInf Ds Qualified
D RcdNbrTot 10i 0
D RcdNbrRtn 10i 0
D Handle 4a
D RcdLen 10i 0
D InfSts 1a
D Dts 13a
D LstSts 1a
D 1a
D InfLen 10i 0
D Rcd1 10i 0
D 40a
**-- User information:
D AUTU0100 Ds Qualified
D UsrPrf 10a
D UsrGrpI 1a
D GrpMbrI 1a
**-- User information:
D USRI0300 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D UsrPrf 10a
D PrvSgoDts 13a Overlay( USRI0300: 19 )
D PrvSgoDat 7a Overlay( USRI0300: 19 )
D PrvSgoTim 6a Overlay( USRI0300: 26 )
D InvSgo 10i 0 Overlay( USRI0300: 33 )
D PrfSts 10a Overlay( USRI0300: 37 )
D PwdChgDat 8a Overlay( USRI0300: 47 )
D NoPwdI 1a Overlay( USRI0300: 55 )
D PwdExpDat 8a Overlay( USRI0300: 61 )
D PwdExpI 1a Overlay( USRI0300: 73 )
D UsrCls 10a Overlay( USRI0300: 74 )
D SpcAut 15a Overlay( USRI0300: 84 )
D GrpPrf 10a Overlay( USRI0300: 99 )
D LmtCap 10a Overlay( USRI0300: 189 )
**-- Open list of authorized users:
D LstAutUsr Pr ExtPgm( 'QGYOLAUS' )
D LuRcvVar 65535a Options( *VarSize )
D LuRcvVarLen 10i 0 Const
D LuLstInf 80a
D LuNbrRcdRtn 10i 0 Const
D LuFmtNam 8a Const
D LuSltCri 10a Const
D LuGrpNam 10a Const
D LuError 1024a Options( *VarSize )
**-- Get list entry:
D GetLstEnt Pr ExtPgm( 'QGYGTLE' )
D GlRcvVar 65535a Options( *VarSize )
D GlRcvVarLen 10i 0 Const
D GlHandle 4a Const
D GlLstInf 80a
D GlNbrRcdRtn 10i 0 Const
D GlRtnRcdNbr 10i 0 Const
D GlError 1024a Options( *VarSize )
**-- Close list:
D CloseLst Pr ExtPgm( 'QGYCLST' )
D ClHandle 4a Const
D ClError 1024a Options( *VarSize )
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D SpMsgId 7a Const
D SpMsgFq 20a Const
D SpMsgDta 128a Const
D SpMsgDtaLen 10i 0 Const
D SpMsgTyp 10a Const
D SpCalStkE 10a Const Options( *VarSize )
D SpCalStkCtr 10i 0 Const
D SpMsgKey 4a
D SpError 32767a Options( *VarSize )
**-- Convert date & time:
D CvtDtf Pr ExtPgm( 'QWCCVTDT' )
D CdInpFmt 10a Const
D CdInpVar 17a Const Options( *VarSize )
D CdOutFmt 10a Const
D CdOutVar 17a Options( *VarSize )
D CdError 10i 0 Const
**-- Retrieve net attribute:
D RtvNetAtr Pr ExtPgm( 'QWCRNETA' )
D RnRcvVar 32767a Options( *VarSize )
D RnRcvVarLen 10i 0 Const
D RnNbrNetAtr 10i 0 Const
D RnNetAtr 10a Const Dim( 256 )
D Options( *VarSize )
D RnError 32767a Options( *VarSize )
**-- Retrieve user information:
D RtvUsrInf Pr ExtPgm( 'QSYRUSRI' )
D RuRcvVar 32767a Options( *VarSize )
D RuRcvVarLen 10i 0 Const
D RuFmtNam 10a Const
D RuUsrPrf 10a Const
D RuError 32767a Options( *VarSize )
**-- Retrieve object description:
D RtvObjD Pr ExtPgm( 'QUSROBJD' )
D RoRcvVar 32767a Options( *VarSize )
D RoRcvVarLen 10i 0 Const
D RoFmtNam 8a Const
D RoObjNamQ 20a Const
D RoObjTyp 10a Const
D RoError 32767a Options( *VarSize )
**-- Convert system DTS to date:
D CvtDtsDat Pr d
D PxSysDts 8a Value
**-- Get system name:
D GetSysNam Pr 8a Varying
**-- Get user creator:
D GetUsrCrt Pr 10a
D PxUsrPrf 10a Value
**-- Send completion message:
D SndCmpMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- Write detail line:
D WrtDtlLin Pr
**-- Write list header:
D WrtLstHdr Pr
D PxOvrFlwRel 10i 0 Const Options( *NoPass )
**-- Write list trailer:
D WrtLstTrl Pr
D PxTrlTxt 32a Const
**-- Call system command:
D QCMDEXC PR ExtPgm('QCMDEXC')
D Cmd 500A options(*varsize) Const
D CmdLen 15P 5 Const
**-- Entry parameters:
D ANZUSREXP Pr
D PxOverDays 5 0
D PxActOpt 10a
D PxSysPrf 4a
**
D ANZUSREXP Pi
D PxOverDays 5 0
D PxActOpt 10a
D PxSysPrf 4a
/Free
ExSr GetWorkdate;
LstApi.RtnRcdNbr = 1;
LstApi.SltCri = '*ALL';
LstApi.GrpNam = '*NONE';
LstAutUsr( AUTU0100
: %Size( AUTU0100 )
: LstInf
: 1
: 'AUTU0100'
: LstApi.SltCri
: LstApi.GrpNam
: ERRC0100
);
If ERRC0100.BytAvl = *Zero;
DoW LstInf.LstSts <> '2' Or LstInf.RcdNbrTot >= LstApi.RtnRcdNbr;
ExSr GetPrfInf;
LstApi.RtnRcdNbr = LstApi.RtnRcdNbr + 1;
GetLstEnt( AUTU0100
: %Size( AUTU0100 )
: LstInf.Handle
: LstInf
: 1
: LstApi.RtnRcdNbr
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Leave;
EndIf;
EndDo;
CloseLst( LstInf.Handle: ERRC0100 );
EndIf;
WrtLstTrl( '*** E N D O F L I S T ***' );
SndCmpMsg( 'List has been printed.' );
*InLr = *On;
Return;
BegSr GetPrfInf;
RtvUsrInf( USRI0300
: %Size( USRI0300 )
: 'USRI0300'
: AUTU0100.UsrPrf
: ERRC0100
);
If ERRC0100.BytAvl = *Zero;
ExSr ChkPrfInf;
EndIf;
EndSr;
BegSr ChkPrfInf;
If PxSysPrf = '*YES' Or GetUsrCrt( USRI0300.UsrPrf ) <> '*IBM';
Select;
//When USRI0300.PwdExpI = 'Y';
// ExSr WrtPrfInf;
When USRI0300.PwdExpDat = *Blanks;
// No expiration date - skip user profile.
//When CvtDtsDat( USRI0300.PwdExpDat ) <= %Date();
When CvtDtsDat( USRI0300.PwdExpDat ) <= WorkDate;
If (PxActOpt = '*DISABLED');
CmdStr = 'CHGUSRPRF USRPRF(' + %trim(USRI0300.UsrPrf) +
') STATUS(*DISABLED)';
CmdLen = %len(%trim(CmdStr));
QCMDEXC(%trim(CmdStr) : CmdLen);
Else;
ExSr WrtPrfInf;
EndIf;
EndSl;
EndIf;
EndSr;
BegSr WrtPrfInf;
LstRcd.UsrPrf = USRI0300.UsrPrf;
LstRcd.PrfSts = USRI0300.PrfSts;
LstRcd.InvSgo = USRI0300.InvSgo;
LstRcd.GrpPrf = USRI0300.GrpPrf;
LstRcd.LmtCap = USRI0300.LmtCap;
LstRcd.UsrCls = USRI0300.UsrCls;
If USRI0300.PwdExpDat = *Blanks;
LstRcd.PwdExpD = '*NONE';
Else;
LstRcd.PwdExpD = %Char( CvtDtsDat( USRI0300.PwdExpDat ): *JOBRUN );
EndIf;
If USRI0300.PwdChgDat = *Blanks;
LstRcd.PwdChgD = '*NONE';
Else;
LstRcd.PwdChgD = %Char( CvtDtsDat( USRI0300.PwdChgDat ): *JOBRUN );
EndIf;
If USRI0300.PrvSgoDts = *Blanks;
LstRcd.PrvSgoD = '*NONE';
Else;
LstRcd.PrvSgoD = %Char( %Date( USRI0300.PrvSgoDat: *CYMD0 )
: *JOBRUN
);
EndIf;
If USRI0300.PwdExpI = 'Y';
LstRcd.PwdExpI = '*YES';
Else;
LstRcd.PwdExpI = '*NO';
EndIf;
If USRI0300.NoPwdI = 'Y';
LstRcd.PwdI = '*NO';
Else;
LstRcd.PwdI = '*YES';
EndIf;
If USRI0300.SpcAut = 'NNNNNNNN';
LstRcd.SpcAut = '*NO';
Else;
LstRcd.SpcAut = '*YES';
EndIf;
WrtDtlLin();
EndSr;
BegSr *InzSr;
LstTim = %Int( %Char( %Time(): *ISO0));
SysNam = GetSysNam();
WrtLstHdr();
EndSr;
/End-Free
C GetWorkDate BegSr
C eval Workdate = %Date()
C SUBDUR PxOverDays:*D Workdate
C EndSr
**-- Printer file definition: ------------------------------------------**
OQSYSPRT EF Header 2 2
O UDATE Y 8
O LstTim 18 ' : : '
O 36 'System:'
O SysNam 45
O 82 'User profile exceptions'
O 107 'Program:'
O PgmSts.PgmNam 118
O 126 'Page:'
O PAGE + 1
**
OQSYSPRT EF LstHdr 1
O 4 'User'
O 17 'Class'
O 29 'Group'
O 42 'Status'
O 53 'Limit'
O 65 'Spc.aut.'
O 75 'Inv.sign.'
O 84 'Password'
O 94 'Pwd.exp.'
O 104 'Exp.date'
O 114 'Sign-on'
O 129 'Pwd. changed'
**
OQSYSPRT EF DtlLin 1
O LstRcd.UsrPrf 10
O LstRcd.UsrCls 22
O LstRcd.GrpPrf 34
O LstRcd.PrfSts 46
O LstRcd.LmtCap 52
O LstRcd.SpcAut 62
O LstRcd.InvSgo Z 70
O LstRcd.PwdI 81
O LstRcd.PwdExpI 92
O LstRcd.PwdExpD 104
O LstRcd.PrvSgoD 115
O LstRcd.PwdChgD 126
**
OQSYSPRT EF LstTrl 1
O TrlTxt 34
**-- Write detail line: ------------------------------------------------**
P WrtDtlLin B
D Pi
/Free
WrtLstHdr( 3 );
Except DtlLin;
/End-Free
P WrtDtlLin E
**-- Write list header: ------------------------------------------------**
P WrtLstHdr B
D Pi
D PxOvrFlwRel 10i 0 Const Options( *NoPass )
/Free
If %Parms = *Zero;
Except Header;
Except LstHdr;
Else;
If PrtLinInf.CurLin > PrtLinInf.OvfLin - PxOvrFlwRel;
Except Header;
Except LstHdr;
EndIf;
EndIf;
/End-Free
P WrtLstHdr E
**-- Write list trailer: -----------------------------------------------**
P WrtLstTrl B
D Pi
D PxTrlTxt 32a Const
/Free
TrlTxt = PxTrlTxt;
Except LstTrl;
/End-Free
P WrtLstTrl E
**-- Convert system DTS to date: ---------------------------------------**
P CvtDtsDat B
D Pi d
D PxSysDts 8a Value
D MI_DTS s 20a
/Free
CvtDtf( '*DTS': PxSysDts: '*YYMD': MI_DTS: *Zero );
Return %Date( %Timestamp( MI_DTS: *ISO0 ));
/End-Free
P CvtDtsDat E
**-- Get system name: --------------------------------------------------**
P GetSysNam B
D Pi 8a Varying
**
**-- Local variables:
D Idx s 10i 0
D SysNam s 8a Varying
**
D RtnAtrLen s 10i 0
D NetAtrNbr s 10i 0 Inz( %Elem( NetAtr ))
D NetAtr s 10a Dim( 1 )
**
D RtnVar Ds Qualified
D RtnVarNbr 10i 0
D RtnVarOfs 10i 0 Dim( %Elem( NetAtr ))
D RtnVarDta 1024a
D RtnAtr Ds Qualified Based( RtnValPtr )
D AtrNam 10a
D DtaTyp 1a
D InfSts 1a
D AtrLen 10i 0
D Atr 1008a
/Free
RtnAtrLen = %Elem( NetAtr ) * 24 + ( %Size( SysNam )) + 4;
NetAtr(1) = 'SYSNAME';
RtvNetAtr( RtnVar
: RtnAtrLen
: NetAtrNbr
: NetAtr
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
SysNam = '';
Else;
For Idx = 1 to RtnVar.RtnVarNbr;
RtnValPtr = %Addr( RtnVar ) + RtnVar.RtnVarOfs(Idx);
If RtnAtr.AtrNam = 'SYSNAME';
SysNam = %SubSt( RtnAtr.Atr: 1: RtnAtr.AtrLen );
EndIf;
EndFor;
EndIf;
Return SysNam;
/End-Free
P GetSysNam E
**-- Get user creator: -------------------------------------------------**
P GetUsrCrt B Export
D Pi 10a
D PxUsrPrf 10a Value
**
D OBJD0300 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D ObjCrt 10a Overlay( OBJD0300: 220 )
/Free
RtvObjD( OBJD0300
: %Size( OBJD0300 )
: 'OBJD0300'
: PxUsrPrf + 'QSYS'
: '*USRPRF'
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return *Blanks;
Else;
Return OBJD0300.ObjCrt;
EndIf;
/End-Free
P GetUsrCrt E
**-- Send completion message: ------------------------------------------**
P SndCmpMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
/Free
SndPgmMsg( 'CPF9897'
: 'QCPFMSG *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: ANZUSREXP
Type : CMD
Usage : CRTCMD CMD(ANZUSREXP) PGM(ANZUSREXP)
OS : V5R2(含)以後
Usage : ANZUSREXP EXPDAYS(10) EXPACT(*PRINT) SYSPRF(*NO)
將密碼過期 10 天的 User 列印出來, 且不包含由系統預設產生的 user
ANZUSREXP EXPDAYS(10) EXPACT(*DISABLED)
將密碼過期 10 天的 User 設定為失效
/*-------------------------------------------------------------------*/
/* */
/* Compile options: */
/* */
/* CrtCmd Cmd( ANZUSREXP ) */
/* Pgm( ANZUSREXP ) */
/* SrcMbr( ANZUSREXP ) */
/* */
/*-------------------------------------------------------------------*/
Cmd Prompt( 'Analyze User Expired' )
PARM KWD(EXPDAYS) TYPE(*DEC) LEN(5 0) MIN(1) +
EXPR(*YES) PROMPT('Over user expired days')
PARM KWD(EXPACT) TYPE(*CHAR) LEN(10) RSTD(*YES) +
DFT(*PRINT) VALUES(*PRINT *DISABLED) +
EXPR(*YES) PROMPT('Action for over +
exipred days')
Parm SYSPRF *Char 4 +
Dft( *YES ) +
Rstd( *YES ) +
SpcVal(( *YES ) +
( *NO )) +
Expr( *YES ) +
Prompt( 'Include system profiles' )
2006-09-30 如何判別使用者對某些物件是否有某些權限?(CHKAUT command with API QSYRUSRA)
如何判別使用者對某些物件是否有某些權限?(CHKAUT command with API QSYRUSRA)
如何判別使用者對某些物件是否有某些權限?(CHKAUT command with API QSYRUSRA)
此指令執行時, 若使用者對物件沒有指定的權限, 會拋出錯誤訊息 CPF9802,
所以於 CLP中可以執行類似如下指令:
CHKAUT USER(TEST) OBJ(QGPL/QCLSRC) OBJTYPE(*FILE) AUT(*ALL)
monmsg cpf9802 exec(do)
/* 無權限處理程序 */
chgvar &Okay '0'
enddo
File : QCLSRC
Member: CHKAUT
Type : CLP
Usage : CRTCLPGM CHKAUT
/*------------------------------------------------------------------*/
/* Programmers Group & Management Resource Copyright 2000 */
/* */
/* \\\ */
/* ( o o ) */
/*------------------------oOO----(_)----OOo-------------------------*/
/* */
/* System name . . . : Technical Support */
/* Program name . . . : CHKAUT */
/* Text . . . . . . . : Check authority to the Object */
/* */
/* Author . . . . . . : Alexander Nubla */
/* Description . . . : This is the CPP for CHKAUT command. */
/* The program checks to determine what */
/* type of authority the user has over */
/* the specified object. */
/* */
/* ooooO Ooooo */
/* ( ) ( ) */
/*-------------------------( )-------------( )----------------------*/
/* (_) (_) */
/* Updated by Vengoal Chang 2006/09/30 */
/*------------------------------------------------------------------*/
pgm (&user /* Check user */ +
&fullobj /* Object name */ +
&objtype /* Object type */ +
&auts ) /* Authorities */
/*--------------------------------------------------------*/
/* declaration */
/*--------------------------------------------------------*/
dcl &user *char 10
dcl &fullobj *char 20
dcl &objtype *char 7
dcl &auts *char 72
dcl &obj *char 10
dcl &objlib *char 10
dcl &nbr *dec 5 0
dcl &objaut *char 10
dcl &authority *char 10
dcl &autreq *char 70
dcl &okay *char 1
dcl &RcvVar *char 93
dcl &VarLen *char 4 x'0000005D'
dcl &Fmtnam *char 8 USRA0100
dcl &Objtyp *char 10
dcl &ErrDta *char 116
dcl &ErrDta2 *char 116
dcl &bin4 *char 4
dcl &Erravl *dec 15
/*--------------------------------------------------------*/
/* error message variables */
/*--------------------------------------------------------*/
dcl &error *lgl /* std err */
dcl &msgid *char 7 /* std err */
dcl &msgkey *char 4 /* std err */
dcl &msgdta *char 100 /* std err */
dcl &msgf *char 10 /* std err */
dcl &msgflib *char 10 /* std err */
dcl &msgtyp *char 10 '*DIAG' /* std err */
dcl &msgtypctr *char 4 X'00000001' /* std err */
dcl &pgmmsgq *char 10 '*' /* std err */
dcl &stkctr *char 4 X'00000001' /* std err */
dcl &errbytes *char 4 X'00000000' /* std err */
monmsg msgid(cpf0000) exec(goto error)
/*--------------------------------------------------------*/
/* Get the object name & library */
/*--------------------------------------------------------*/
chgvar &Obj %sst(&FullObj 1 10)
chgvar &Objlib %sst(&FullObj 11 10)
if (%sst(&Objlib 1 1) = '*' ) do
rtvobjd obj(&Obj) +
objtype(&objtype) +
rtnlib(&Objlib)
enddo
chkobj obj(&Objlib/&Obj) +
objtype(&objtype)
/*--------------------------------------------------------*/
/* Retrieve user authority to the object */
/*--------------------------------------------------------*/
chgvar &RcvVar ' '
chgvar &Objtyp &objtype
chgvar &ErrDta X'00000074'
call pgm(QSYRUSRA) +
parm(&RcvVar +
&VarLen +
&Fmtnam +
&User +
&FullObj +
&Objtyp +
&ErrDta)
chgvar &bin4 %sst(&ErrDta 5 4)
chgvar &ErrAvl %bin(&bin4)
/*----------------------------------------------*/
/* Error found on the API, send error message */
/*----------------------------------------------*/
if (&ErrAvl > 0) do
chgvar &ErrDta2 %sst(&ErrDta 1 &ErrAvl)
chgvar &Msgid %sst(&ErrDta2 9 7)
chgvar &MsgDta %sst(&ErrDta2 17 100)
if (&Msgid *ne ' ') do
sndpgmmsg msgid(&Msgid) +
msgdta(&MsgDta) +
msgf(QCPFMSG) +
msgtype(*escape)
enddo
enddo
chgvar &ObjAut %sst(&RcvVar 9 10)
/*--------------------------------------------------------*/
/* Get the list of authorities requested */
/*--------------------------------------------------------*/
chgvar &Nbr %bin(&Auts 1 2)
chgvar &Nbr (&Nbr * 10)
chgvar &AutReq %sst(&Auts 3 &Nbr)
/*--------------------------------------------------------*/
/* Check the requested authorities Vs &ObjAut returned */
/*--------------------------------------------------------*/
chkaut:
chgvar &Authority %sst(&AutReq 1 10)
If (&Authority = ' ' ) goto nomore
chgvar &Okay 'Y'
If (&Authority *eq '*ALL' *and +
&Objaut *ne '*ALL') do
chgvar &Okay 'N'
enddo
If (&Authority *eq '*CHANGE' *and +
&Objaut *ne '*ALL' *and +
&Objaut *ne '*CHANGE') do
chgvar &Okay 'N'
enddo
If (&Authority *eq '*USE' *and +
&Objaut *ne '*ALL' *and +
&Objaut *ne '*CHANGE' *and +
&Objaut *ne '*USE') do
chgvar &Okay 'N'
enddo
If (&Authority *eq '*EXCLUDE' *and +
&Objaut *ne '*EXCLUDE' ) do
chgvar &Okay 'N'
enddo
If (&Authority *eq '*OBJOPR') do
chgvar &Okay %sst(&RcvVar 20 1)
enddo
If (&Authority *eq '*OBJMGT') do
chgvar &Okay %sst(&RcvVar 21 1)
enddo
If (&Authority *eq '*OBJEXIST') do
chgvar &Okay %sst(&RcvVar 22 1)
enddo
If (&Authority *eq '*OBJALTER') do
chgvar &Okay %sst(&RcvVar 92 1)
enddo
If (&Authority *eq '*OBJREF') do
chgvar &Okay %sst(&RcvVar 93 1)
enddo
If (&Authority *eq '*READ' ) do
chgvar &Okay %sst(&RcvVar 23 1)
enddo
If (&Authority *eq '*ADD') do
chgvar &Okay %sst(&RcvVar 24 1)
enddo
If (&Authority *eq '*UPDATE') do
chgvar &Okay %sst(&RcvVar 25 1)
enddo
If (&Authority *eq '*DELETE') do
chgvar &Okay %sst(&RcvVar 26 1)
enddo
If (&Authority *eq '*EXECUTE') do
chgvar &Okay %sst(&RcvVar 81 1)
enddo
/*--------------------------------------------------------*/
/* NOT AUTHORIZED! */
/*--------------------------------------------------------*/
If (&Okay *eq 'N' ) do
sndpgmmsg msgid(CPF9802) +
msgf(QCPFMSG) +
msgdta(&Obj || &Objlib || +
%sst(&Objtyp 2 6)) +
msgtype(*escape)
enddo
chgvar &AutReq %sst(&AutReq 11 60)
goto chkaut
nomore:
return
/*--------------------------------------------------------*/
/* error routine: */
/*--------------------------------------------------------*/
error:
if &error (goto errordone)
else chgvar &error '1'
/*----------------------------------------------*/
/* move all *DIAG message to *PRV program queue */
/*----------------------------------------------*/
call QMHMOVPM (&msgkey +
&msgtyp +
&msgtypctr +
&pgmmsgq +
&stkctr +
&errbytes)
/*----------------------------------------------*/
/* resend the last *ESCAPE message */
/*----------------------------------------------*/
errordone:
call QMHRSNEM (&msgkey +
&errbytes)
monmsg cpf0000 exec(do)
sndpgmmsg msgid(cpf3cf2) msgf(QCFPMSG) +
msgdta('QMHRSNEM') msgtype(*escape)
monmsg cpf0000
enddo
end: endpgm
File : QCMDSRC
Member: CHKAUT
Type : CMD
Usage : CRTCMD CMD(yourlib/CHKAUT) PGM(yourlib/CHKAUT)
/*-----------------------------------------------------------------*/
/* Programmers Group & Management Resource Copyright 2000 */
/* */
/* \\\ */
/* ( o o ) */
/*------------------------oOO----(_)----OOo------------------------*/
/* */
/* System name . . . : Technical Support */
/* Command name . . . : CHKAUT */
/* Text . . . . . . . : Check Authority of User */
/* */
/* Author . . . . . . : Alexander Nubla */
/* */
/* ooooO Ooooo */
/* ( ) ( ) */
/*-----------------------( )-------------( )-----------------------*/
/* (_) (_) */
/* */
/* Command parameters: */
/* */
/* ALLOW((*ALL) */
/* */
/* CPP: CHKAUT */
/* */
/*-----------------------------------------------------------------*/
CMD PROMPT('Check Authority')
/* -------------------------------------------- */
/* User id */
/* -------------------------------------------- */
PARM KWD(USER) TYPE(*NAME) LEN(10) +
SPCVAL((*CURRENT)) MIN(1) PROMPT('User')
/* -------------------------------------------- */
/* Object */
/* -------------------------------------------- */
PARM KWD(OBJ) TYPE(QOBJ) MIN(1) PROMPT('Object')
QOBJ: QUAL TYPE(*NAME) LEN(10) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL)) EXPR(*YES) PROMPT('Library')
/* -------------------------------------------- */
/* Object type */
/* -------------------------------------------- */
PARM KWD(OBJTYPE) TYPE(*NAME) LEN(7) +
SPCVAL((*ALRTBL) (*AUTL) (*BNDDIR) +
(*CFGL) (*CHTFMT) (*CLD) (*CLS) (*CMD) +
(*CNNL) (*COSD) (*CRG) (*CRQD) (*CSI) +
(*CSPMAP) (*CSPTBL) (*CTLD) (*DEVD) +
(*DTAARA) (*DTADCT) (*DTAQ) (*EDTD) +
(*FCT) (*FILE) (*FNTRSC) (*FNTTBL) +
(*FORMDF) (*FTR) (*GSS) (*IPXD) (*JOBD) +
(*JOBQ) (*JRN) (*JRNRCV) (*LIB) (*LIND) +
(*LOCALE) (*MEDDFN) (*MENU) (*MGTCOL) +
(*MODD) (*MODULE) (*MSGF) (*MSGQ) (*M36) +
(*M36CFG) (*NODGRP) (*NODL) (*NTBD) +
(*NWID) (*NWSD) (*OUTQ) (*OVL) (*PAGDFN) +
(*PAGSEG) (*PDG) (*PGM) (*PNLGRP) +
(*PRDDFN) (*PRDLOD) (*PSFCFG) (*QMFORM) +
(*QMQRY) (*QRYDFN) (*RCT) (*SBSD) +
(*SCHIDX) (*SPADCT) (*SQLPKG) (*SQLUDT) +
(*SRVPGM) (*SSND) (*SVRSTG) (*TBL) +
(*USRIDX) (*USRPRF) (*USRQ) (*USRSPC) +
(*VLDL) (*WSCST)) MIN(1) EXPR(*YES) +
PROMPT('Object type')
/* -------------------------------------------- */
/* Object authority */
/* -------------------------------------------- */
PARM KWD(AUT) TYPE(*CHAR) LEN(10) RSTD(*YES) +
VALUES(*OBJALTER *OBJEXIST *OBJMGT +
*OBJOPR *OBJREF *ADD *DELETE *EXECUTE +
*READ *UPDATE) SNGVAL((*ALL) (*CHANGE) +
(*USE) (*EXCLUDE)) MIN(1) MAX(7) +
EXPR(*YES) PROMPT('Authority')
訂閱：
文章 (Atom)