如何判斷系統是否在限制(restricted state)狀態中？(Command RTVSYSSTE with API QWCRSSTS)
有時候應用程式必須要在系統為限制(restricted state)狀態下才能執行，所以需要利用 API QWCRSSTS 判斷系統狀態
，防止應用程式在一般狀態下執行。
此指令 RTVSYSSTE 取得目前系統是否為限制狀態。
回傳值為 '1' 即為限制(restricted state)狀態
回傳值為 '0' 即為一般狀態狀態
File : QCLSRC
Member : RTVSYSSTEC
Type : CLP
Usage : CRTCLPGM RTVSYSSTEC
/* =============================================================== */
/* = Program....... RtvSysSteC = */
/* = Description... Retrieve system state information = */
/* =============================================================== */
Pgm (&RstdState)
/* =============================================================== */
/* = Declarations = */
/* =============================================================== */
Dcl &RstdState *Char ( 1 )
/* =============================================================== */
/* = Restricted state flag. = */
/* = 0 System is not in restricted state. = */
/* = 1 System is in restricted state = */
/* =============================================================== */
Dcl &RcvVar *Char ( 68 )
Dcl &RcvVarLen *Char ( 4 )
Dcl &Format *Char ( 8 )
Dcl &Reset *Char ( 10 )
Dcl &APIError *Char ( 272 )
Dcl &BytesProv *Char ( 4 )
Dcl &BytesAvail *Char ( 4 )
Dcl &MsgID *Char ( 7 )
Dcl &MsgDta *Char ( 256 )
Dcl &MsgF *Char ( 10 )
Dcl &MsgFLib *Char ( 10 )
/* =============================================================== */
/* = Global error monitor = */
/* =============================================================== */
MonMsg ( CPF0000 MCH0000 ) Exec( +
GoTo Error )
/* =============================================================== */
/* = Initialize variables = */
/* =============================================================== */
ChgVar &Format ( 'SSTS0200' )
ChgVar &Reset ( '*YES' )
ChgVar ( %Bin( &RcvVarLen ) ) ( 68 )
ChgVar ( %Bin( &BytesProv ) ) ( 272 )
ChgVar ( %Bin( &BytesAvail ) ) ( 0 )
ChgVar ( %Sst( &APIError 1 4 ) ) ( &BytesProv )
ChgVar ( %Sst( &APIError 5 4 ) ) ( &BytesAvail )
/* =============================================================== */
/* = Retrieve system status information = */
/* =============================================================== */
Call QWCRSSts +
( +
&RcvVar +
&RcvVarLen +
&Format +
&Reset +
&APIError +
)
/* --------------------------------------------------------------- */
/* - Check for error and percolate if one exists - */
/* --------------------------------------------------------------- */
ChgVar &BytesAvail ( %Sst( &APIError 5 4 ) )
If ( %Bin( &BytesAvail ) *NE 0 ) +
Do
ChgVar &MsgID ( %Sst( &APIError 9 7 ) )
ChgVar &MsgDta ( %Sst( &APIError 17 256 ) )
ChgVar &MsgF ( 'QCPFMSG' )
ChgVar &MsgFLib ( 'QSYS' )
GoTo SndMsg
EndDo
/* =============================================================== */
/* = Extract system status information = */
/* =============================================================== */
ChgVar &RstdState ( %Sst( &RcvVar 31 1 ) )
/* =============================================================== */
/* = Exit program = */
/* =============================================================== */
Return
/* =============================================================== */
/* = Error routine = */
/* =============================================================== */
Error:
RcvMsg MsgType( *Excp ) +
MsgDta( &MsgDta ) +
MsgID( &MsgID ) +
MsgF( &MsgF ) +
MsgFLib( &MsgFLib )
MonMsg ( CPF0000 MCH0000 )
SndMsg:
SndPgmMsg MsgID( &MsgID ) +
MsgF( &MsgFLib/&MsgF ) +
MsgDta( &MsgDta ) +
MsgType( *Escape )
MonMsg ( CPF0000 MCH0000 )
/* =============================================================== */
/* = End of program = */
/* =============================================================== */
EndPgm
File : QCMDSRC
Member : RTVSYSSTE
Type : CMD
Usage : CRTCMD CMD(RTVSYSSTE) PGM(lib/RTVSYSSTEC) ALLOW(*IPGM *BPGM)
/* =============================================================== */
/* = Command....... RtvSysSte = */
/* = CPP........... RtvSysSteC = */
/* = Description... Retrieve System State = */
/* = = */
/* = = */
/* = CrtCmd Cmd( RtvSysSte ) = */
/* = Pgm( RtvSysSteC ) = */
/* = SrcFile( YourSourceFile ) = */
/* = Allow( *Ipgm *Bpgm ) = */
/* =============================================================== */
/* = Date : 2009/01/10 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Cmd Prompt( 'Retrieve System State')
Parm Kwd( RstdState ) +
Type( *Char ) +
RtnVal( *Yes ) +
Len( 1 ) +
Prompt( 'Restricted state' )
File : QCLSRC
Member : RTVSYSSTET
Type : CLP
Usage : CRTCLPGM RTVSYSSTET
測試程式 CALL RTVSYSSTET
PGM
DCL &RSTDSTATE *CHAR 1
DCL &MSGDTA *CHAR 256
RTVSYSSTE RSTDSTATE(&RSTDSTATE)
/* =============================================================== */
/* = Insert your code that uses the system status values = */
/* =============================================================== */
If (&RstdState *EQ '1') +
ChgVar &MsgDta 'Current system state is in restricted state'
Else +
ChgVar &MsgDta 'Current system state is not in restricted state'
SndPgmMsg MsgId(CPF9898) Msgf(QCPFMSG) +
MsgDta(&MsgDta)
ENDPGM
星期三, 11月 08, 2023
2009-01-10 如何判斷系統是否在限制(restricted state)狀態中？(Command RTVSYSSTE with API QWCRSSTS)
星期二, 11月 07, 2023
2007-06-05 如何取得現有系統支援的 OS 版本 ?(API QSZRTVPR, QSZCHKTG)
如何取得現有系統支援的 OS 版本 ?(API QSZRTVPR, QSZCHKTG)
(如編譯程式參數 TGTRLS 及 SAVLIB,SAVOBJ參數 TGTRLS)
當你想讓備份程式自動指定非現有 TGTRLS 時,就可利用此 API 取得現有系統所支援的舊版本 OS.
File : QCLSRC
Member: CHKTGTRLSC
Type : CLP
Usage : CRTCLPGM CHKTGTRLSC
CALL CHKTGTRLSC
Reference:
Retrieve Product Information (QSZRTVPR) retrieves information about a specific product load for a software product
http://publib.boulder.ibm.com/infocenter/iseries/v5r4/topic/apis/qszrtvpr.htm
Check Target Release (QSZCHKTG) verifies that a valid target release value is specified on a CL command that supports the TGTRLS parameter
http://publib.boulder.ibm.com/infocenter/iseries/v5r4/topic/apis/qszchktg.htm
PGM
DCL &RELEASE *CHAR 6
DCL &TGTRLS *CHAR 10
DCL &VLDTGTRLS *CHAR 6
DCL &SPTRLSOS *CHAR 6
DCL &RCVR *CHAR 784
DCL &RCVRLEN *CHAR 4 VALUE(X'00000310')
DCL &FORMAT *CHAR 8 VALUE('PRDR0700')
DCL &PRDINFO *CHAR 27 VALUE('*OPSYS V1R3M00000*CODE ')
DCL &ERRCODE *CHAR 4 VALUE(X'00000000')
DCL &BYTRTN *DEC 5 0
DCL &NBRRLSRTN *DEC 5 0
DCL &STROFFSET *DEC 5 0
DCL &IDX *DEC 5 0
DCL &NBRSPTRLSC *CHAR 4
CALL QSYS/QSZRTVPR PARM(&RCVR &RCVRLEN &FORMAT &PRDINFO &ERRCODE)
CHGVAR &BYTRTN %BIN(&RCVR 5 4)
CHGVAR &NBRRLSRTN %BIN(&RCVR 9 4)
CHGVAR &IDX 1
CHGVAR &STROFFSET 17
LOOP:
IF (&IDX *GT &NBRRLSRTN) GOTO END
CHGVAR &RELEASE (%SST(&RCVR &STROFFSET 6))
CHGVAR &TGTRLS &RELEASE
CHGVAR %BIN(&NBRSPTRLSC) 1
CHGVAR &ERRCODE X'00000000'
CALL QSYS/QSZCHKTG PARM(&TGTRLS '*SAV' &NBRSPTRLSC &VLDTGTRLS +
&SPTRLSOS &ERRCODE)
MONMSG CPF0C35 *N GOTO NEXT
SNDPGMMSG MSG('THIS SYSTEM SUPPORT RELEASE' |> &VLDTGTRLS)
NEXT:
CHGVAR &IDX (&IDX + 1)
CHGVAR &STROFFSET (&STROFFSET + 6)
GOTO LOOP
END:
ENDPGM
2005-05-21 如何直接取得 OS400 版本資訊 ? (API QSZRTVPR)
如何直接取得 OS400 版本資訊 ? (API QSZRTVPR)
可以利用系統 API QSZRTVPR(Retrieve Product Information)可以直接取得 OS/400 版本資訊
File : QCLSRC
Member: RTVOSLVLC
Type : CLP
Usage : CRTCLPGM RTVOSLVLC
CALL RTVOSLVLC
PGM
DCL &RELEASE *CHAR 6
DCL &RCVR *CHAR 128
DCL &RCVRLEN *CHAR 4 VALUE(X'00000080')
DCL &FORMAT *CHAR 8 VALUE('PRDR0100')
DCL &PRDINFO *CHAR 27 VALUE('*OPSYS *CUR 0000*CODE ')
DCL &ERRCODE *CHAR 4 VALUE(X'00000000')
CALL QSYS/QSZRTVPR PARM(&RCVR &RCVRLEN &FORMAT &PRDINFO &ERRCODE)
CHGVAR &RELEASE (%SST(&RCVR 20 6))
SNDPGMMSG MSG('THIS SYSTEM IS AT RELEASE' |> &RELEASE)
ENDPGM
星期一, 11月 06, 2023
2003-08-21 如何很簡便的取得 OS/400 OS 的版本資訊？(API CEEGPID)
如何很簡便的取得 OS/400 OS 的版本資訊？(API CEEGPID)
取得 OS/400 OS 的版本資訊有多種方式：
1: DSPDTAARA QSS1MRI
2: MATMATR API (2001/03 電子報 如何於 RPG IV 中直接取得系統資訊 ?)
3: CEEGPID Retrieve OS level API(本期範例)
File : QRPGLESRC
Member: RTVOSLVLR
Type : RPGLE
OS version : V3
Usage : CRTBNDRPG RTVOSLVLR
CALL RTVOSLVLR
H DFTACTGRP(*NO) ACTGRP(*NEW)
D VerRelMod S 10I 0
D OSPlatform S 10I 0
C CallB 'CEEGPID'
C Parm VerRelMod
C Parm OSPlatform
C*
C* OSPlatform
C* 2 OS/2
C* 3 MVS/VM/370
C* 4 OS/400
C Select
C When OSPlatform = 2
C 'OS/2' dsply
C When OSPlatform = 3
C 'MVS/VM/370' dsply
C When OSPlatform = 4
C 'OS/400' dsply
C EndSl
C VerRelMod Dsply
C eval *InLr = *On
2003-05-30 如何取得系統現在有幾個線上使用者(Users currently signed on)？
如何取得系統現在有幾個線上使用者(Users currently signed on)？
可以利用 System API QWCRSSTS 取得系統現有狀態，此 API 包含的資訊與 DSPSYSSTS
指令所顯示的資訊是類似的，更包括記憶體區塊的使用情形。
詳細請參考 :
Retrieve System Status (QWCRSSTS) API
http://publib.boulder.ibm.com/iseries/v5r2/ic2924/info/apis/qwcrssts.htm
File : QCLSRC
Member: RTVSIGNONC
Type : CLP
Usage : CRTCLPGM RTVSIGNONC
CALL RTVSIGNONC
/* Program : RTVSIGNONC */
/* System : iSeries */
/* */
/* Description : retrieve the number of users signed on */
/* */
PGM
DCL VAR(&SIGNON) TYPE(*DEC) LEN(9 0)
DCL VAR(&SIGNON_CHR) TYPE(*CHAR) LEN(9)
DCL VAR(&RECEIVER) TYPE(*CHAR) LEN(100)
DCL VAR(&RCV_LEN) TYPE(*CHAR) LEN(4)
DCL var(&RESET) TYPE(*CHAR) LEN(10)
CHGVAR VAR(%BIN(&RCV_LEN)) VALUE(100)
CHGVAR VAR(&RESET) VALUE('*NO')
CALL PGM(QWCRSSTS) PARM(&RECEIVER &RCV_LEN +
'SSTS0100' &RESET X'00000000')
CHGVAR VAR(&SIGNON) VALUE(%BIN(&RECEIVER 25 4))
CHGVAR VAR(&SIGNON_CHR) VALUE(&SIGNON)
SNDPGMMSG MSG('The number of users signed on = ' *CAT +
&SIGNON_CHR)
END: ENDPGM
2003-05-13 如何免手動開關機設定 ASP 硬碟儲存區的臨界值(Threshold Value) (Command DSPASP, CHGASP)?
如何免手動開關機設定 ASP 硬碟儲存區的臨界值(Threshold Value) ?
AS/400(iSeries)的硬碟儲存區是將許多實體的硬碟（例如 10 顆 36G 的硬碟組合成
一個邏輯磁碟區。）組合而成一個 ASP。系統將之視為與記憶體一體，當記憶體不夠用
時，系統會自動將硬碟區視為記憶體的一部份，已增加系統整體效能，由於有如此功能，
為了防止硬碟空間不足，所以需要設定臨界值來通知相關人員採取適當措施（增加硬碟），
但是要更改這個臨界值，需要手動開機設定，步驟較煩瑣，所以在此介紹利用 System API
來完成這項工作。
此工具可適用於 OS/400 V4R4以後，且須具有 *ALLOBJ 或 *SERVICE 特殊權限者才能執行。
File : QCLSRC
Member: DSPASPC
Type : CLP
Usage : CRTCLPGM DSPASPC
PGM
/* ***************************************************************** */
/* This job uses API QYASPOL to determine the current ASP Threshold. */
/* If this is being run Interactively, the details will be displayed */
/* on the users screen, prior to being written to file ASPTHRESH2, */
/* via Query ASPTHRESH. */
/* */
/* */
/* ***************************************************************** */
/* API parameters */
DCL VAR(&RCVR) TYPE(*CHAR) LEN(116)
DCL VAR(&LEN) TYPE(*CHAR) LEN(4)
DCL VAR(&LIST) TYPE(*CHAR) LEN(80)
DCL VAR(&NUMR) TYPE(*CHAR) LEN(4)
DCL VAR(&NUMF) TYPE(*CHAR) LEN(4)
DCL VAR(&FLTR) TYPE(*CHAR) LEN(16)
DCL VAR(&FMT) TYPE(*CHAR) LEN(8) VALUE('YASP0200')
DCL VAR(&ERR) TYPE(*CHAR) LEN(80)
DCL VAR(&FSIZE) TYPE(*CHAR) LEN(4)
DCL VAR(&FKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&FFDSIZE) TYPE(*CHAR) LEN(4)
DCL VAR(&FDATA) TYPE(*CHAR) LEN(4)
/* Terminal Id */
DCL VAR(&TERMINAL) TYPE(*CHAR) LEN(10)
DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
/* ASP No */
DCL VAR(&APIASPNO) TYPE(*DEC) LEN(2 0)
DCL VAR(&ASPNO) TYPE(*CHAR) LEN(2)
/* ASP Threshold */
DCL VAR(&APIASPTHLD) TYPE(*DEC) LEN(2 0)
DCL VAR(&ASPTHLD) TYPE(*CHAR) LEN(2)
/* ASP %used */
DCL VAR(&APIASPUSE) TYPE(*CHAR) LEN(5)
DCL VAR(&PERUSED) TYPE(*DEC) LEN(5 2)
/* ASP Total */
DCL VAR(&APIASPTOT) TYPE(*DEC) LEN(11 0)
DCL VAR(&ASPTOT) TYPE(*CHAR) LEN(11)
/* ASP Available */
DCL VAR(&APIASPAVL) TYPE(*DEC) LEN(11 0)
RTVJOBA JOB(&TERMINAL) TYPE(&TYPE)
CREATEFILE: CRTPF FILE(QGPL/ASPTHRESH) RCDLEN(132)
MONMSG MSGID(CPF0000) EXEC(CLRPFM +
FILE(QGPL/ASPTHRESH))
CRTDTAARA: CRTDTAARA DTAARA(QGPL/ASPTHRESH) TYPE(*CHAR) LEN(2) +
TEXT('ASP Threshold')
MONMSG MSGID(CPF0000) EXEC(CHGDTAARA +
DTAARA(QGPL/ASPTHRESH) VALUE(' '))
CHGVAR VAR(%BIN(&FSIZE 1 4)) VALUE(16)
CHGVAR VAR(%BIN(&FKEY 1 4)) VALUE(1)
CHGVAR VAR(%BIN(&FFDSIZE 1 4)) VALUE(4)
CHGVAR VAR(%BIN(&FDATA 1 4)) VALUE(-1)
CHGVAR VAR(&FLTR) VALUE(&FSIZE *CAT &FKEY *CAT +
&FFDSIZE *CAT &FDATA)
CHGVAR VAR(%BIN(&ERR 1 4)) VALUE(80)
CHGVAR VAR(%BIN(&ERR 5 4)) VALUE(0)
CHGVAR VAR(%SST(&ERR 9 72)) VALUE(' ')
CHGVAR VAR(%BIN(&LEN 1 4)) VALUE(116)
CHGVAR VAR(%BIN(&NUMF 1 4)) VALUE(1)
CHGVAR VAR(%BIN(&NUMR 1 4)) VALUE(1)
/* Call API QYASPOL */
CALL PGM(QGY/QYASPOL) PARM(&RCVR &LEN &LIST &NUMR +
&NUMF &FLTR &FMT &ERR)
/* Parse info received from API */
CHGVAR VAR(&APIASPNO) VALUE(%BIN(&RCVR 3 2))
CHGVAR VAR(&APIASPTOT) VALUE(%BIN(&RCVR 9 4))
CHGVAR VAR(&APIASPAVL) VALUE(%BIN(&RCVR 13 4))
CHGVAR VAR(&APIASPTHLD) VALUE(%bin(&RCVR 63 2))
/* Calculate ASP %used */
CHGVAR VAR(&PERUSED) VALUE(100 - ((&APIASPAVL / +
&APIASPTOT) * 100))
/* Move *DEC to *CHAR fields */
CHGVAR VAR(&APIASPUSE) VALUE(&PERUSED)
CHGVAR VAR(&ASPTOT) VALUE(&APIASPTOT)
CHGVAR VAR(&ASPNO) VALUE(&APIASPNO)
CHGVAR VAR(&ASPTHLD) VALUE(&APIASPTHLD)
IF COND(&TYPE *EQ '0') THEN(GOTO CMDLBL(BATCH))
SNDBRKMSG MSG('ASP No: ' *CAT &ASPNO *CAT ' ASP +
%Threshold: ' *CAT &ASPTHLD *CAT ' +
ASP %Used: ' *CAT &APIASPUSE) +
TOMSGQ(&TERMINAL)
batch:
/* Set up file ASPTHRESH2, containing ASP Threshold% */
CHGDTAARA DTAARA(QGPL/ASPTHRESH) VALUE(&ASPTHLD)
DSPDTAARA DTAARA(QGPL/ASPTHRESH) OUTPUT(*PRINT)
CPYSPLF FILE(QPDSPDTA) TOFILE(QGPL/ASPTHRESH) +
SPLNBR(*LAST) MBROPT(*REPLACE)
RUNQRY: RUNQRY QRYFILE((ASPTHRESH))
ENDPGM
File : QCMDSRC
Member: DSPASP
Type : CMD
Usage : CRTCMD CMD(your-lib/DSPASP) PGM(your-lib/DSPASPC)
/* CPP DSPASPC */
CMD PROMPT('Display ASP Threshold')
File : QCLSRC
Member: CHGASPC
Type : CLP
Usage : CRTCLPGM CHGASPC
/**********************/
/* COMMAND CHGASP CPP */
/**********************/
PGM PARM(&ASP &THRESHOLD)
DCL VAR(&TERMINAL) TYPE(*CHAR) LEN(10)
DCL VAR(&ASP) TYPE(*CHAR) LEN(4)
DCL VAR(&THRESHOLD) TYPE(*CHAR) LEN(4)
DCL VAR(&COUNTER) TYPE(*DEC) LEN(1)
/* API parameters */
DCL VAR(&HANDLE) TYPE(*CHAR) LEN(8)
DCL VAR(&ERROR) TYPE(*CHAR) LEN(96)
DCL VAR(&BYTESPROV) TYPE(*CHAR) LEN(4)
DCL VAR(&BYTESAVAIL) TYPE(*CHAR) LEN(4)
DCL VAR(&EXCEPID) TYPE(*CHAR) LEN(7)
DCL VAR(&RESERVED) TYPE(*CHAR) LEN(1)
DCL VAR(&EXCEPDATA) TYPE(*CHAR) LEN(80)
DCL VAR(&OPKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&OPVAR) TYPE(*CHAR) LEN(8)
DCL VAR(&OPVARLEN) TYPE(*CHAR) LEN(4)
DCL VAR(&FORMAT) TYPE(*CHAR) LEN(8) +
VALUE('DMOP0100')
DCL VAR(&ASPNO) TYPE(*CHAR) LEN(4)
DCL VAR(&ASPTHRESH) TYPE(*CHAR) LEN(4)
RTVJOBA JOB(&TERMINAL)
/* Start DASD Management Session - QYASSDMS API */
CHGVAR VAR(%BIN(&BYTESPROV 1 4)) VALUE(0)
CHGVAR VAR(&ERROR) VALUE(&BYTESPROV *CAT +
&BYTESAVAIL *CAT &EXCEPID *CAT &RESERVED +
*CAT &EXCEPDATA)
STARTSESS: CALL PGM(QYASSDMS) PARM(&HANDLE &ERROR)
MONMSG MSGID(CPFBA21) EXEC(DO) /* session already +
active */
CHGVAR VAR(&COUNTER) VALUE(&COUNTER + 1)
IF COND(&COUNTER *EQ 3) THEN(DO)
SNDBRKMSG MSG('CHGASP: DASD Management session still +
in use - job will now end') TOMSGQ(&TERMINAL)
GOTO CMDLBL(END)
ENDDO
SNDBRKMSG MSG('DASD Management session still in use - +
please wait for 6 mins to allow the +
previous session to end. Press enter to +
continue.') TOMSGQ(&TERMINAL)
DLYJOB DLY(360)
GOTO CMDLBL(STARTSESS)
ENDDO
/* Start DASD Management Operation - QYASSDMO API */
CHGVAR VAR(%BIN(&OPKEY 1 4)) VALUE(1)
CHGVAR VAR(%BIN(&aspno 1 4)) VALUE(&ASP)
CHGVAR VAR(%BIN(&ASPTHRESH 1 4)) VALUE(&THRESHOLD)
CHGVAR VAR(&OPVAR) VALUE(&ASPNO *CAT &ASPTHRESH)
CALL PGM(QYASSDMO) PARM(&HANDLE &OPKEY &OPVAR +
&OPVARLEN &FORMAT &ERROR)
/* End DASD Management Operation - QYASEDMO API */
CALL PGM(QYASEDMO) PARM(&HANDLE &ERROR)
MONMSG MSGID(CPFBA46) /* not active */
/* End DASD Management Session - QYASEDMS API */
CALL PGM(QYASEDMS) PARM(&HANDLE &ERROR)
DSPASP
MONMSG MSGID(CPF0000)
END: ENDPGM
File : QCMDSRC
Member: CHGASP
Type : CMD
Usage : CRTCMD CMD(your-lib/CHGASP) PGM (your-lib/CHGASPC)
/* CPP CHGASPC */
CMD PROMPT(' Set ASP Threshold ')
PARM KWD(ASP) TYPE(*CHAR) LEN(4) RSTD(*NO) +
DFT('1') CHOICE(' Eg ''1'' ') +
PROMPT('Enter ASP No: ''1'', ''2'' etc ')
PARM KWD(THRESHOLD) TYPE(*CHAR) LEN(4) RSTD(*NO) +
DFT('80') CHOICE(' Eg ''80'' ') +
PROMPT('Enter ASP Threshold')
2003-04-11 如何讓多部 AS/400(iSeries) 系統間的使用者設定檔(User Profile)同步 ?
如何讓多部 AS/400(iSeries) 系統間的使用者設定檔(User Profile)同步 ?
如何讓多部 AS/400(iSeries) 系統間的使用者設定檔(User Profile)同步，簡化系
統管理工作？
當您管理電腦系統時（包含 AS/400 iSeries ），有三個動作視您需要記住的，
那就是備份、備份、備份。如果您想晚上睡個好覺，您最好有一個關於資料、程式
及作業系統的備份措施。
但仍然有其他的系統管理議題，例如，如果您有一個重要的應用軟體需要一年 365
天，全天 24 小時不中斷的運作，線上即時複製應用軟體及其資料庫系統將是一個
重要的議題。在今天的資訊服務的運算環境中，系統停機而導致無法對客戶提供服務
是不被接受的。如果您的客戶正在進行交易時，因為您的資訊系統無法及時提供應有
的服務，而被迫中斷正在進行的交易，可以想見，他明天有可能是別人的客戶。因此
，如果遇到災難及系統當機時，您的系統需要能自動切換到另一台伺服器，並繼續執
行，就好像沒事發生一樣。為了要完成讓客戶滿意的目標，您需要找適當的資訊技術
來複製應用軟體、資料及其他系統物件，如使用者設定檔（User profiles）。在
這篇文章中我將討論如何複製使用者設定檔（User profiles）至另一台 iSeries。
使用者設定檔（User profiles）
如何讓各個 AS/400(iSeries) 系統彼此之間有一組相同的使用者，是許多應用軟體
供應商或系統管理人員所面臨的挑戰之一。換句話說，當在提供服務的主要系統增加新
的使用者時，同時主要系統要有一個機制自動增加同一使用者於備份系統中。我們使用
AS/400(iSeries) 系統上二個不同且未經常被使用的功能來完成這個目標，這二個功
能是：程序檢核點(又稱跳出點 exit point)及遠端資料序列(remote data queue)。
在這篇文章中，我們將說明當系統管理人員完成某些動作時，系統能自動使用程序檢核點
(exit point)呼叫一支程式的方法；同時以系統管理人員於系統中新增使用者的動作當
成範例。我們也將說明您如何以遠端資料序列(remote data queue)將資訊自動地從一
個系統傳至另一系統。在範例中，我們也將使用遠端資料序列(remote data queue)將
使用者的資訊自動地從一個系統傳至另一備份系統。
現在開始說明如下：
我們將假設您有兩部 AS/400(iSeries)系統彼此間已也完成相關網路設定，並且已經互
相連接於網路上進行通訊，在這篇文章中我們並不說明相關網路設定的方法您能從網站
http://www.geocities.com/vengoal/ AS/400 初學者手冊中(含APPC與TCP/IP)，取得相關
網路設定的方法。
當在 AS/400(iSeries)系統中複製使用者設定檔（User profiles）的第一個挑戰是
：判斷主要系統中何時新增使用者設定檔，一種方式是，我們可以新增一支程式列出兩個
系統的所有使用者，並比對其中的差異。但這種方式無法做到即時同步更新，所以我們需
要執行一支能即時同步更新更新使用者設定檔的程式，進而達到跨 AS/400(iSeries)系
統間使用者設定檔的同步，這才是這篇文章的主要目的。
我們想要執行這支同步更新使用者設定檔的程式能於新增使用者時，自動完成同步的動作
，很幸運的，系統提供一個程序檢核點(exit point)讓我們能完成這個動作，一個程序
檢核點(exit point)是系統執行某些系統處理程序時，系統會暫停並且呼叫程序檢核點
(exit point)所指定的程式，此程式需要系統管理人員依照自己的需求自行撰寫，而這
支程式稱為程序檢核程式（又稱跳出程式 exit program），表一列出程序檢核程式
（又稱跳出程式 exit program）的部份原始碼，這支程式於主要系統中每次新增使用
者時，會自動地被執行。
您可能會問：我們如何告訴系統執行程序檢核點(exit point)所指定的程式？回答是：
我們需要跟系統註冊相對應動作的程序檢核點(exit point)，我們可以使用下述指令跟
系統註冊新增使用者的程序檢核點(exit point)：
ADDEXITPGM +
EXITPNT(QIBM_QSY_CRT_PROFILE) +
FORMAT(CRTP0100) +
PGMNBR(*LOW) +
PGM(xxx/CRTPRFEXTR)
新增程序檢核程式（又稱跳出程式 exit program）的指令 Add Exit Program
(ADDEXITPGM) 會讓系統知道當新增使用者設定檔時執行範例程式 CRTUSREXTR。
不管您是否了解程序檢核點，系統提供許多的程序檢核點(exit point)供系統人
員使用，包括TCP/IP網路應用軟體的安全控管，使用者設定檔，備份等。如果您想
要知道系統提供哪些程序檢核點(exit point)，僅需要執行 Work with
Registration Information (WRKREGINF)指令，瀏覽所有的程序檢核點
(exit point)，並可直接於畫面上新增或移除程序檢核點(exit point)中所指
定的程序檢核程式（又稱跳出程式 exit program）；您也可以於程序檢核點中指定
多支程序檢核程式（又稱跳出程式 exit program），並使用參數 PGMNBR 指定程式
執行的順序。
在我們的範例中，我們於程序檢核點 QIBM_QSY_CRT_PROFILE(exit point)中指
定一支程序檢核程式(跳出程式 exit program)，這是一個新增使用者設定檔的程序
檢核點(exit point)，我們選擇它是因為我們以新增使用者設定檔的程序當成範例
，當然還有 QSY_DLT_PROFILE 及 QSY_CHG_PROFILE 程序檢核點(exit point)
。您要如何利用這些程序檢核點(exit point)來控制您的系統，完全是您的環境而定
，您可能需要撰寫您自己的程序檢核程式(跳出程式 exit program)供刪除及更改使
用者設定檔使用。
表一僅列出程式的一部份，我們來看看這支程式是如何運作的，
參數 InData 代表系統傳給程序檢核程式(跳出程式 exit program)的資訊，它是
一個 38 個位元的資料結構，這個資料結構的定義，依照不同的程序檢核點有不同的
格式，有關使用者設定檔程序檢核點的詳細格式請參照手冊 System API Reference
SC41-5801-03 Chapter 69. Security Exit Programs。
新增使用者設定檔的程序檢核點 QIBM_QSY_CRT_PROFILE (exit point)
格式 CRTP0100 的資料結構格式如下：
位置 欄位型態及長度 欄位說明
===============|
10進位 16進位|
====== =======| ============ ====================================
0 0 | CHAR(20) Exit point name QIBM_QSY_CRT_PROFILE
20 14 | CHAR(8) Exit point format name CRTP0100
28 1C | CHAR(10) User profile name
在我們的範例中，我們所要擷取的是資料結構中最後 10 位的使用者設定檔名稱，這是
一個重要的資訊，我們呼叫 QSYRUSRI API 時，需要傳使用者設定檔名稱給這個 API
，並傳回該使用者相關的使用者設定檔的資訊，回傳的資訊放入變數 Receiver1 中，
並使用 QSNDDTAQ API 將資訊送至第二部 AS/400(iSeries)中，在本篇文章中會有
詳細說明。
在這個範例中，您會看到這支程式呼叫 QSYRUSRI API 兩次，第一次是要取得回傳資
料的可用長度，因為我們不知道真正回傳資訊的長度，但這個 API(其它的 API 也一
樣)將告訴您回傳資訊的可用長度，接著使用 ALLOC 運算元設定接收變數的長度，第
二次才是依照第一次所取得的長度取回資訊，並放入變數 QSYI0300 中。
QSYRUSRI API 所使用格式 USRI0300 的資料結構格式請參照手冊 System API
Reference SC41-5801-03 Chapter 68. Security APIs。
您可能從手冊中注意到回傳值幾乎包含所有除了使用者密碼之外的使用者設定檔資訊，
所以下一件事，這支程序檢核程式(跳出程式 exit program)需要取得該使用者的密
碼。
您可能會有疑問，”我能獲得使用者的密碼嗎？如果能取得使用者密碼，哪我就能以任
一使用者的代碼及其密碼進入系統。”我不想搓破你的美夢，但這並不像您所想的，您
仍然無法取得使用者的原始密碼，但有一個 QSYRUPWD API 可以取得使用者經過系統
加密過後的密碼，而這個經過加密後的密碼是無法在進入系統(SignOn)畫面上使用的，
這個範例所取得的密碼即是經過系統加密過後的密碼，您無法看到使用者的真正密碼，
所以還是忘了那個美夢吧。唯一所能做的是將取得的加密密碼，傳給 QSYSUPWD API
，這個 API 用來設定同一個使用者的加密密碼，也就是說 QSYRUPWD API 的使用
者設定檔參數值及 QSYSUPWD API UPWD0100 格式中使用者設定檔欄位值要相同。
QSYRUPWD API 及 QSYSUPWD API 的相關詳細資訊參照手冊 System API
Reference SC41-5801-03 Chapter 68. Security APIs。
這支程式呼叫 RtvEncPwd 程序擷取使用者的密碼，這個程序接收使用者設定檔名稱，
同樣呼叫 QSYRUPWD API 二次，然後傳資料結構(加密密碼及使用者設定檔名稱)給呼
叫程式；我們然後將此回傳的資料結構與 QSYRUSRI API 所擷取的使用者設定檔資訊
結合成一個字串，並使用 QSNDDTAQ API 將此合成字串寫入遠端資料序列(remote
data queue)。
現在我們來說明資料序列(data queue)，資料序列所存放的資料是先進先出，而所謂的
遠端資料序列(remote data queue)即是從系統 A 將資料寫入遠端資料序列(remote
data queue)，便可以從另一系統 B 擷取系統 A 所放入的資訊，而系統 A 及 系統 B
可以是不同的 AS/400(iSeries)系統。我們可藉由下述指令建立一個使用 TCP/IP 連線
的遠端資料序列(remote data queue)：
CRTDTAQ +
DTAQ(QGPL/PASSUSER) +
TYPE(*DDM) +
MAXLEN(1000) +
SEQ(*KEYED) +
KEYLEN(4) +
RMTDTAQ(QGPL/PASSUSERRM) +
RMTLOCNAME(RMTNAME)
我們於指令建立資料佇列(CRTDTAQ)參數 TYPE 指定值為 *DDM，DDM 代表分散式資
料管理(Distributed Data Management)，它同時告訴 AS/400(iSeries) 系統
這個資料佇列將指向於參數 RMTLOCNAME(Remote Location Name)所指定的另一個
AS/400(iSeries)系統上，在我們的例子中，參數 RMTLOCNAME 值為 RMTNAME，你需要
參考 CFGTCP Menu(Go CFGTCP)選項 10 中，遠端 AS/400 的主機名稱(Host name)。
參數 RMTLOCNAME 告訴系統遠端資料佇列所擺放的遠端系統，遠端資料佇列(Remote
Data Queue) 參數 RMTDTAQ 告訴本端系統，此遠端資料佇列放置於遠端系統的哪個
程式館及其名稱。所以要讓遠端資料佇列能有效運作，需要作如下的動作：
系統 A 系統 B
首先建立一個系統 B 本地端的資料佇列
CRTDTAQ DTAQ(QGPL/PASSUSERRM)
MAXLEN(1000)
SEQ(*KEYED)
KEYLEN(4)
接著於系統 A 建立遠端資料佇列 /\
(Remote Data Queue) ||
CRTDTAQ ||
DTAQ(QGPL/PASSUSER) ||
TYPE(*DDM) ||
MAXLEN(1000) ||
SEQ(*KEYED) ||
KEYLEN(4) ||
RMTDTAQ(QGPL/PASSUSERRM) <===================|| 指向系統 B 的資料佇列
RMTLOCNAME(RMTNAME)
要注意的是系統 A 建立遠端資料佇列參數 RMTDTAQ 要指定系統 B 本地端的資料佇
列名稱。
上述說明是主要系統所要做的動作，我們設定程序檢核點 QIBM_QSY_CRT_PROFILE
(exit point)連結到一支程序檢核程式(跳出程式 exit program)需當新增使用者
設定檔時，自動呼叫程序檢核程式傳送新增使用者設定檔資訊至第二台 AS/400
系統，所有其他的動作就是第二台 AS/400 系統取得使用者設定檔資訊，並新增
一個同樣的使用者設定檔於第二台 AS/400 系統中。表二列出完成這些動作的部
分原始碼。
在遠端系統上的這支程式利用 QRCVDTAQ API 從資料佇列(data queue)讀取資訊，
然後將資訊組成指令 CRTUSRPRF(新增使用者設定檔)所需要的參數，並利用 "system"
程序執行指令 CRTUSRPRF(新增使用者設定檔)。
相信上述的說明能幫助您自動化的管理使用者設定檔。
表一主要系統程序檢核點 QIBM_QSY_CRT_PROFILE(exit point)的程序檢核程式
CRTPRFEXTR (跳出程式 exit program)：
**********************************************************************
* Program name : CRTPRFEXTR *
* Date : 2002/09/16 *
**********************************************************************
* Before you use the program to syncronize User profile between
* AS/400(iSeries) systems, you need
*
* CRTBNDRPG CRTPRFEXTR
*
* Create a data queue on target system by following command :
* CRTDTAQ DTAQ(QGPL/PASSUSERRM) MAXLEN(1000) SEQ(*KEYED) KEYLEN(4)
*
* Create a remote data queue on source system by following command :
* 使用 TCP/IP 方式:
* CRTDTAQ +
* DTAQ(QGPL/PASSUSER) +
* TYPE(*DDM) +
* MAXLEN(1000) +
* SEQ(*KEYED) +
* KEYLEN(4) +
* RMTDTAQ(QGPL/PASSUSERRM) +
* RMTLOCNAME(RMTNAME)
*
* 或使用 APPC 方式:
*
* CRTDTAQ +
* DTAQ(QGPL/PASSUSER) +
* TYPE(*DDM) +
* MAXLEN(1000) +
* SEQ(*KEYED) +
* KEYLEN(4) +
* RMTDTAQ(QGPL/PASSUSERRM) +
* RMTLOCNAME(RMTNAME)
* PS: RMTNAME specified in APPC device under communication line
*
* Add Exit program to Create User Profile exit point on source system:
*
* ADDEXITPGM +
* EXITPNT(QIBM_QSY_CRT_PROFILE) +
* FORMAT(CRTP0100) +
* PGMNBR(*LOW) +
* PGM(xxx/CRTUSREXTR)
*
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) DFTACTGRP(*NO)
*/COPY QSYSINC/QRPGLESRC,QSYRUSRI
DQSYI0300 DS Based(ReceivePtr)
D* Qsy USRI0300
D QSYBRTN02 1 4B 0
D* Bytes Returned
D QSYBAVL02 5 8B 0
D* Bytes Available
D QSYUP03 9 18
D* User Profile
D QSYPS00 19 31
D* Previous Signon
D QSYRSV103 32 32
D* Reserved 1
D QSYSN00 33 36B 0
D* Signon Notval
D QSYUS02 37 46
D* User Status
D QSYPD02 47 54
D* Pwdchg Date
D QSYNP00 55 55
D* No Password
D QSYRSV203 56 56
D* Reserved 2
D QSYPI01 57 60B 0
D* Pwdexp Interval
D QSYPD03 61 68
D* Pwdexp Date
D QSYPD04 69 72B 0
D* Pwdexp Days
D QSYPE00 73 73
D* Password Expired
D QSYUC00 74 83
D* User Class
D QSYAOBJ01 84 84
D* All Object
D QSYSA05 85 85
D* Security Admin
D QSYJC01 86 86
D* Job Control
D QSYSC01 87 87
D* Spool Control
D QSYSS02 88 88
D* Save System
D QSYRVICE01 89 89
D* Service
D QSYAUDIT01 90 90
D* Audit
D QSYISC01 91 91
D* Io Sys Cfg
D QSYERVED10 92 98
D* Reserved
D QSYGP02 99 108
D* Group Profile
D QSYOWNER01 109 118
D* Owner
D QSYGA00 119 128
D* Group Auth
D QSYAL04 129 138
D* Assistance Level
D QSYCLIB 139 148
D* Current Library
D QSYNAME14 149 158
D* Name
D QSYBRARY14 159 168
D* Library
D QSYNAME15 169 178
D* Name
D QSYBRARY15 179 188
D* Library
D QSYLC00 189 198
D* Limit Capabilities
D QSYTD 199 248
D* Text Description
D QSYDS00 249 258
D* Display Signon
D QSYLDS 259 268
D* Limit DeviceSsn
D QSYKB 269 278
D* Keyboard Buffering
D QSYRSV300 279 280
D* Reserved 3
D QSYMS 281 284B 0
D* Max Storage
D QSYSU 285 288B 0
D* Storage Used
D QSYSP 289 289
D* Scheduling Priority
D QSYNAME16 290 299
D* Name
D QSYBRARY16 300 309
D* Library
D QSYAC 310 324
D* Accounting Code
D QSYNAME17 325 334
D* Name
D QSYBRARY17 335 344
D* Library
D QSYMD 345 354
D* Msgq Delivery
D QSYRSV4 355 356
D* Reserved 4
D QSYMS00 357 360B 0
D* Msgq Severity
D QSYNAME18 361 370
D* Name
D QSYBRARY18 371 380
D* Library
D QSYPD05 381 390
D* Print Device
D QSYSE 391 400
D* Special Environment
D QSYNAME19 401 410
D* Name
D QSYBRARY19 411 420
D* Library
D QSYLI 421 430
D* Language Id
D QSYCI 431 440
D* Country Id
D QSYCCSID00 441 444B 0
D* CCSID
D QSYSK00 445 445
D* Show Keywords
D QSYSD00 446 446
D* Show Details
D QSYFH00 447 447
D* Fullscreen Help
D QSYSS03 448 448
D* Show Status
D QSYNS00 449 449
D* Noshow Status
D QSYRK00 450 450
D* Roll Key
D QSYPM00 451 451
D* Print Message
D QSYERVED11 452 480
D* Reserved
D QSYNAME20 481 490
D* Name
D QSYBRARY20 491 500
D* Library
D QSYOBJA18 501 510
D* Object Audit
D QSYCMDS00 511 511
D* Command Strings
D QSYREATE00 512 512
D* Create
D QSYELETE00 513 513
D* Delete
D QSYJD01 514 514
D* Job Data
D QSYOBJM07 515 515
D* Object Mgt
D QSYOS00 516 516
D* Office Services
D QSYPGMA00 517 517
D* Program Adopt
D QSYSR00 518 518
D* Save Restore
D QSYURITY00 519 519
D* Security
D QSYST00 520 520
D* Service Tools
D QSYSFILD00 521 521
D* Spool File Data
D QSYSM00 522 522
D* System Management
D QSYTICAL00 523 523
D* Optical
D QSYERVED12 524 574
D* Reserved
D QSYGAT00 575 584
D* Group Auth Type
D QSYSGO00 585 588B 0
D* Supp Group Offset
D QSYSGNBR02 589 592B 0
D* Supp Group Number
D QSYUID 593 596U 0
D* UID
D QSYGID 597 600U 0
D* GID
D QSYHDO 601 604B 0
D* HomeDir Offset
D QSYHDL 605 608B 0
D* HomeDir Len
D QSYLJA 609 624
D* Locale Job Attributes
D QSYLO 625 628B 0
D* Locale Offset
D QSYLL 629 632B 0
D* Locale Len
D QSYGMI03 633 633
D* Group Members Indicator
D QSYDCI 634 634
D* Digital Certificate Indicato
D QSYCC 635 644
D* Chrid Control
D QSYSPSDO 645 648B 0
D* IASP Storage Dsc Offset
D QSYSPSDC 649 652B 0
D* IASP Storage Dsc Count
D QSYPSDCR 653 656B 0
D* IASP Storage Dsc Count Rtn
D QSYSPSDL 657 660B 0
D* IASP Storage Dsc Length
D*QSYSGN02 661 670 DIM(00001)
D*
D* Varying length
D*QSYPI02 671 671
D*
D* Varying length
D*QSYLI00 672 672
D*
D* Varying length
D*QSYASPSD00 20 DIM(00001)
D* QSYIASPN00 10 OVERLAY(QSYASPSD00:00001)
D* QSYERVED36 2 OVERLAY(QSYASPSD00:00011)
D* QSYMS02 9B 0 OVERLAY(QSYASPSD00:00013)
D* QSYSU01 9B 0 OVERLAY(QSYASPSD00:00017)
D*
D* Varying length
/COPY QSYSINC/QRPGLESRC,QUSEC
d RtvEncPwd PR 38
d PmProfile 10 const
d Data S 1000
d DataQue S 10 inz('PASSUSERRM')
d DataQueLib S 10 inz('QGPL ')
d DataLength S 5 0 inz(1000)
D FormatName S 8 inz('USRI0300')
D InData S 38
d UsrProFile S 10
d Key S 4 inz('0000')
d KeyLength S 3 0 inz(4)
D OI S 4 0
D ReceiveLen S 10i 0
D Receiver1 DS
D BytesRtn1 10i 0
D BytesAvl1 10i 0
D PassWordDs Ds 38
C *Entry PList
C Parm InData
C Eval UsrProFile = %Subst(InData : 29 : 10)
* Retrieve the user profile information
C Call 'QSYRUSRI'
C Parm Receiver1
C Parm 8 ReceiveLen
C Parm FormatName
C Parm UsrProfile
C Parm QusEc
c Alloc BytesAvl1 ReceivePtr
C Call 'QSYRUSRI'
C Parm QSYI0300
C Parm BytesAvl1 ReceiveLen
C Parm FormatName
C Parm UsrProfile
C Parm QusEc
* Retrieve the encrypted password data
c Eval PassWordDs = RtvEncPwd(UsrProfile)
c Eval DataLength = BytesAvl1 + 38
c Eval Data = PassWordDs + Qsyi0300
* Write the information to the DDM data queue
c CALL 'QSNDDTAQ'
C PARM DataQue
C PARM DataQueLib
C PARM DataLength
C PARM Data
C PARM KeyLength
C PARM Key
c Eval *inlr = *on
* procedure RtvEncPwd: Retrieve encrypted password for given user
P RtvEncPwd B export
d RtvEncPwd PI 38
d PmProfile 10 const
DQSYD0100 DS Based(ReceivePtr)
D* Qsy RUPWD UPWD0100
D QSYBRTN04 1 4B 0
D* Bytes Returned
D QSYBAVL04 5 8B 0
D* Bytes Available
D QSYPN06 9 18
D* Profile Name
D PassWord 19 38
D Receiver1 DS
D BytesRtn1 10i 0
D BytesAvl1 10i 0
DQUSEC DS 116 inz
D QUSBPRV 1 4B 0 inz(116)
D QUSBAVL 5 8B 0 inz(0)
D QUSEI 9 15
D QUSERVED 16 16
D QUSED01 17 116
D FormatName S 8 Inz('UPWD0100')
D InProfile S 10
D ReceiveLen S 10i 0
c Eval InProfile = PmProfile
C Call 'QSYRUPWD'
C Parm Receiver1
C Parm 8 ReceiveLen
C Parm FormatName
C Parm InProfile
C Parm QusEc
c Alloc BytesAvl1 ReceivePtr
C Call 'QSYRUPWD'
C Parm QsyD0100
C Parm BytesAvl1 ReceiveLen
C Parm FormatName
C Parm InProfile
C Parm QusEc
c Return QsyD0100
P RtvEncPwd E
表二：在遠端系統上的 RTVUSRINFR 程式列表
**********************************************************************
* Program name : RTVUSRINFR *
* Date : 2002/09/16 *
**********************************************************************
*
* CRTBNDRPG RTVUSRINFR
*
* CRTDTAQ DTAQ(QGPL/PASSUSERRM) MAXLEN(1000) SEQ(*KEYED) KEYLEN(4)
*
* SBMJOB CMD(CALL PGM(RTVUSRINFR)) JOB(AUTOCRTPRF)
*
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO) BNDDIR('QC2LE') DFTACTGRP(*NO)
d System PR 10i 0 extproc('system')
d Cmd * value options(*string)
d CpfMsgId S 7 import('_EXCP_MSGID')
d FormatCmd PR 1000
d UsrProfile 10 const
d SetEncPwd PR
d PwdStruct 38
DPassWordDs DS 38
DReceiveDs DS 1000
d ProfData 39 1000
d pwdexpitvb 95 98B 0
d maxstgb 319 322B 0
d msgsevb 395 398B 0
d ccsidb 479 482B 0
DQSYI0300 DS
D QSYUP03 9 18
D* User Profile
D QSYURITY00 519 519
D* Security
d DataQue S 10 inz('PASSUSERRM')
d DataQueLib S 10 inz('QGPL ')
d DataLength S 5 0 inz(1000)
d Key S 4 inz('0000')
d KeyLength S 3 0 inz(4)
d KeyOrder S 2 inz('EQ')
d SenderInf S 50
d SenderLen S 3 0 inz(50)
d WaitLength S 5 0 inz(-1)
* Read the data queue as entries arrive
c CALL 'QRCVDTAQ'
C PARM DataQue
C PARM DataQueLib
C PARM DataLength
C PARM ReceiveDs
C PARM WaitLength
C PARM KeyOrder
C PARM KeyLength
C PARM Key
C PARM SenderLen
C PARM SenderInf
c Movel ReceiveDs PassWordDs
c Movel ProfData Qsyi0300
* execute the command to create the user profile
c If System(FormatCmd(QsyUp03)) > 0
* If procedure returned not zero, display the error msgid
c CpfMsgId dsply
C* Dump
c Else
* Set the password the same as in the original profile
c Callp SetEncPwd(PassWordDs)
c
c Endif
c
c eval *inlr = *on
P FormatCmd B export
d FormatCmd PI 1000
d UsrProfile 10 const
D cmdStr S 1000 inz
D password S 10 inz('*USRPRF')
D pwdexp S 4
D status S 9
D usrcls S 10
D astlvl S 9
D curlib S 10
D inlpgm S 10
D inlpgml S 10
D fullinlpgm S 21
D inlmnu S 10
D inlmnul S 10
D lmtcpb S 8
D text S 50
D spcaut S 80
D spcautind S 1
D spcenv S 9
D dspsgninf S 9
D pwdexpitv S 9
D lmtdevssn S 9
D kbdbuf S 9
D maxstg S 9
D ptylmt S 1
D fulljobd S 21
D jobdname S 10
D jobdlib S 10
D grpprf S 10
D owner S 7
D grpaut S 8
D grpauttyp S 8
D acgcde S 15
D msgq S 21
D dlvry S 7
D msgsev S 6
D prtdev S 10
D outq S 21
D atn S 21
D srt S 21
D langid S 7
D cntryid S 7
D ccsid S 11
D chridctl S 9
D tempn S 10
* PWDEXP
C If %SubSt(ProfData : 73 : 1) = 'Y'
C Eval pwdexp = '*YES'
C Else
C Eval pwdexp = '*NO '
C EndIf
C Eval status = %SubSt(ProfData : 37 : 10)
C Eval usrcls = %SubSt(ProfData : 74 : 10)
C Eval astlvl = %SubSt(ProfData : 129 : 10)
C Eval curlib = %SubSt(ProfData : 139 : 10)
C Eval inlpgm = %SubSt(ProfData : 169 : 10)
C Eval inlpgml= %SubSt(ProfData : 179 : 10)
C If inlpgm = '*NONE '
C Eval fullinlpgm = '*NONE'
C Else
C Eval fullinlpgm = %trim(inlpgml) + '/' +
C %trim(inlpgm)
C EndIf
C Eval inlmnu = %SubSt(ProfData : 149 : 10)
C Eval inlmnul= %SubSt(ProfData : 159 : 10)
C Eval lmtcpb = %SubSt(ProfData : 189 : 10)
C Eval text = %SubSt(ProfData : 199 : 10)
*SPCAUT
C Eval spcautind = '0'
C If %SubSt(ProfData : 84 : 1) = 'Y'
C Eval spcaut = '*ALLOBJ'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 85 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *SECADM'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 86 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *JOBCTL'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 87 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *SPLCTL'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 88 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *SAVSYS'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 89 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *SERVICE'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 90 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *AUDIT'
C Eval spcautind = '1'
C EndIf
C If %SubSt(ProfData : 91 : 1) = 'Y'
C Eval spcaut = %trim(spcaut) + ' *IOSYSCFG'
C Eval spcautind = '1'
C EndIf
C If spcautind = '0'
C Eval spcaut = '*NONE'
C EndIf
C Eval spcenv = %SubSt(ProfData : 391 : 10)
C Eval dspsgninf = %SubSt(ProfData : 249 : 10)
*PWDEXPITV
C If pwdexpitvb = 0
C Eval pwdexpitv ='*SYSVAL'
C Else
C If pwdexpitvb = -1
C Eval pwdexpitv ='*NOMAX'
C Else
C MoveL pwdexpitvb pwdexpitv
C EndIf
C EndIf
C Eval lmtdevssn = %SubSt(ProfData : 259 : 10)
C Eval kbdbuf = %SubSt(ProfData : 269 : 10)
C
*MAXSTG
C If maxstgb = -1
C Eval maxstg = '*NOMAX'
C Else
C MoveL maxstgb maxstg
C EndIf
*PTYLMT
C Eval ptylmt = %SubSt(ProfData : 289 : 1)
*JOBD
C Eval jobdlib = %SubSt(ProfData : 300 : 10)
C Eval jobdname = %SubSt(ProfData : 290 : 10)
C Eval fulljobd = %trim(jobdlib) + '/' +
C %trim(jobdname)
*GRPPRF
C Eval grpprf = %SubSt(ProfData : 99 : 10)
*OWNER
C Eval owner = %SubSt(ProfData : 109 : 10)
*GRPAUT
C Eval grpaut = %SubSt(ProfData : 119 : 10)
*GRPAUTTYP
C Eval grpauttyp = %SubSt(ProfData : 575 : 10)
*ACGCDE
C Eval acgcde = %SubSt(ProfData : 310 : 15)
*MSGQ
C Eval msgq = %trim(%SubSt(ProfData : 335 : 10)) +
C '/' +
C %trim(%SubSt(ProfData : 325 : 10))
*DLVRY
C Eval dlvry = (%SubSt(ProfData : 345 : 10))
*MSG SEV
C Movel msgsevb msgsev
*PRTDEV
C Eval prtdev = (%SubSt(ProfData : 381 : 10))
*OUTQ
C Eval tempn= %trim(%SubSt(ProfData : 361 : 10))
C If tempn = '*WRKSTN ' or
C tempn = '*DEV '
C Eval outq = tempn
C Else
C Eval outq = %trim(%SubSt(ProfData : 371 : 10)) +
C '/' +
C %trim(%SubSt(ProfData : 361 : 10))
C EndIf
*ATNPGM
C Eval tempn= %trim(%SubSt(ProfData : 401 : 10))
C If tempn<> '*SYSVAL ' or
C tempn<> '*NONE ' or
C tempn<> '*ASSIST '
C Eval atn = tempn
C Else
C Eval atn = %trim(%SubSt(ProfData : 411 : 10)) +
C '/' +
C %trim(%SubSt(ProfData : 401 : 10))
C EndIf
*SRTSEQ
C Eval tempn = %SubSt(ProfData : 481 : 10)
C If (tempn = '*HEX ') OR
C (tempn = '*LANGIDUNQ') OR
C (tempn = '*LANGIDSHR') OR
C (tempn = '*SYSVAL ')
C Eval srt = tempn
C Else
C Eval srt = %trim(%SubSt(ProfData : 491 : 10)) +
C '/' +
C %trim(%SubSt(ProfData : 481 : 10))
C EndIf
*LANGID
C Eval langid= %SubSt(ProfData : 421 : 10)
*CNTRYID
C Eval cntryid= %SubSt(ProfData : 431 : 10)
*CCSID
C If ccsidb = -2
C Eval ccsid = '*SYSVAL'
C Else
C Movel ccsidb ccsid
C EndIf
*CHRIDCTL
C Eval cntryid= %SubSt(ProfData : 635 : 10)
C Eval cmdStr = 'CRTUSRPRF ' +
C 'USRPRF(' + %trim(UsrProfile) + ') ' +
C 'PASSWORD(*USRPRF) ' +
C 'PWDEXP(' + %trim(pwdexp) + ') ' +
C 'STATUS(' + %trim(status) + ') ' +
C 'USRCLS(' + %trim(usrcls) + ') ' +
C 'ASTLVL(' + %trim(astlvl) + ') ' +
C 'CURLIB(' + %trim(curlib) + ') ' +
C 'INLPGM(' + %trim(fullinlpgm) + ') ' +
C 'INLMNU(' + %trim(inlmnul) +
C '/' + %trim(inlmnu) +
C ') ' +
C 'LMTCPB(' + %trim(lmtcpb) + ') ' +
C 'TEXT(' + %trim(text) + ') ' +
C 'SPCAUT(' + %trim(spcaut)+ ') ' +
C 'SPCENV(' + %trim(spcenv) + ') ' +
C 'DSPSGNINF('+ %trim(dspsgninf) + ') ' +
C 'PWDEXPITV('+ %trim(pwdexpitv) + ') ' +
C 'KBDBUF(' + %trim(kbdbuf) + ') ' +
C 'MAXSTG(' + %trim(maxstg) + ') ' +
C 'PTYLMT(' + %trim(ptylmt) + ') ' +
C 'JOBD(' + %trim(fulljobd) + ') ' +
C 'GRPPRF(' + %trim(grpprf) + ') ' +
C 'OWNER(' + %trim(owner) + ') ' +
C 'GRPAUT(' + %trim(grpaut) + ') ' +
C 'GRPAUTTYP('+ %trim(grpauttyp) + ') ' +
C 'ACGCDE(' + %trim(acgcde) + ') ' +
C 'MSGQ(' + %trim(msgq) + ') ' +
C 'DLVRY(' + %trim(dlvry) + ') ' +
C 'SEV(' + %trim(msgsev) + ') ' +
C 'PRTDEV(' + %trim(prtdev) + ') ' +
C 'OUTQ(' + %trim(outq) + ') ' +
C 'ATNPGM(' + %trim(atn) + ') ' +
C 'SRTSEQ(' + %trim(srt) + ') ' +
C 'LANGID(' + %trim(langid) + ') ' +
C 'CNTRYID(' + %trim(cntryid) + ') ' +
C 'CCSID(' + %trim(ccsid) + ') ' +
C 'CHRIDCTL(' + %trim(chridctl) + ') '
C Dump
C Return CmdStr
P FormatCmd E
P SetEncPwd B export
d SetEncPwd PI
d QSYSD0100 38
DQUSEC DS 116 inz
D QUSBPRV 1 4B 0 inz(116)
D QUSBAVL 5 8B 0 inz(0)
D QUSEI 9 15
D QUSERVED 16 16
D QUSED01 17 116
D FormatName S 8 Inz('UPWD0100')
C Call 'QSYSUPWD'
C Parm QsysD0100
C Parm FormatName
C Parm QusEc
c Return
P SetEncPwd E
星期四, 11月 02, 2023
2002-12-09 如何限制使用 PWRDWNSYS 關機指令, 防止不小心執行關機動作?
如何限制使用 PWRDWNSYS 關機指令, 防止不小心執行關機動作?
PWRDWNSYS 關機指令的系統預設權限如下:
Edit Object Authority
Object . . . . . . . : PWRDWNSYS Owner . . . . . . . : QSYS
Library . . . . . : QSYS Primary group . . . : *NONE
Object type . . . . : *CMD ASP device . . . . . : *SYSBAS
Type changes to current authorities, press Enter.
Object secured by authorization list . . . . . . . . . . . . *NONE
Object
User Group Authority
QSYS *ALL
QSYSOPR *USE
*PUBLIC *EXCLUDE
由上述畫面可知 QSYSOPR 有使用權限, 但公共權限為 *EXCLUDE 亦即非指定使用者是無
法使用的, 所以此 PWRDWNSYS 的使用權限需要針對單一使用者個別授權才能使用, 你可
以使用 EDTOBJAUT 指令授權某些人可以使用, 但仍然會有被授權使用者使用者不小心下
了 PWRDWNSYS 指令, 如輸入 PWRDWNSYS 直接按 Enter 執行鍵或按 F4 鍵欲檢視 PWRDWNSYS
指令的參數, 欲取消參數畫面需按 F3 或 F12 鍵, 有可能疏忽而按了 Enter 執行鍵,
此指令一執行是無法取消的,所以要非常謹慎, 所以系統也提供一個程序檢核點(Exit Point) QIBM_QWC_PWRDWNSYS,
作為在關機前的準備動作檢查, 每個應用系統有可能需要在關機前作某些清除動作, 讓應
用系統能正常終止, 以防止下次開機時無法啟動, 所以系統提供此程序檢核點(Exit Point)
QIBM_QWC_PWRDWNSYS, 讓系統管理人員能進一步確認整個關機的步驟, 我們可以利用此程序檢核點(Exit Point) QIBM_QWC_PWRDWNSYS,
連結程序檢核程式(Exit Program), 來作為是否執行關機動作的再次確認.
此範例程式是將關機訊息送至 QSYSOPR 訊息佇列, 若 QSYSOPR 回應 'G' or 'g' 時,
系統執行關機動作, 若回應其他訊息, 則系統不會執行此關機動作, 但此訊息會一直留在
QSYSOPR 訊息佇列等待回應正確的回應值 'G', 你可以在 DSPMSG QSYSOPR 畫面按 F11
清除此訊息. 此種方式是系統管理上需要防止不正常關機的最佳方式.
File : QCLSRC
Member: PWRDWNSYSC
Type : CLP
Version : V5R1 以後(因 V5R1 才提供 程序檢核點(Exit Point) QIBM_QWC_PWRDWNSYS)
Usage : CRTCLPGM PWRDWNSYS
PGM
DCL VAR(&REPLY) TYPE(*CHAR) LEN(1)
SNDUSRMSG MSGID(CPF9898) MSGF(QCPFMSG) +
MSGDTA('PWRDWNSYS will be processed as +
soon as you respond to this message. +
Enter G to continue.') VALUES('G') +
TOUSR(QSYSOPR) MSGRPY(&REPLY)
ENDPGM
設定方式 :
ADDEXITPGM EXITPNT(QIBM_QWC_PWRDWNSYS) FORMAT(PWRD0100) PGMNBR(1)
PGM(your-library-name/PWRDWNSYSC) */
2002-10-24 當新增使用者或更改使用者密碼時, 如何產生使用者動態密碼 ?(Create dynamic password)
當新增使用者或更改使用者密碼時, 如何產生使用者動態密碼 ?
當系統管理者新增使用者或更改使用者密碼時, 如何產生使用者動態密碼 ?
由於新增使用者時，系統的預設密碼為使用者代碼，或使用者密碼錯誤次數超過系統值
QMAXSIGN 的設定值時，系統會將使用者設為失效，或使用者密碼忘記時，這些狀況均
需要重設密碼，此時若使用系統預設值 PASSWORD(*USRPRF) 是很危險的，因為使用者若
未即時更改預設密碼（此時密碼與使用者代碼相同），就會給與不肖人士有機會入傾系統，
造成系統安全漏洞， 所以需要有一支能
產生動態密碼的程式，來產生使用者密碼，但產生的密碼要好記，不然使用者很容易忘記．
這裡提供一個範例，你可依照自己的需求更改．
File : QRPGLESRC
Member: GENPWDR
Type : RPGLE
OS/400 Version: V3R1 以後
Usage : CRTBNDRPG GENPWDR
CALL GENPWDR 按 Enter，若回 'N','n' 停止執行，否則每按一次 Enter，產生一個密碼.
* Scott Klement [klemscot@klements.com]
H DFTACTGRP(*NO) BNDDIR('QC2LE')
D srand PR extproc('srand')
D seed 10U 0 value
D rand PR 10I 0 extproc('rand')
D consonant PR 1A
D vowel PR 1A
D dsTS DS
D dsTS_1 Z
d dsTS_Date 10A overlay(dsTS_1:1)
d dsTS_Time 8A overlay(dsTS_1:12)
d dsTS_Milli 6A overlay(dsTS_1:21)
d dsTS_sec1 1A overlay(dsTS_Time:7)
d dsTS_sec2 1A overlay(dsTS_Time:8)
d dsTS_ms1 1A overlay(dsTS_Milli:1)
d dsTS_ms2 1A overlay(dsTS_Milli:2)
d dsTS_ms3 1A overlay(dsTS_Milli:3)
D dsSeed DS
D dsSeed_1 5S 0 inz(0)
D dsSeed_2 2S 0 overlay(dsSeed_1:1)
D dsSeed_ms3 1A overlay(dsSeed_1:1)
D dsSeed_ms1 1A overlay(dsSeed_1:2)
D dsSeed_sec2 1A overlay(dsSeed_1:3)
D dsSeed_sec1 1A overlay(dsSeed_1:4)
D dsSeed_ms2 1A overlay(dsSeed_1:5)
D wkMsg S 50A
D wkReply S 1A
C****************************************************************
C* Mangle the time, and use it to seed the random number generator
C****************************************************************
c time dsTS_1
c eval dsSeed_ms1 = dsTS_ms1
c eval dsSeed_ms2 = dsTS_ms2
c eval dsSeed_ms3 = dsTS_ms3
c eval dsSeed_sec1 = dsTS_sec1
c eval dsSeed_sec2 = dsTS_sec2
c dow dsSeed_2 > 31
c eval dsSeed_2 = dsSeed_2 - 31
c enddo
c callp srand(dsSeed_1)
C****************************************************************
C* Make a password that consists of 7 chars, consonants and
C* vowels every other char
C****************************************************************
c dou wkReply='N' or wkReply='n'
c eval wkMsg = 'Password = ' +
c consonant +
c vowel +
c consonant +
c vowel +
c consonant +
c vowel +
c consonant +
c ' Calculate another?'
c wkMsg dsply wkReply
c enddo
c eval *inlr = *on
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* this returns a random consonant
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P consonant B
D consonant PI 1A
D x S 10I 0
D c S 21A INZ('BCDFGHJKLMNPQRSTVWXZ')
c eval x = %rem(rand: 20) + 1
c return %subst(c:x:1)
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* this returns a random vowel
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P vowel B
D vowel PI 1A
D x S 10I 0
D v S 21A INZ('AEIOUY')
c eval x = %rem(rand: 6) + 1
c return %subst(v:x:1)
P E
2002-09-19 iSeries(AS/400) 的安全控管稽核重點
iSeries(AS/400) 的安全控管稽核重點
iSeries(AS/400) 的安全控管稽核重點
Contributed 05/18/2002 By Vengoal Chang
目標
AS/400 的安全控管稽核重點主要提供 AS/400 使用者關於 AS/400 安全控管的
主要項目資訊及控管後所產生影響結果。安全控管方式的選擇及導入應該配合公司的安全政策，
有效執行而不會被中斷，並且容易管理。
安全控管的層次及控管方式的選擇及導入均應視所在位置的處理環境（例如：網路連結方式，使
用者的數目及他們的需求，應用程式的設計方式，資訊部門人員編制大小等）
小型處理環境 － 結合安全控管的層次 30 或 40 的日誌(log)，選項畫面安全設定(Menu Security)
，系統及使用者設定檔的設定能夠控制使用者去執行某些批次作業或特殊的 AS/400
指令或工具。由於資訊部門的人員編制小，所以資訊部門人員一般擁有存取 AS/400
資源的所有權限，故安全控管方式需以使用者控制及系統稽核日誌追蹤加以強化補充。
中型極大行處理環境 － 結合安全控管的層次 30 或 40 的日誌(log)，選項畫面安全設定
(Menu Security)，資源安全設定(Resource Seurity)，系統及使用者設定檔
的設定，能夠有效的導入系統及資料安全。在如此的環境中，資訊人員存取系
統及資料都應該被評估及被授權至該資訊人員所應知道的基礎上，亦即限制某
些人依安全控管方式，取得被授權的系統資源及資料。
適當的規劃及導入一個有效且對使用者親切的安全環境是很重要的關鍵。
IBM 所提供的 AS/400 操作系統包含許多安全控管特性，用來防止未經授權的人進入系統及存取未經授權
的資訊，AS/400 所提供的安全控管特性說明如下：
"AS/400 所提供安全控管特性能減少使用者無意間更改或刪除資源的機會，你的安全控管要有效
，那你的資源控管就要結合實體安全及權責分明的界線。如果沒有使用這些控管，那你的系統就有
可能暴露，且未經授權的人有可能存取你的系統。"
使用者能依照系統所在環境（硬體及軟體，機房，電力等）及所需的控管範圍啟動及更改安全設定。IBM
所提供主要 AS/400 的安全控管特性用來確保系統及資訊安全表列如下。
AS/400 安全控管特性可分成幾組簡單描述如下：
相關安全控管的系統值
使用者設定檔的安全設定
控制存取的工具
實體及硬體的控制
IBM 出售 AS/400 時，系統預設的的安全層級一般設定在安全層級 30。
所必須考慮的安全控管特性：
相關安全控管的系統值
AS/400 提供許多相關安全控管的系統值，允許使用者規劃及設定符合他自己環境所需的安全控管方式。
在 AS/400 上，這些廣義的系統值用於控制進入系統、密碼、區域及網路的作業。
相關安全控管的系統值又可分成：
進入系統（Sign-On)
密碼（Password）
區域及網路（Local and Network）
一般 AS/400 安全控管特性，可藉由系統層次的廣義系統值或導入依個人層次的使用者設定檔參數選項來建立。
A. 進入系統的安全控管系統值
1. QSECURITY (Security Level)
AS/400 提供廣義的安全系統值稱為"QSECURITY"，此系統值啟動系統所需安全控管層次。在AS/400
上有四種安全控管層次可供使用，系統一次只能選擇一個安全控管層次，五種安全控管層次如下：
- 安全控管層次 10 -
在此安全控管層次任何人不用正確的使用者代碼及密碼均能進入系統及存取所有系統資源，
能讀取、更改、刪除系統上所有的物件。
所需考慮採取的安全控管方式：
這個安全控管層次應該提升至安全控管層次 30.
- 安全控管層次 20 -
在這個安全控管層次，使用者需要使用者代碼及密碼才能進入系統，但進入系統後仍然預設
其權限可以存取或刪除任何物件（例如：所有檔案、資料庫、程式、使用者設定檔等）。
所需考慮採取的安全控管方式：
在這個安全控管層次通常是個過度階段，最少應該盡快採用安全控管層次 30 及適當的稽核層次（QAUDLVL）。
- 安全控管層次 30 -
在這個安全控管層次，使用者需有系統管理員為其建立一個使用者設定檔及密碼才能進入系
統存取系統資源，在安全控管層次 30，使用者藉由 "Public" 公共權限存取其他物件，若有
物件將公共權限排除在外，那使用者就需得到額外授權才能存取該物件。
所需考慮採取的安全控管方式：
這個安全控管層次需加上及適當的稽核層次（QAUDLVL）。
- 安全控管層次 40 -
在這個安全控管層次，已包含安全控管層次 30 所提供的一切安全控管方式，也包含設定稽核
層次(QAUDLVL)及啟動稽核日誌，同時也提供作業系統的完整性檢核，限制系統指令等。
所需考慮採取的安全控管方式：
在採用安全控管層次 40 前，應該先採用安全控管層次 30，加上稽核層次（QAUDLVL 設定為 *AUTFAIL
及 *PGMFAIL），若違反安全控管層次 40 所規範的授權規範，系統就會將授權失敗紀錄(失敗原因代碼為
"AF")於稽核日誌(QAUDJRN)中，檢視稽核日誌將所有相關違反安全控管層次 40的規則或錯誤，授與應用
軟體、相關資料庫及使用者適當的權限及防止程式授權失敗後，再導入安全控管層次 40，對於有複雜的
非 IBM 系統介面、網路連結或處理公司外部磁帶，建議採用這個安全控管層次。
- 安全控管層次 50 -
在這個安全控管層次，已包含安全控管層次 40 所提供的一切安全控管方式，並符合美國國防部
的安全 C2 標準 。由於此層級強化系統層級安全控管，對於系統運作績效有很大的影響，使用前
請先評估。
2. QMAXSIGN (Maximum Sign-On Attempts)
這個廣義的安全系統值稱為"QMAXSIGN"，系統用來控制使用者所允許進入系統時所發生的錯誤次數（例如密
碼錯誤、使用者代碼輸入錯誤或使用未被授權的工作站），當錯誤次數達到系統值所允許的次數時，系統會
依照另一系統值 QMAXSGNACN 的設定採取對應的處理，並傳送一個訊息至 QSYSOPR 訊息佇列（及如果
QSYSMSG 存在於 QSYS 中時，也傳送同一個訊息至 QSYSMSG）。
如果於 QSYS 程式館建立 QSYSMSG 訊息佇列，系統會自動將重要的訊息送至 QSYSMSG，以防止重要訊息淹沒
於有大量訊息的 QSYSOPR 訊息佇列中。
為了防止駭客入傾，這個系統值最好設定低且合理的值，一般的容許錯誤次數是 3 到 5。
2.1 QMAXSGNACN (Action When Sign-On Attempts Reached)
這個系統值用於決定當進入系統的錯誤次數達到系統值 QMAXSIGN 所設定的錯誤次數時應採取的處理動作。
應採取的處理動作可分為：
3：將使用者設定檔及工作站設為失效。
1：將工作站設為失效。
2：將使用者設定檔設為失效。
QMAXSGNACN 建議值為 3。
3. QRMTSIGN (Remote Sign-On Control)
這個廣義的安全系統值稱為"QRMTSIGN"，是系統用來控制遠端進入系統的需求，例如從另一 AS/400 系統透
過 Pass-through、Client Access 5250 工作站及 Telnet 來的遠端進入系統的需求。
這個安全系統值"QRMTSIGN"應該設定為 *FRCSIGNON ，讓所有的遠端進入系統需求使用正常的進入系統程序。
4. QAUDCTL
系統值 “QAUDCTL” ，是系統用來決定是否啟動稽核日誌功能。有三類稽核方式可供選擇(可多選)：
*AUDLVL
依照 QAUDLVL 稽核層級統值的定義
*OBJAUD
經過指令個別指定的物件才會針對該物件啟動稽核功能
Change Object Auditing (CHGOBJAUD)
Change DLO Auditing (CHGDLOAUD)
經過指令個別指定的使用者才會針對該使用者啟動稽核功能
Change User Audit (CHGUSRAUD) command
*NOQTEMP
Library QTEMP 中的物件不做稽核日誌，因為 QTEMP 中均是暫存物件。
*NONE – 不啟動稽核日誌功能
4.1 QAUDLVL (Auditing Level)
這個廣義的安全系統值稱為"QAUDLVL"稽核層級，是系統用來控制哪些安全控管的事件需要被紀錄於安全
稽核日誌（QAUDJRN）中。
這個安全系統值 "QAUDLVL" 最少應該設定為 *AUTFAIL（系統紀錄所有授權失敗的事件），*SECUTITY
（紀錄所有更改安全控管系統值的事件）。若再加上 *SAVRST（紀錄 Restored 時所有相關安全的事件）
在選擇 "QAUDLVL" 選項前，要做系統績效及系統資源的評估，因為作紀錄的動作會影響系統運作績效及
硬碟空間的使用。
在使用 "QAUDLVL" 前，系統值 "QAUDCTL" 需包含 "*AUDLVL"。
5. QLMTSECOFR (Limit Security Officer)
限制具有 *ALLOBJ 或 *SERVICE 的使用者是否僅能從 System Console 進入系統.
1: 是
但仍能夠使用Grant Object Authority (GRTOBJAUT) 指令授權使用者可以從其他工作站進入系統.
0: 否
防止高權限使用者權限被誤用
5.1 QLMTDEVSSN (Limit Device Sessions)
這個廣義的安全系統值稱為"QLMTDEVSSN"，用來控制使用者是否能同時從多台工作站進入系統。
建議值為 '1'，限定使用者再任何時間僅能從一台工作站進入系統，除非使用者結束原有的工作站
作業退系統，回到進入系統畫面(SignOn Screen)，才能從另外一台工作站進入系統。
限制工作站功能也可以從使用者設定檔中，針對個人設定。
使用這個安全系統值 "QLMTDEVSSN" 可減少多人共用同一個使用者代碼及密碼。但若有一群人共用因
業務需要而共用同一個使用者代碼及密碼，而公司政策又話，那又是另一個議題了。
6. QINACTITV (Inactive Job Time-Out Interval)
這個廣義的安全系統值稱為"QINACTITV"，是系統用來控制允許一台工作站持續沒有任何動作的時間
（例如使用者離開座位），當沒有任何動作的時間達到 "QINACTTITV" 所指定的時間時，依照系統值
"QINACTMSGQ" 的設定採取對應的處理動作。這個系統值的設定減少未經授權的人存取系統的機會。
設定這個系統值 "QINACTITV" 時，要考慮使用者的作業環境，如製造業現場工單流程，客戶服務中心
等。這個系統值應該設定實際且有效的值，一般的設定為 60 分鐘。
這個系統值只針對 5250 終端工作站、Client Access 5250 終端模擬及 Telnet (V4R3 以後)有效。
Telnet 在 V4R2 以前，需使用 CHGTELNA 指令。
這個系統值並不適用於 FTP Server，使用 CHGFTPA 設定 INACTTIMO 參數。
6.1 QINTACTMSGQ (Inactive Job Time-Out Message Queue)
這個系統值 "QINACTMSGQ" 用以決定當系統值 "QINACTITV" 所設定的時間達到時所應採取的對應動作。
建議值為 *ENDJOB 結束該工作。
若值為 *DSCJOB, 則 QDSCJOBITV 可指定暫時中斷幾分鐘後結束作業。
7. QAUTOVRT (Automatic Configuration of Virtual Devices)
這個廣義的安全系統值稱為"QAUTOVRT"，是系統用來控制 AS/400 是否能自動建立虛擬工作站，以回應
遠端工作站進入系統的需求。
允許你的系統自動建立虛擬工作站，會給駭客更多的入傾機會，例如 QMAXSIGN 進入系統錯誤的次數設
為 3，且 QAUTOVRT 允許建立的虛擬工作站的數目設定為 500，駭客的入傾次數機會高達 1500 次。不
可不慎重。
建議值設定為 0。
8. QDSPSGNINF (Display Sign-On Information)
這個廣義的安全系統值稱為"QDSPSGNINF"，是系統用來決定是否顯示進入系統的相關資訊，例如上次進入
系統的時間，此次進入系統錯誤的次數，幾天後密碼過期（如果密碼到期日小於等於 7 天才會顯示）。
建議值為 "1"，讓使用者知道自己的密碼是否快過期。此系統值也可針對個人設定於使用者設定檔中。
B. 相關密碼安全控管的系統值
1. QPWDEXPITV (Password Expiration Interval)
這個廣義的安全系統值稱為"QPWDEXPITV"，是系統用來指定一個密碼的有效期限，當有效期限到期時，
系統會強迫使用者更改密碼。此系統值也可針對個人設定於使用者設定檔中。
建議值一般為 90 天，較重要的使用者為 30 天。
2. QPWDRQDDIF (Required Difference in Passwords)
這個廣義的安全系統值稱為"QPWDRQDDIF"，是系統用來控制密碼是否能與先前幾次使用過的密碼相同。
建議值為 "5"，不得與前 10 次密碼相同。
3. QPWDLMTREP (Restriction of Repeated Characters for Passwords)
這個廣義的安全系統值稱為 "QPWDLMTREP" ，是系統用來限制密碼字元可否重覆，若系統值 "QPWDLVL"
設為 2 或 3，密碼字元分大小寫是不同的字元，如 a 與 A 是不同的字元。
建議值為 "1"，密碼中不得有重複的字元。
4. QPWDMINLEN (Minimum Length of Passwords)
這個廣義的安全系統值稱為 "QPWDMINLEN"，是系統用來控制組成密碼的最小長度，用以忽略較容易猜的密碼。
建議值為 6 到 8。
當系統值 "QPWDLVL" 為 "1" 時，這密碼的長度可藉於 1 到 10 間。
當系統值 "QPWDLVL" 為 "2" 或 "3" 時，這密碼的長度可藉於 1 到 128 間。
C. 網路相關安全控管系統值
1. PCSACC
AS/400 提供一個 PC Support Access 的網路安全控管的系統值 PCSACC，是系統用來控制 PC 可否
存取哪些系統服務，如 5250 終端連線模擬，檔案下載及上傳等服務。
如果需要 PC Support 的功能，那 "PCSACC" 的網路參數屬性應該設定為 *OBJAUT。設定 *OBJAUT
這個值接受 PC Support 所有的功能，然而這些服務需求仍需遵循正常的 AS/400 物件權限確認程序。
若要依照個別功能設定權限，可自行撰寫 Exit Program，使用 CHGNETA 指定 PCSACC 的參數為 Exit Program.
V3R1 以後可以使用 *REGFAC 參數選項，WRKREGINF 指定個別功能的 Exit Program.
如果不需要 PC Support 的功能，"PCSACC" 就應設定為 *REJECT，拒絕遠端 PC 所有的服務需求。
2. DDMACC
AS/400 同時提供另一個網路參數屬性 "DDMACC"(distributed data management 分散式資料管理)，
用來控制及確認遠端 AS/400 系統所提出的處理需求。
如果需要分散式資料管理的功能，那 "DDMACC" 的網路參數屬性應該設定為 *OBJAUT。設定 *OBJAUT
這個值接受所有分散式資料管理的功能，然而這些服務需求仍需遵循正常的 AS/400 物件權限確認程序。
如果不需要分散式資料管理的功能，"DDMACC" 就應設定為 *REJECT，拒絕所有分散式存取服務需求。
若要依照個別功能設定權限，可自行撰寫 Exit Program，使用 CHGNETA 指定 DDMACC 的參數為 Exit Program.
V3R1 以後可以使用 *REGFAC 參數選項，WRKREGINF 指定個別功能的 Exit Program.
使用者設定檔的安全設定 (User Profiles Security)
在 AS/400 上，使用者需要事先授與適當的權限，包含系統層級特殊權限或針對單一物件（例如：
指令、資料庫檔案、工作站印表機設備等）。
使用者設定檔用來定義使用者及他們的權限範圍，且提供許多參數設定，可參照系統值或針對個別
使用者設定。例如：系統值 "QPWDEXPITV" 密碼有效期間，可藉由設定使用者設定檔參數
"Password Expiration Interval" 取代系統值。
使用者設定檔的安全參數屬性需要針對個人作業適當的評估，授與個人作業範圍內應有的權限。
1. 特殊權限 (Special Authorities)
AS/400 為了一般安全控管及系統工作需要而提供使用者特殊權限，共有六種：
*ALLOBJ - 幾乎擁有無限的權限，系統允許使用者定義、更改、刪除及存取所有資源，
且不受個別物件所指定的權限設定限制，但並沒有新增及更改使用者設定檔的權限，
*SECADM - 允許管理 AS/400 使用者設定檔，這是 AS/400 安全管理員的特殊權限，這授權使用
者有新增、修改、刪除其他使用者設定檔的權。
*SAVSYS - 允許使用者儲存、回復系統及資料，
*JOBCTL - 授與使用者管理工作(Job)及輸出佇列(Output queue)的權限，如一般工作的暫停、更
改、釋放及終止，子系統啟動與終止，印表機的啟動與終止，及 IPL（開機）。
*SERVICE - 允許使用者處理服務性工作，例如：Disk 等硬體資源的維護。
*SPLCTL - 允許使用者對於所有報表有全部的權限，縱然輸出佇列指定 OPRCTL(*NO) 也無法阻止
有 *SPLCTL 特殊權限的使用者，檢視非他自己的報表。
2. IBM 內建的使用者代碼 (IBM-Supplied ID's)
AS/400 為了系統作業需要而內建了一些使用者代碼(如：QSECOFR, QPGMR, QUSER, QSRV, QSRVBAS,
QSYSOPR, QUSER等)，應該將這些使用者的密碼設為 *NONE，讓使用者無法以這些使用者代碼進入系統。
3. 使用者的等級 (User Classes)
AS/400 提供 5 種使用者等級建議的特殊權限如下表：
特殊權限 使用者等級
===============================================
*SECOFR *SECADM *PGMR *SYSOPR *USER
========= ======= ======== ======== ======== ========
*ALLOBJ Yes NO No No No
*SECADM Yes Yes No No No
*JOBCTL Yes Yes Yes Yes No
*SPLCTL Yes No No Yes No
*SAVSYS Yes Yes Yes Yes No
*SERVICE Yes No No No No
*AUDIT Yes Yes No No No
*IOSYSCFG Yes Yes No No No
- *SECOFR - 最高安全使用者等級(Security Officer class)
具有最高權限可存取系統所有資源。
- *SECADM - 安全管理員(Security Administration class)
- *PGMR - 程式員等級(Programmer class)
- *SYSOPR - 系統操作員(System Operator class)
- *USER - 一般使用者
控制存取系統資源的工具
AS/400 支援多種控制存取系統資源的工具，AS/400 允許結合這些工具以符合個別作業環境的需求，
這些工具可分為以下四類：
菜單式(Menu Security)
物件資源存取(Resource Security)
繼承程式擁有者權限(Program Adoption)
授權表列(Authorization Lists)
1. 菜單式(Menu Security)
菜單式是系統強迫使用者進入系統時，依照事先定義的菜單，限制使用者只能執行菜單上的選項作業
，如果是當的設定菜單權限，使用者是無法突破這個系統控制的環境。
要使用菜單式安全控管方式，可以藉由使用者設定檔的三個參數
初始程式(Initial Program)
初始畫面(Initial Menu)
限制執行指令(Limited Capability)
- 初始程式(Initial Program)
當使用者進系統時，首先執行初始程式，強迫使用者進入事先定義的應用程式畫面，或執行
事先定義的程式，或其他某些控制功能。
- 初始畫面(Initial Menu)
當使用者進系統時，強迫使用者進入指定的菜單選項畫面。
- 限制執行指令(Limited Capability)
限制執行指令用於限制使用者是否可以藉由命令列執行指令，例如 SIGNOFF，SNDMSG，DSPMSG
或 DSPLOG 等。
結合使用初始程式及初始畫面可強迫使用者執行指定的程式或其他的菜單作業。如果你想要限制使用者
只能執行初始程式，就也需設定參數 Initial menu 值為 *SIGNOFF，這個值會於使用者退出初始化程式
時，自動將使用者退出系統。
為了限制使用者只能執行菜單上的選項作業，就也需設定參數 Limited Capability 限制執行指令為 *YES。
TCP/IP 應用軟體 FTP Server（檔案傳輸伺服器）的指令 RCMD 同樣使用者設定檔上參數
Limited Capability 限制執行指令來控管。
事實上，菜單式的安全控管方式是不夠的，還需加上物件資源安全控管，以加強資源的存取控管。
2. 物件資源存取(Resource Security)
物件資源存取 (Resource Security) 藉由個別物件授權給個別使用者或群組的方式，來達到控制使用者
存取物件的權限，或定義一個 public 的公共權限，讓系統上所有使用者都能利用公共權限所授與的權限
來存取該物件。
使用者需要授與適當的物件資源權限(Object Authority)及資料權限(Data Authority)才能順利的存取
物件資源或資料。
關於物件資源權限及資料權限詳細資料請參閱 AS/400 Security Concepts and Planning Guide - Chapter 4。
物件資源存取(Resource Security)可分為二種層次：
"library level" 或 object level 例如：
- 程式館層次(Library Level Resource Security)
Library 層次主要針對整個 Library 作控管，並不涉及 Library 內的物件及資料權限，當一個
使用者被授與對某個 Library 有存取的權限，哪這個使用者幾乎就能存取該 Library 所有的物件及資料。
Library 層次主要架構在 *PUBLIC 公共權限上，藉由 Library 層次的保護，這個受保護的 Library
可以放置重要敏感性的資料，並限制一般使用者的使用。
- 物件層次(Object Level Resource Security)
物件層次針對單一物件設定每一個使用者的存取權限，系統管理員或物件擁有者需要維護哪些使用
者可以存取該物件（例如：新的使用者加入或使用者換職務等），這對系統管理員帶來很大的工作
負擔，但可藉由群組使用者做適當的授權，便可減輕系統管理員的負擔。
3. 使用程式擁有者權限(Program Adoption)
使用程式擁有者權限(Program Adoption)允許使用者在沒有被授權特殊權限的情況下存取一個物件
（正常可能需要全部權限或某些特殊權限才能存取），當使用程式擁有者權限時，當執行程式時，
執行程式的使用者除了使用本身的權限外，還會自動繼承程式擁有者的所有權限，這提供執行程式
的使用者額外的存取物件權限，但只限於執行該程式時才有額外的存取物件權限，一但程式結束，
系統會將程式擁有者的權限移除。
在產生程式（CRTxxxPGM）時，系統的預設值是 USER(*USER)，也就是不採用繼承程式擁有者權限。
若要採用繼承程式擁有者權限就設定為 USER(*OWNER)。
4. 授權表列(Authorization List)
物件資源授權若針對單一物件授權個別使用者權限，是一向沉重的負擔，所以系統提供授權表列的
方式來簡化個別物件的授權，將多個使用者或群組依照個別權限需求，可組成授權表列，再將授權
表列設定於被授權物件的 Authorization list name，授權表列包含所有使用此授權表列的物件及
藉由此授權表列存取物件的所有使用者。
建立授權表列
CRTAUTL AUTL(AUTL1) AUT(*EXCLUDE) TEXT("Sample Authorization List")
將使用者加入授權表列，並設定使用者權限
ADDAUTLE AUTL(AUTL1) USER(xxx) AUT(xxxx)
設定物件使用授權表列權限
GRTOBJAUT OBJ(object) OBJTYPE(type) AUTL(AUTL1)
Authority to the Authorization List
┌───────────────────────────────────┐
│Authorization list name:AUTL1 │
│Owner:KARENS │
│Public authority:*EXCLUDE │
│ │
│User Authority │
│KARENS *ALL *AUTLMGT │
│TERRY *USE │
│JUDY *CHANGE │
│SCOTT *ALL │
│MARY *CHANGE *AUTLM │
└────────┬──────────────────────────┘
│
│Objects secured by
│authorization list
│ ┌───────────────┐
│ ┌────│File A │
│ │ └───────────────┘
│ │ ┌───────────────┐
│ ├────│Program B │
└─────┤ └───────────────┘
│ ┌───────────────┐
├────│File C │
│ └───────────────┘
│ ┌───────────────┐
└────│Library D │
└───────────────┘
實體及硬體的控制(Physical Security and Hardware Controls)
1. 實體的安全管制(Physical Security)
為了保護 AS/400 系統防止遭受損害或未經授權的存取，AS/400 應放在一個安全的機房，
也就是要有適當的安全控管，控制人員的進出，並要有防火，溫控，防水保護等功能。
2. AS/400 Keylock Switch
某些 AS/400 配有鎖，以防止未經授權的人直接操作 AS/400 主機面板上的功能。
參考書目：
Security Reference Version 5 SC41-5302-05
An Implementation Guide for AS/400 Security and Auditing GG24-4200-00
2002-07-15 如何檢查 IFS 檔案是否存在 (Command CHKOBJLNK) ?
如何檢查 IFS 檔案是否存在 (Command CHKOBJLNK) ?
由於現在有許多的應用軟體（HTTP power by Apache，Websphere 系列產品，Java等，你可以使用 WRKLNK 檢視有哪些路徑）會採用 AS/400 中的
IFS 檔案架構(與 PC windows 檔案架構類似)，所以有時會將檔案寫入 IFS 檔案，所以需
要檢查檔案是否存在，你可以使用下列指令檢查：
File : QCLSRC
Member: CHKOBJLNKC
Type : CLP
Usage : CRTCLPGM PGM(CHKOBJLNK)
/* CHECK OBJECT LINK */
PGM PARM(&OBJ &OBJERROR)
DCL VAR(&OBJ) TYPE(*CHAR) LEN(512)
DCL VAR(&OBJERROR) TYPE(*LGL)
DCL VAR(&OFF) TYPE(*LGL) VALUE('0')
DCL VAR(&ON) TYPE(*LGL) VALUE('1')
DCL VAR(&SPLF) TYPE(*CHAR) LEN(10) VALUE(CHKOBJLNK)
/* TURN ERROR FLAG OFF */
CHGVAR VAR(&OBJERROR) VALUE(&OFF)
/* CHECK TO SEE IF THE OBJECT EXISTS */
OVRPRTF FILE(*PRTF) HOLD(*YES) SPLFNAME(&SPLF) +
OVRSCOPE(*CALLLVL)
DSPLNK OBJ(&OBJ) OUTPUT(*PRINT) OBJTYPE(*ALL) +
DETAIL(*BASIC) DSPOPT(*USER)
MONMSG MSGID(CPFA0A9) EXEC(CHGVAR VAR(&OBJERROR) +
VALUE(&ON))
/* DELETE THE SPOOL FILE */
DLTSPLF FILE(&SPLF) SPLNBR(*LAST)
MONMSG MSGID(CPF0000)
ENDPGM
File : QCMDSRC
Member: CHKOBJLNK
Type : CMD
Usage : CRTCMD CMD(CHKOBJLNK) PGM(CHKOBJLNKC)
於 CLP 中使用指令 CHKOBJLNK OBJ(xxx) OBJERROR(&OBJERROR)
此指令會回傳值'1'表物件不存在，'0'表物件存在
/* CHECK OBJECT LINK */
CMD PROMPT('Check object link')
PARM KWD(OBJ) TYPE(*PNAME) LEN(512) MIN(1) +
PROMPT('Object Link to check')
PARM KWD(OBJERROR) TYPE(*LGL) RTNVAL(*YES) +
PROMPT('Object error')
2002-07-01 如何讓 AS/400 全系統備份自動化？
如何讓 AS/400 全系統備份自動化？
AS/400 全系統備份需要在專屬模式（restrictive state）下及需要在中控台（console）
上執行備份指令才能完成，由於專屬模式下，所有的使用者作業及所有子系統均已被停止
，只有系統作業及從中控台進入系統（SignOn）的線上即時作業可以正常執行，所以我們
可以利用中控台上的線上即時作業（interactive job）自動執行全系統備份作業。
做法是：
１：從中控台進入系統（SignOn），執行下列的指令，在程式中會從訊息佇列
（message queue）中讀取訊息，訊息佇列若沒有訊息時，程式會等待有訊息時才讀取，並判斷是否執行全系統備份作業。
２：於排程作業中設定某時間傳送訊息至訊息佇列，以啟動或終止備份作業。
File : QCLSRC
Member: FULSAVC
Type : CLP
Usage :
1. 新增訊息佇列 SAVSYSMSGQ: Yourlib - 指定您自己的 Library
CRTMSGQ MSGQ(Yourlib/SAVSYSMSGQ) TEXT('Message Queue for Unattended full save')
2. 修改程式中 Yourlib - 指定您自己的 Library 及 console DSP01 --指定您自己的 console 名稱
CRTCLPGM FULSAVC
CRTCMD CMD(FULSAV) PGM(Yourlib/FULSAVC)
3. 新增自動工作排程傳送啟動備份訊息 Yourlib - 指定您自己的 Library
此範例指定，此作業於每個星期天 16:55 執行：
ADDJOBSCDE JOB(BIGSAV) CMD(SNDMSG MSG('STRSAVSYS') TOMSGQ(Yourlib/SAVSYSMSGQ))
FRQ(*WEEKLY) SCDDATE(*NONE) SCDDAY(*SUN) SCDTIME('16:55:00') JOBQ(QGPL/QBASE)
USER(QSECOFR) TEXT('Send a message to start full system save.')
如果要取消份作業，上述指令 CMD 參數更改如下：
SNDMSG MSG( 'ENDSAVSYS' ) TOMSGQ( Yourlib/SAVSYSMSGQ)
4. 於星期五下班前，從 Console Sign On 進入系統，於命令列輸入 FULSAV，系統即進入等待上述啟動備份訊息
當每個星期天 16:55 時間到達時，系統會收到訊息判斷是否啟動備份作業。
附註：
由於資料量及磁帶容量與磁帶機設備不同，所以有可能需要一卷以上的磁帶做備份，若由於設備不足，您還是
要由人工換磁帶。使用此範例前，請先測試無問題後，在正式實施。
/* ***************************************************************** */
/* * * */
/* * * */
/* * TITLE........: Weekly Savsys & Full Nonsys Save (FULSAVC) * */
/* * * */
/* * * */
/* ***************************************************************** */
/* * * */
/* * To run an unattended SAVSYS, you can add a job scheduler * */
/* * entry as follows: * */
/* * * */
/* * SNDMSG MSG( 'STRSAVSYS' ) TOMSGQ( Yourlib/SAVSYSMSGQ) * */
/* * * */
/* * Specify the date and time you want the message to be sent. * */
/* * You should call this program from the console, and when the * */
/* * job scheduler sends the message the program will continue * */
/* * and perform the SAVSYS & full *NONSYS save followed by IPL. * */
/* * * */
/* * Note that by sending message ENDSAVSYS you can cause this * */
/* * program to end without performing the SAVSYS etc. * */
/* * * */
/* ***************************************************************** */
PGM
/* ***************************************************************** */
/* Declare Program Variables * */
/* ***************************************************************** */
DCL VAR(&MSG) TYPE(*CHAR) LEN(9) /* Message */
DCL VAR(&JOB) TYPE(*CHAR) LEN(10) /* This Job */
DCL VAR(&COUNT) TYPE(*DEC) LEN(4 0) VALUE(0) /* Retry */
/* ***************************************************************** */
/* Main Processing * */
/* ***************************************************************** */
/* Allocate the message queue to this job so it has exclusive ' */
/* use of the message queue so we can receive and remove ' */
/* messages from the queue. If we're unable to obtain the ' */
/* exclusive lock, then another job is using the queue and ' */
/* this job will cancel. ' */
ALCOBJ OBJ((Yourlib/SAVSYSMSGQ *MSGQ *EXCL)) WAIT(0)
MONMSG MSGID(CPF0000) EXEC(SNDPGMMSG MSGID(CPF9897) +
MSGF(QCPFMSG) MSGDTA('Unable to allocate +
SAVSYS message queue.') TOUSR(*SYSOPR) +
MSGTYPE(*ESCAPE))
/* Make sure that we are running on DSP01 (The Console)' */
/* If we're not, this job will end when we do ENDSBS *ALL *IMMED! */
RTVJOBA JOB(&JOB)
IF COND(&JOB *NE 'DSP01 ') THEN(SNDPGMMSG +
MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA('DO +
IT ON THE CORRECT SCREEN YOU MUPPET!!!!') +
MSGTYPE(*ESCAPE))
/* Remove any old messages from message queue */
RMVMSG MSGQ(Yourlib/SAVSYSMSGQ) CLEAR(*ALL)
/* Change this job's message queues to *Hold so we don't get any. */
CHGJOB LOGCLPGM(*YES) BRKMSG(*NOTIFY)
CHGMSGQ MSGQ(*USRPRF) DLVRY(*HOLD)
MONMSG MSGID(CPF2451)
CHGMSGQ MSGQ(*WRKSTN) DLVRY(*NOTIFY)
/* Receive messages in the queue. WAIT(*MAX) tells the system */
/* to wait for a message forever if no messages are in the */
/* queue. Once the message is received, it will be removed. */
Loop:
SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) +
MSGDTA('Waiting for somebody to tell me +
to start save of entire system........') +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
CHGJOB STSMSG(*NONE)
RCVMSG MSGQ(Yourlib/SAVSYSMSGQ) MSGTYPE(*ANY) +
WAIT(*MAX) RMV(*YES) MSG(&MSG)
CHGJOB STSMSG(*SYSVAL)
/* If the message is neither STRSAVSYS or ENDSAVSYS, ignore */
IF COND((&MSG *NE 'STRSAVSYS') *AND (&MSG *NE +
'ENDSAVSYS')) THEN(GOTO CMDLBL(LOOP))
/* If the message is STRSAVSYS, continue with Saves */
IF COND(&MSG *EQ 'STRSAVSYS') THEN(DO)
/* Send Start of wait Message to Qsysopr */
SNDPGMMSG MSG(SAVSYS starting in 5 mins.) +
TOMSGQ(*SYSOPR)
/* Send message to all users telling them to sign off */
SNDPGMMSG +
MSG(' -
****** The Backups for tonight will start in 5 minutes... +
Please sign off the AS/400 +
Immediately. *******') TOUSR(*ALLACT)
/* Delay job for next five minutes */
SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) +
MSGDTA('Waiting for five minutes while +
users sign off........................') +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
CHGJOB STSMSG(*NONE)
DLYJOB DLY(300)
CHGJOB STSMSG(*SYSVAL)
/* End all the subsystems */
Loop3: SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) +
MSGDTA('Ending all the subsystems.....') +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
CHGJOB STSMSG(*NONE)
ENDSBS SBS(*ALL) OPTION(*IMMED)
/* Delay job for next four minutes */
CHGJOB STSMSG(*SYSVAL)
SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) +
MSGDTA('Waiting for four minutes while +
Subsystems are ended..................') +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
CHGJOB STSMSG(*NONE)
DLYJOB DLY(240)
/* Start SAVSYS */
CHGJOB STSMSG(*SYSVAL)
SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) +
MSGDTA('Saving the system (SAVSYS)... +
......................................') +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
CHGJOB STSMSG(*NONE)
/* Loop 2 tries to do a savsys. If the system is not yet in */
/* restricted state, a count is incremented, and the program waits */
/* another two minutes and tries again. */
LOOP2: SAVSYS DEV(TAP03) ENDOPT(*LEAVE) OUTPUT(*PRINT) +
CLEAR(*ALL)
MONMSG MSGID(CPF3785) EXEC(DO)
CHGVAR VAR(&COUNT) VALUE(&COUNT + 1)
/* If we have retried 12 times (24 minutes), NYCOMSGR is started and */
/* a message is sent to QSYSOPR to be paged out. The program then */
/* loops to LOOP3 to attempt Endsbs *all *immed again. */
IF COND(&COUNT *GE 12) THEN(DO)
STRSBS SBSD(NYCOMSGR)
DLYJOB DLY(120)
SNDMSG MSG('The system wont go down on me!!') +
TOUSR(*SYSOPR)
GOTO CMDLBL(LOOP3)
ENDDO
DLYJOB DLY(120)
GOTO CMDLBL(LOOP2)
ENDDO
CHGJOB STSMSG(*SYSVAL)
/* Start SAVLIB *NONSYS */
SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) +
MSGDTA('Saving all the user libraries +
(SAVLIB *NONSYS).....................') +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
CHGJOB STSMSG(*NONE)
SAVLIB LIB(*NONSYS) DEV(TAP03) ENDOPT(*LEAVE) +
CLEAR(*AFTER) ACCPTH(*YES) OUTPUT(*PRINT)
MONMSG MSGID(CPF3777) EXEC(SNDMSG MSG('Not All +
objects Saved On Sunday Night!!!! Look at +
log of job DSP01') TOMSGQ(GSKELTON +
ACUSWORTH JBARRY DCOLAM DSTEER))
CHGJOB STSMSG(*SYSVAL)
/* Start SAVDLO */
SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) +
MSGDTA('Saving all Document libraries +
(SAVDLO DLO(*ALL)....................') +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
CHGJOB STSMSG(*NONE)
SAVDLO DLO(*ALL) FLR(*ANY) DEV(TAP03) +
ENDOPT(*LEAVE) OUTPUT(*PRINT) CLEAR(*AFTER)
CHGJOB STSMSG(*SYSVAL)
/* Start save of all directory objects */
SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) +
MSGDTA('Saving all Directory objects (SAV +
OBJ((''/*'')......................') +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
CHGJOB STSMSG(*NONE)
SAV DEV('/QSYS.LIB/TAP03.DEVD') OBJ(('/*') +
('/QSYS.LIB' *OMIT) ('/QDLS' *OMIT)) +
OUTPUT(*PRINT) ENDOPT(*UNLOAD) +
UPDHST(*YES) CLEAR(*AFTER)
CHGJOB STSMSG(*SYSVAL)
/* Apply PTFs permanently */
SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) +
MSGDTA('Applying PTFs.................... +
..................................') +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
CHGJOB STSMSG(*NONE)
APYPTF LICPGM(*ALL) APY(*PERM) DELAYED(*YES)
MONMSG MSGID(CPF3660)
CHGJOB STSMSG(*SYSVAL)
/* Power Down the System */
SNDPGMMSG MSGID(CPF9898) MSGF(QSYS/QCPFMSG) +
MSGDTA('Powering down the system......... +
..................................') +
TOPGMQ(*EXT) MSGTYPE(*STATUS)
CHGJOB STSMSG(*NONE)
PWRDWNSYS OPTION(*IMMED) RESTART(*YES)
CHGJOB STSMSG(*SYSVAL)
ENDDO
/* The program would not normally get to this point. If it does, */
/* it is because the message 'ENDSAVSYS' has been received. */
/* The job will now sign off for security. */
SIGNOFF LOG(*LIST)
ENDPGM
/* ***************************************************************** */
訂閱：
文章 (Atom)