如何使用 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月 31, 2023
2001-07-19 如何使用 System API 列出 Subsystem Description 的相關資訊 ?
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言