如何擷取某一個子系統(Subsystem)的狀態？(RTVSBSSTS with API QWDRSBSD)
於系統管理上，常會有需要限定某些工作(Job)只能執行於限定的子系統(subsystem)，
如利用工作站名稱分類的子系統，依批次工作分類的批次子系統等等。建立子系統有助
於系統管理及系統效能的提升，然而有時就會需要檢查某一個子系統是否已在系統中執
行？可利用 API QWDRSBSD(Retrieve subsystem information) 來擷取子系統的狀態
及有幾個 job 正在該仔細統中執行等資訊。
File : QCLSRC
Member: RTVSBSSTSC
Type : CLP
Usage : CRTCLPGM RTVSBSSTSC
PGM PARM(&RTVSBS &SBSSTS &JOBCNTC)
DCL VAR(&RTVSBS) TYPE(*CHAR) LEN(20)
DCL VAR(&SBSSTS) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBCNTC) TYPE(*CHAR) LEN(3)
DCL VAR(&RCVDTA) TYPE(*CHAR) LEN(360)
DCL VAR(&RCVLEN) TYPE(*DEC) LEN(3 0) VALUE(360)
DCL VAR(&RCVLENB) TYPE(*CHAR) LEN(4)
DCL VAR(&FMTNAM) TYPE(*CHAR) LEN(8) VALUE('SBSI0100')
DCL VAR(&JOBCNT#) TYPE(*DEC) LEN(3 0)
DCL &ERRCOD *CHAR 8 (X'0000000000000000')
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)
CHGVAR VAR(%BIN(&RCVLENB)) VALUE(&RCVLEN)
/* RETRIEVE SUBSYSTEM INFORMATION */
CALL PGM(QWDRSBSD) PARM( &RCVDTA +
&RCVLENB +
&FMTNAM +
&RTVSBS +
&ERRCOD )
CHGVAR &SBSSTS %SST(&RCVDTA 29 10)
CHGVAR VAR(&JOBCNT#) VALUE(%BIN(&RCVDTA 73 4))
CHGVAR VAR(&JOBCNTC) VALUE(&JOBCNT#)
/*--------------------------------------------------------*/
/* 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: RTVSBSSTS
Type : CMD
Usage : CRTCMD CMD(RTVSBSSTS) PGM(RTVSBSSTSC) ALLOW(*IPGM *BPGM)
/********************************************************************/
/* Title: RTVSBSSTS: RETRIEVE SUBSYSTEM STATUS */
/* */
/* Description - This command retrieve subsystem satatus */
/* */
/* The Create Command command should include the following: */
/* */
/* CRTCMD CMD(RTVSBSSTS) PGM(RTVSBSSTSC) */
/* RETURN SBSSTS : *ACTIVE OR *INACTIVE */
/* JOBCNT : HOW MANY JOBS CURRENTLY RUNNING IN SUBSYSTEM */
/********************************************************************/
/*------------------------------------------------*/
/* Command Definition */
/*------------------------------------------------*/
CMD PROMPT('Retrieve Subsystem Status')
PARM KWD(SBSD) TYPE(SBSD) MIN(1) +
PROMPT('Subsystem Description')
PARM KWD(SBSSTS) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
PROMPT('Return Subsystem Status')
PARM KWD(JOBCNT) TYPE(*CHAR) LEN(3) +
RTNVAL(*YES) PROMPT('Return Jobs count in +
Sybsystem')
SBSD: QUAL TYPE(*NAME) LEN(10) MIN(1) EXPR(*YES)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*CURLIB)) EXPR(*YES) +
PROMPT('Library')
File : QCLSRC
Member: RTVSBSSTST
Type : CLP
Usage : CRTCLPGM RTVSBSSTST
測試程式
CALL RTVSBSSTST ('subsystem-name' 'library')
或
CALL RTVSBSSTST ('QINTER' '*LIBL')
PGM PARM(&SBSNAME &SBSLIB)
DCL VAR(&SBSNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&SBSLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&SBSSTS) TYPE(*CHAR) LEN(10)
DCL VAR(&JOBCNTC) TYPE(*CHAR) LEN(3)
DCL VAR(&ERROR) TYPE(*LGL) /* std err */
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) /* std err */
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4) /* std err */
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(100) /* std err */
DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) /* std err */
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) /* std err */
DCL VAR(&MSGTYP) TYPE(*CHAR) LEN(10) +
VALUE('*DIAG') /* std err */
DCL VAR(&MSGTYPCTR) TYPE(*CHAR) LEN(4) +
VALUE(X'00000001') /* std err */
DCL VAR(&PGMMSGQ) TYPE(*CHAR) LEN(10) VALUE('*') +
/* std err */
DCL VAR(&STKCTR) TYPE(*CHAR) LEN(4) +
VALUE(X'00000001') /* std err */
DCL VAR(&ERRBYTES) TYPE(*CHAR) LEN(4) +
VALUE(X'00000000') /* std err */
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
RTVSBSSTS SBSD(&SBSLIB/&SBSNAME) SBSSTS(&SBSSTS) +
JOBCNT(&JOBCNTC)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('THE +
NUMBER OF JOBS ACTIVE IN ' || &SBSNAME *BCAT +
'IS ' || &JOBCNTC || ' & THE SBS IS ' || &SBSSTS)
/*--------------------------------------------------------*/
ERROR:
IF COND(&ERROR) THEN(GOTO CMDLBL(ERRORDONE))
ELSE CMD(CHGVAR VAR(&ERROR) VALUE('1'))
/*----------------------------------------------*/
/* move all *DIAG message to *PRV program queue*/
/*----------------------------------------------*/
CALL PGM(QMHMOVPM) PARM(&MSGKEY &MSGTYP +
&MSGTYPCTR &PGMMSGQ &STKCTR &ERRBYTES)
/*----------------------------------------------*/
/* resend the last *ESCAPE message */
/*----------------------------------------------*/
ERRORDONE:
CALL PGM(QMHRSNEM) PARM(&MSGKEY &ERRBYTES)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSGID(CPF3CF2) MSGF(QCFPMSG) +
MSGDTA('QMHRSNEM') MSGTYPE(*ESCAPE)
MONMSG MSGID(CPF0000)
ENDDO
END: ENDPGM
星期一, 11月 06, 2023
2003-10-28 如何擷取某一個子系統(Subsystem)的狀態？(RTVSBSSTS with API QWDRSBSD)
星期二, 10月 31, 2023
2001-07-19 如何使用 System API 列出 Subsystem Description 的相關資訊 ?
如何使用 System API 列出 Subsystem Description 的相關資訊 ?
File : QRPGLESRC
Member: ANZSBSDR
Type : RPGLE
利用 System API 函數或
下指令 DSPSBSD sunsystem *Print
因指令 DSPSBSD 輸出太複雜，所以我使用
System API 函數，列出 Active subsystem
的相關設定資料
*/ Upload to QRPGLESRC member 112 long
*/ CRTBNDRPG
*----------------------------------------------------------------
* anzsbsdr - generate report for subsystem related entries.
*
* Created by Vengoal Chang, 7/18/2001
*
*----------------------------------------------------------------
* program summary:
*
* executes api to load all active subsystem names into array.
* sort the array in ascending sequence for printing.
* execute api to get pool id..
* execute api to pool id of routing entries
* print report
*
*----------------------------------------------------------------
* api (application program interface) calls:
* quscrtus create user space
* qwclasbs list active subsystems
* qsdrsbsd retrieve subsystem info - get pool ids
* qwdlsbse list subsystem entries
* The following formats can be used:
*
* SBSE0100 Routing entry list.
* SBSE0200 Communications entry list.
* SBSE0300 Remote locations entry list.
* SBSE0400 Autostart job entry list.
* SBSE0500 Prestart job entry list.
* SBSE0600 Workstation name entry list.
* SBSE0700 Workstation type entry list.
*
* qwdlsjbq list subsystem entries - get jobq entries
* qwcrneta retrieve network attribute - get system name
*
* see system programmer's INTERFACE REFERENCE for API detail.
*----------------------------------------------------------------
Fqsysprt o f 198 printer Oflind(*InOV)
*
D psds sds
D JobDate 270 275S 0
*----------------------------------------------------------------
* Get user space list info from header section.
*----------------------------------------------------------------
D ds based(uHeadPtr)
D uOffSetToList 125 128i 0 offset to list
D uNumOfEntrys 133 136i 0 number list entries
D uSizeOfEntry 137 140i 0 list entry size
*
*----------------------------------------------------------------
* Field to move through user space by pointer.
*----------------------------------------------------------------
D uListEntry ds Based(uListPtr) sbs lib
D uSbsLib 20 sbs lib
* for Rounting Entry format SBSE0100
D uSquenceNO 10i 0 overlay(uListEntry:1)
D uRoutingPgm 10 overlay(uListEntry:5)
D uRoutingPgmLib 10 overlay(uListEntry:15)
D uRoutingClass 10 overlay(uListEntry:25)
D uRoutingClsLib 10 overlay(uListEntry:35)
D uMaxRoutingStp 10i 0 overlay(uListEntry:45)
D uRoutingPoolId 10i 0 overlay(uListEntry:49)
D uCmpStrPos 10i 0 overlay(uListEntry:53)
D uCmpValue 80 overlay(uListEntry:57)
* for AutoStart Job format SBSE0400
D uAutostartJob 10 overlay(uListEntry:1)
D uAutostartJobD 10 overlay(uListEntry:11)
D uAutostartJobL 10 overlay(uListEntry:21)
* for Rounting Entry format SBSE0500
D uPreJobPgm 10 overlay(uListEntry:1)
D uPreJobPgmLib 10 overlay(uListEntry:11)
D uUsrPrf 10 overlay(uListEntry:21)
D uStartJob 1 overlay(uListEntry:31)
D uWaitJob 1 overlay(uListEntry:32)
D uIniNumJobs 10i 0 overlay(uListEntry:33)
D uThreshold 10i 0 overlay(uListEntry:37)
D uAdditionalJob 10i 0 overlay(uListEntry:41)
D uMaxNumJobs 10i 0 overlay(uListEntry:45)
D uMaxNumUse 10i 0 overlay(uListEntry:49)
D uPoolId 10i 0 overlay(uListEntry:53)
D uPreJobName 10 overlay(uListEntry:57)
D uPreJobD 10 overlay(uListEntry:67)
D uPreJobDLib 10 overlay(uListEntry:77)
D uFirstClsName 10 overlay(uListEntry:89)
D uFirstClsLib 10 overlay(uListEntry:99)
D uNumJobsUseFst 10i 0 overlay(uListEntry:109)
D uSecClassName 10 overlay(uListEntry:113)
D uSecClassLib 10 overlay(uListEntry:123)
D uNumJobsUseSec 10i 0 overlay(uListEntry:133)
* for Workstation Entrys format name SBSE0600 , type SBSE0700
D uWorkStationNM 10 overlay(uListEntry:1)
D uWorkStationJD 10 overlay(uListEntry:11)
D uWorkStationJL 10 overlay(uListEntry:21)
D uControlJob 10 overlay(uListEntry:31)
D uMaxActJob 10i 0 overlay(uListEntry:41)
* for Jobq Entrys format name SJQL0100
D uJobqName 10 overlay(uListEntry:1)
D uJobqLib 10 overlay(uListEntry:11)
D uSeqNo 10i 0 overlay(uListEntry:21)
D uAllocInd 10 overlay(uListEntry:25)
D ureserved 2 overlay(uListEntry:35)
D uMaxAct 10i 0 overlay(uListEntry:37)
D uMaxActPri1 10i 0 overlay(uListEntry:41)
D uMaxActPri2 10i 0 overlay(uListEntry:45)
D uMaxActPri3 10i 0 overlay(uListEntry:49)
D uMaxActPri4 10i 0 overlay(uListEntry:53)
D uMaxActPri5 10i 0 overlay(uListEntry:57)
D uMaxActPri6 10i 0 overlay(uListEntry:61)
D uMaxActPri7 10i 0 overlay(uListEntry:65)
D uMaxActPri8 10i 0 overlay(uListEntry:69)
D uMaxActPri9 10i 0 overlay(uListEntry:73)
D MaxPri 10i 0 overlay(uListEntry:41) dim(9)
*
D MaxPriDs ds sbs lib
D MaxActPri1C 10
D MaxActPri2C 10
D MaxActPri3C 10
D MaxActPri4C 10
D MaxActPri5C 10
D MaxActPri6C 10
D MaxActPri7C 10
D MaxActPri8C 10
D MaxActPri9C 10
D MaxPriC 10 overlay(MaxPriDs:1) dim(9)
*
*----------------------------------------------------------------
* Define various numeric counters, indexes and such.
*----------------------------------------------------------------
D aa s 5u 0
D bb s 5u 0
D cc s 5u 0
D xx s 5u 0
D yy s 5u 0
D zz s 10u 0
D ii s 10u 0
*
*----------------------------------------------------------------
* array of subsystem names to allow alpha sorting for report.
* array of routing entry pool IDs so only unique IDs will print.
*----------------------------------------------------------------
D ArryOfSBS s 20 dim(999) ascend sort array
D ArryOfRtg s 10i 0 dim(50) ascend inz unique only
*
*----------------------------------------------------------------
* Get pool ID and names into print string.
*----------------------------------------------------------------
D vrcvar ds 1000
D vNumPools 10i 0 overlay(vrcvar:77)
*
D vrcvarlen s 10i 0 inz(%size(vrcvar))
D vQualSbsName s 20
*
D PoolDSAPI ds based(ptr_pool) get from API
D PNumAPI 10i 0
D PNameAPI 10
*
D PoolDSPRT ds 15 load print string
D PNumPrt 1 2
D PNamePrt 4 14
*
D PoolString s 75 print string
D RtgString s 30 print string
D PRtgPrt s 3
*
*----------------------------------------------------------------
* Define parms for Create User space API.
*----------------------------------------------------------------
D ExtndAttrb s 10 inz('TEST ')
D Hex0Init s 1 inz(x'00')
D UseAthrity s 10 inz('*ALL ')
D SpaceText s 50 inz('User command space')
D ReplaceObj s 10 inz('*NO ')
D LenOfSpace s 10i 0 inz(1000000)
D Domain s 10 inz('*DEFAULT')
D TransferSize s 10i 0 inz(32)
D OptimumAlign s 1 inz('1')
*
*----------------------------------------------------------------
* These field are defined to retrieve system name from QWCRNETA
*----------------------------------------------------------------
D vsysnm s 8 EXTRACT SYSNAM
*
* Load number of attributes to retrieve and attribute name
D vapiky ds
D vnkfld 10i 0 inz(1)
D vkarry 11 inz('SYSNAME')
*
* Number of keys returned and offset to attribute data
D vrcvr1 ds 200 inz
D vnkyrt 10i 0
D voffna 10i 0
D vrcvln s 10i 0 inz
*
* Network Attribute Information Table returned
D vnait ds inz
D vrtatt 1 10
D vrttyp 11 11
D vrtsta 12 12
D vrtlen 10i 0
*
*----------------------------------------------------------------
* Error return code parm for APIs.
*----------------------------------------------------------------
D vApiErrDs ds
D vbytpv 10i 0 inz(%size(vApiErrDs)) bytes provided
D vbytav 10i 0 inz(0) bytes returned
D vmsgid 7 error msgid
D vresvd 1 reserved
D vexdta 50 replacement data
*
*----------------------------------------------------------------
* load the active subsystem names to the the user space.
*----------------------------------------------------------------
C call 'QWCLASBS' LOAD ACTIVE SBS
C parm uSpaceName USER SPACE
C parm 'SBSL0100' vfornm 8 TYPE FORMAT
C parm vApiErrDs
*
*----------------------------------------------------------------
* Move through user space to get the subsystem name and library.
* load into array for sorting.
*----------------------------------------------------------------
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
1B C do uNumOfEntrys PROCESS LOOP
*
C add 1 xx
C eval ArryOfSBS(xx)=uSbsLib
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
1E C enddo
*
*---------------------------------------------------------------------------------------------
* Sort the array and position the element counter to beginning of loaded entries.
*---------------------------------------------------------------------------------------------
C sorta ArryOfSBS
C eval xx=1000-xx skip to data
*
*---------------------------------------------------------------------------------------------
* Spin though the sorted array
*---------------------------------------------------------------------------------------------
1B C xx do 999 yy
C eval vQualSbsName=ArryOfSBS(yy)
*
*---------------------------------------------------------------------------------------------
* Get POOL id number and names. Load up to 5 entries into string for printing.
*---------------------------------------------------------------------------------------------
C call 'QWDRSBSD' retrieve Sbs Info
C parm vrcvar
C parm vrcvarlen
C parm 'SBSI0100' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
*
C eval ptr_pool = %addr(vrcvar)+80
C clear PoolString
C z-add 1 aa
*
2B C do vNumPools zz
3B C if zz>5
2L C leave
3E C endif
*
C evalr PNumPrt=%editc(PNumAPI:'4')
C eval PNamePrt = PNameAPI
C eval %subst(PoolString:aa)= PoolDsPrt
C add 15 aa
C eval ptr_pool=ptr_pool+28 next offset
2E C enddo
*
*---------------------------------------------------------------------------------------------
* load the routing entries for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSBSE' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SBSE0100' vfornm 8 TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
*
* -----------------------------------------------------------------------------------------
* This is a little complicated. The same routing pool entry ID could be in many
* of the routing entries. We only want to show one . I will
* use an array to lookup and see if the entry is used yet.
* -----------------------------------------------------------------------------------------
C clear aa
C clear ArryOfRtg
C eval RtgString=*all'- '
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
C except heading
C except routingh
C if uNumOfEntrys = 0
C except nodata
C endif
2B C do uNumOfEntrys PROCESS LOOP
C
C except routingd
C if *InOV = *On
C except heading
C except routingh
C eval *InOV = *Off
C endif
C
C uRoutingPoolIDlookup ArryOfRtg 81
3B C if *in81=*off
C add 1 aa
C eval ArryOfRtg(aa)=uRoutingPoolID
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
2E C enddo
*
* -------------------------------------------------------------------------------------
* Sort the array and load it into print string.
* -------------------------------------------------------------------------------------
C sorta ArryOfRTG
C eval aa=51-aa
*
*---------------------------------------------------------------------------------------------
* Spin through the array loading the print string
*---------------------------------------------------------------------------------------------
C z-add 1 cc
2B C aa do 50 bb
C evalr PRtgPrt=%editc(ArryOfRtg(bb):'4')
C eval %subst(RtgString:cc:3)=PRtgPrt
C add 3 cc
2E C enddo
*
C except poolidh
C except poolidd
*
*---------------------------------------------------------------------------------------------
* load the JobQueue entries for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSJBQ' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SJQL0100' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
C except heading
C except jobqh
C if uNumOfEntrys = 0
C except nodata
C endif
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
2B C do uNumOfEntrys PROCESS LOOP
C
C clear MaxPriC
C for ii = 1 to 9
C if MaxPri(ii) = -1
C eval MaxPriC(ii)= '*NOMAX'
C else
C eval MaxPriC(ii)= %editc(MaxPri(ii): '4')
C endif
C endfor
C except jobqd
3B C if *InOV = *On
C except heading
C except jobqh
C eval *InOV = *Off
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
C
2E C enddo
*
*---------------------------------------------------------------------------------------------
* load the Autostart entries for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSBSE' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SBSE0400' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
C except heading
C except autostarth
C if uNumOfEntrys = 0
C except nodata
C endif
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
2B C do uNumOfEntrys PROCESS LOOP
C
C except autostartd
3B C if *InOV = *On
C except heading
C except autostarth
C eval *InOV = *Off
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
C
2E C enddo
*
*---------------------------------------------------------------------------------------------
* load the prestart entries for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSBSE' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SBSE0500' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
C except heading
C except prestarth
C if uNumOfEntrys = 0
C except nodata
C endif
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
2B C do uNumOfEntrys PROCESS LOOP
C z-add uIniNumJobs IniNumJobs 5 0
C z-add uThreshold Threshold 5 0
C z-add uAdditionalJobAdditionalJob 5 0
C z-add uMaxNumJobs MaxNumJobs 5 0
C z-add uMaxNumUse MaxNumUse 5 0
C z-add uPoolId PoolId 5 0
C z-add uNumJobsUseFstNumJobsUseFst 5 0
C z-add uNumJobsUseSecNumJobsUseSec 5 0
C
C except prestartd
3B C if *InOV = *On
C except heading
C except prestarth
C eval *InOV = *Off
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
C
2E C enddo
*
*---------------------------------------------------------------------------------------------
* load the WorkStation entrys for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSBSE' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SBSE0600' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
C except heading
C except workstnnmh
C if uNumOfEntrys = 0
C except nodata
C endif
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
2B C do uNumOfEntrys PROCESS LOOP
C
C move *blanks MaxActJobC 10
C if uMaxActJob = -1
C eval MaxActJobC = '*NOMAX'
C else
C eval MaxActJobC = %editc(uMaxActJob : '4')
C endif
C except workstnnmd
3B C if *InOV = *On
C except heading
C except workstnnmh
C eval *InOV = *Off
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
C
2E C enddo
*
*---------------------------------------------------------------------------------------------
* load the workStation entrys for this subsystem into the user space
*---------------------------------------------------------------------------------------------
C call 'QWDLSBSE' list sbs entries
C parm uSpaceName USER SPACE
C parm 'SBSE0700' vfornm TYPE FORMAT
C parm vQualSbsName
C parm vApiErrDs
C except heading
C except workstntyh
C if uNumOfEntrys = 0
C except nodata
C endif
C eval uListPtr = uHeadPtr + uOffSetToList START OF LIST
2B C do uNumOfEntrys PROCESS LOOP
C
C move *blanks MaxActJobC 10
C if uMaxActJob = -1
C eval MaxActJobC = '*NOMAX'
C else
C eval MaxActJobC = %editc(uMaxActJob : '4')
C endif
C except workstnnmd
3B C if *InOV = *On
C except heading
C except workstntyh
C eval *InOV = *Off
3E C endif
C eval uListPtr = uListPtr + uSizeOfEntry NEXT ENTRY
C
2E C enddo
*
1E C enddo
C eval *inlr=*on
*
*---------------------------------------------------------------------------------------------
* Call API to retrieve network attributes.
* Use offset to extract Network Attribute Information Table.
* Extract system name from table.
*---------------------------------------------------------------------------------------------
C *inzsr begsr
C call 'QWCRNETA' RETRIEVE SPACE
C parm vrcvr1
C parm 200 vrcvln
C parm vnkfld NUMBER OF KEYS
C parm vkarry KEY ARRAY
C parm vApiErrDs
*
C voffna add 1 aa START OFFSET
C eval vnait = %subst(vrcvr1:aa:16) LOAD NAIT DST
*
C add 16 aa START OF DATA
C vrtlen subst vrcvr1:aa vsysnm EXTRACT SYSNAM
C clear aa
C* except Headin
C* except heading
C* except routingh
*
* -CREATE USER SPACE-----------------------------------------------------------------------
C eval uSpaceName = 'JCRCMDS QTEMP '
C call 'QUSCRTUS' CREATE USER SPC
C parm uSpaceName 20 SPACE LIB
C parm ExtndAttrb EXTENDED ATRIB
C parm LenOfSpace SIZE IN BYTES
C parm Hex0Init INITIAL VALUE
C parm UseAthrity AUTHORITY
C parm SpaceText
C parm ReplaceObj
C parm vApiErrDs
*** parm Domain
*** parm TransferSize
*** parm OptimumAlign
*
* -GET POINTER TO USER SPACE---------------------------------------------------------------
C call 'QUSPTRUS' GET POINTER TO SPACE
C parm uSpaceName SPACE LIB
C parm uHeadPtr
C endsr
*
*---------------------------------------------------------------------------------------------
*
Oqsysprt e heading 1 01
O 10 'ANZSBSDR '
O 72 'ANALYZE SUBSYSTEM INFO'
O 198 'JCR'
O e heading 1
O 109 'SYSTEM:'
O vsysnm 120
O e heading 2
O 109 'Date :'
O JobDate Y 120
O e nodata 1
O vQualSbsName
O +1 'No Entrys data!'
O e poolidh 2 1
O 4 'SBSD'
O 43 'ROUTING ENTRY POOLID'
O 58 'POOLS'
O e poolidd 1
O vQualSbsName
O RtgString +1
O PoolString +1
O e routingh 1
O 15 'Routing Entries'
O e routingh 1
O 4 'SBSD'
O 31 'SeqNO'
O 42 'RoutingPgm'
O 66 'RoutingClass'
O 86 'MaxStep'
O 97 'PoolID'
O 108 'StrPos'
O 117 'CmpValue'
O e routingd 1
O vQualSbsName
O uSquenceNo 4 +1
O uRoutingPgm +1
O uRoutingPgmLib +1
O uRoutingClass +1
O uRoutingClsLib +1
O uMaxRoutingStp4 +1
O uRoutingPoolID4 +1
O uCmpStrPos 4 +1
O uCmpValue +1
O e jobqh 1
O 12 'JobQ Entries'
O e jobqh 1
O 9 'SUBSYSTEM'
O 17 'LIBRARY'
O 25 'Jobq'
O 41 'Library'
O 55 'SeqNo'
O 64 'AllocInd'
O 77 'MaxAct'
O 103 'Maximum by priority 1 - 9'
O e jobqd 1
O vQualSbsName
O uJobqName +1
O uJobqLib 44
O uSeqNo 4 55
O uAllocInd 66
O uMaxAct 4 77
O MaxActPri1C +1
O MaxActPri2C +1
O MaxActPri3C +1
O MaxActPri4C +1
O MaxActPri5C +1
O MaxActPri6C +1
O MaxActPri7C +1
O MaxActPri8C +1
O MaxActPri9C +1
O e autostarth 1
O 21 'Autostart Job Entries'
O e autostarth 1
O 9 'SUBSYSTEM'
O 17 'LIBRARY'
O 33 'AutostartJob'
O 49 'Job Description'
O 57 'Library'
O e autostartd 1
O vQualSbsName
O uAutostartJob +1
O uAutostartJobD 44
O uAutostartJobL 60
O e prestarth 1
O 20 'Prestart Job Entries'
O e prestarth 1
O 9 'SUBSYSTEM'
O 17 'LIBRARY'
O 28 'PROGRAM'
O 39 'LIBRARY'
O 47 'User'
O 55 'S'
O 57 'W'
O 63 'IniJob'
O 69 'Thres'
O 75 'AddJob'
O 81 'Max'
O 87 'Use'
O 93 'Pool'
O 104 'PreJobName'
O 112 'PreJobD'
O 123 'Library'
O 134 'Class 1'
O 145 'Library'
O 154 'Use'
O 162 'Class 2'
O 173 'Library'
O 182 'Use'
O e prestartd 1
O vQualSbsName
O uPreJobPgm +1
O uPreJobPgmLib +1
O uUsrPrf +1
O uStartJob +1
O uWaitJob +1
O IniNumJobs 4 +1
O Threshold 4 +1
O AdditionalJob 4 +1
O MaxNumJobs 4 +1
O MaxNumUse 4 +1
O PoolId 4 +1
O uPreJobName +1
O uPreJobD +1
O uPreJobDLib +1
O uFirstClsName +1
O uFirstClsLib +1
O NumJobsUseFst 4 +1
O uSecClassName +1
O uSecClassLib +1
O NumJobsUseSec 4 +1
O e workstnnmh 1
O 24 'Workstation Name Entries'
O e workstnnmh 1
O 9 'SUBSYSTEM'
O 17 'LIBRARY'
O 32 'WorkStation'
O 49 'Job Description'
O 57 'Library'
O 71 'ControlJob'
O 82 'MaximumJob'
O e workstntyh 1
O 24 'Workstation Type Entries'
O e workstntyh 1
O 9 'SUBSYSTEM'
O 17 'LIBRARY'
O 37 'WorkStation Type'
O 54 'Job Description'
O 62 'Library'
O 76 'ControlJob'
O 87 'MaximumJob'
O e workstnnmd 1
O vQualSbsName
O uWorkstationNM +1
O uWorkstationJD 49
O uWorkstationJL 65
O uControlJob 76
O MaxActJobC 87
星期一, 10月 30, 2023
2015-06-01 如何取得系統正在執行中的子系統(Active subsystem)？(Retrieve active subsystems with List Active Subsystems (QWCLASBS) API)
2015-06-01 如何取得系統正在執行中的子系統(Active subsystem)？(Retrieve active subsystems with List Active Subsystems (QWCLASBS) API)
Member: RTVACTSBS
Usage : CRTCLPGM PGM(RTVACTSBS)
/*-------------------------------------------------------------------*/
/* */
/* Program . . : RTVACTSBS */
/* Description : Retrieve active subsystems CPP */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : June 1, 2015 */
/* */
/* Program function: Retrieve active subsystems */
/* */
/* */
/* Compile options: */
/* CrtClPgm Pgm( RTVACTSBS ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* */
/*-------------------------------------------------------------------*/
Pgm (&RtnSbs &NbrSbs)
Dcl &RtnSbs *char 9800
Dcl &NbrSbs *dec (5 0)
/* API User Space Variables */
Dcl &a_inl *char 1 value( x'00' ) /* Initializer */
Dcl &a_siz *int value( 16384 ) /* Initial size */
Dcl &offslst *int value( 1 ) /* Initial offset */
Dcl &nbrlste *int
Dcl &sizlste *int value( 150 ) /* Init entry sz */
/* General fields... */
Dcl &i *int /* Loop counter */
Dcl &us_hdr *char 150 /* Retrieved Hdr */
Dcl &SBSENT *char 20 /* Retrieved Ent */
Dcl &usrspc *char 10 value( 'ACTSBSD' )
Dcl &usrspclib *char 10 value( 'QTEMP' )
Dcl &qusrspc *char 20
Dcl &sbsd *char 10
Dcl &sbsdlib *char 10 value( '*LIBL' )
Dcl &pospos *dec (5 0)
MonMsg ( Cpf0000 Mch0000 ) Exec( Goto Error )
Dltusrspc &usrspclib/&usrspc
MonMsg Cpf0000
/* Create *usrspc for the SBS info APIs... */
/* Active subsystems will be listed into the space. Basic info will be */
/* retrieved from the space header and used to loop through entries... */
/* Set the qualified *usrspc name... */
Chgvar &qusrspc ( &usrspc *cat &usrspclib )
Call QUSCRTUS ( +
&qusrspc +
'ACTSBSD' +
&a_siz +
&a_inl +
'*ALL ' +
'List active SBSDs ' +
'*YES ' +
x'0000000000000000' +
)
/* List the active SBSDs into our *usrspc... */
Call QWCLASBS ( +
&qusrspc +
'SBSL0100' +
x'00000000' +
)
/* Set our loop control from the *usrspc headers... */
Call QUSRTVUS ( +
&qusrspc +
&offslst +
&sizlste +
&us_hdr +
)
/* Get the offset to the list within the space, the number */
/* of list entries and size of each entry from the header. */
Chgvar &offslst %Bin( &us_hdr 125 4 )
Chgvar &nbrlste %Bin( &us_hdr 133 4 )
Chgvar &sizlste %Bin( &us_hdr 137 4 )
/* If no entries, then get out of here... */
If ( &nbrlste *eq 0 ) do
sndpgmmsg msgid( CPF9897 ) msgf( QCPFMSG ) +
msgdta( 'No active subsystems found.' )
goto Return
Enddo
/* Set the offset to the list within the space... */
Chgvar &offslst ( &offslst + 1 )
If (&Nbrlste > 490) Do
SndPgmMsg MsgId(CPF9898) +
MsgF(QCPFMSG) +
MsgDta('More than 490 active subsystems exist') +
MsgType(*Escape)
EndDo
Chgvar &NbrSbs (&Nbrlste)
DoFor &i From( 1 ) To( &Nbrlste )
/* Retrieve a list entry... */
Call QUSRTVUS ( +
&qusrspc +
&offslst +
&sizlste +
&SBSENT +
)
Chgvar &pos (((&i-1) * 20) + 1)
Chgvar %SST(&RtnSbs &pos 20) &SBSENT
Chgvar &SBSD %sst( &SBSENT 1 10 )
Chgvar &SBSDLIB %sst( &SBSENT 11 10 )
Chgvar &offslst ( &offslst + &sizlste )
EndDo
Return:
Dltusrspc &usrspclib/&usrspc
Return
/*-- Error processor ------------------------------------------------*/
Error:
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY ' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
EndPgm
File : QCMDSRC
Member: RTVACTSBS
Usage : CrtCmd Cmd( RtvActSbs ) Pgm( RtvActSbs ) SrcFile( YourSourceFile ) Allow ( *Ipgm *Bpgm )
/* =============================================================== */
/* = Command....... RTVACTSBS = */
/* = CPP........... RTVACTSBS CLP = */
/* = = */
/* = Description... = */
/* = Retrieve active subsystems = */
/* = = */
/* = CrtCmd Cmd( RtvActSbs ) = */
/* = Pgm( RtvActSbs ) = */
/* = SrcFile( YourSourceFile ) = */
/* = Allow ( *Ipgm *Bpgm ) = */
/* =============================================================== */
/* = Date : 2015/06/01 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Cmd Prompt( 'Retrieve Active Subsystems' )
Parm Kwd( RtnSbs ) +
Type( *Char ) +
Len( 9800 ) +
Rtnval( *Yes ) +
Prompt( 'CL var for RTNSBS (9800) .')
Parm Kwd( NbrSbs ) +
Type( *Dec ) +
Len( 5 0 ) +
Rtnval( *Yes ) +
Prompt( 'CL var for NBRSBS (5 0) .' )
File : QCLSRC
Member: RTVACTSBST
Usage : CrtClPgm Pgm( RTVACTSBS ) SrcFile( YourSourceFile )
Pgm
Dcl &RtnSbs *Char 9800
Dcl &NbrSbs *Dec (5 0)
Dcl &Idx *Dec (5 0)
Dcl &QualSbs *Char 20
Dcl &Sbsd *Char 10
Dcl &SbsdL *Char 10
RtvActSbs RtnSbs(&RtnSbs) NbrSbs(&NbrSbs)
ChgVar &Idx -19
Loop: ChgVar &Idx (&Idx + 20)
If (&Idx *LT 9781) Do /* Within area */
ChgVar &QualSbs %SST(&RtnSbs &Idx 20)
If (&QualSbs *NE ' ') Do /* Active sbs */
ChgVar &SBSD %SST(&QualSbs 1 10)
ChgVar &SBSDL %SST(&QualSbs 11 10)
SndPgmMsg Msgid( CPF9897 ) Msgf( QCPFMSG ) +
MsgDta( 'Found' *bcat &SBSDL *tcat '/' *cat +
&SBSD ) +
ToPgmq( *EXT ) MsgType( *STATUS )
DlyJob (1)
GoTo Loop
EndDo /* Active sbs */
EndDo /* Within area */
DMPCLPGM
EndPgm
星期三, 4月 27, 2011
訂閱：
文章 (Atom)