H DFTACTGRP(*NO)
//
FQPRINT O F 132 PRINTER OFLIND(*INOF)
// プロシージャーのプロトタイプ
D IBM301R PR
// Error Code parameter include
D/COPY QSYSINC/QRPGLESRC,QUSEC
//
D IBM301R PI
//
D USCRTUS PR EXTPGM('QUSCRTUS')
D SPC_NAME 20A CONST
D EXT_ATTR 10A CONST
D SPC_SIZE 9B 0 CONST
D SPC_INIT 1A CONST
D SPC_AUT 10A CONST
D SPC_TEXT 50A CONST
D SPC_REPLAC 10A CONST
D SPC_USEC LIKE(QUSEC) OPTIONS(*NoPass)
D SPC_DOMAIN 10A CONST Options(*NoPass)
//
D USLSPL PR EXTPGM('QUSLSPL')
D SPC_NAME 20A CONST
D FORMAT 8A CONST
D USR_PRF 10A CONST
D OUTQ 20A CONST
D FORMTYP 10A CONST
D USRDTA 10A CONST
D SPC_USEC LIKE(QUSEC)
D JOBNAM 26A CONST
D PKEYS LIKE(KEYS) OPTIONS(*NoPass)
D PKEY# LIKE(KEY#) OPTIONS(*NoPass)
//
D USPTRUS PR EXTPGM('QUSPTRUS')
D SPC_NAME 20A CONST
D PSPCPTR LIKE(SPCPTR)
D PUSEC LIKE(QUSEC)
//
DLSTPTR S *
DLSTPTR2 S *
DSPCPTR S *
DARR S 1 BASED(LSTPTR) DIM(32767)
D DS
DPAGES# 1 4B 0
DPAGESA 1 4
DKEYS DS
D 9B 0 INZ(201)
D 9B 0 INZ(216)
D 9B 0 INZ(211)
DKEY# S 9B 0 INZ(3)
D I S 9S 0 INZ(0)
D J S 9S 0 INZ(0)
D X S 9S 0 INZ(0)
D PRTFIL S 10A INZ(*BLANK)
D OPNDAT S 7A INZ(*BLANK)
D*****************************************************************
D*
D* The following QUSGEN include from QSYSINC is copied into (11)
D* this program so that it can be declared as BASED on SPCPTR
D*
D*****************************************************************
DQUSH0100 DS BASED(SPCPTR)
D* Qus Generic Header 0100
D QUSUA 1 64
D* User Area
D QUSSGH 65 68B 0
D* Size Generic Header
D QUSSRL 69 72
D* Structure Release Level
D QUSFN 73 80
D* Format Name
D QUSAU 81 90
D* API Used
D QUSDTC 91 103
D* Date Time Created
D QUSIS 104 104
D* Information Status
D QUSSUS 105 108B 0
D* Size User Space
D QUSOIP 109 112B 0
D* Offset Input Parameter
D QUSSIP 113 116B 0
D* Size Input Parameter
D QUSOHS 117 120B 0
D* Offset Header Section
D QUSSHS 121 124B 0
D* Size Header Section
D QUSOLD 125 128B 0
D* Offset List Data
D QUSSLD 129 132B 0
D* Size List Data
D QUSNBRLE 133 136B 0
D* Number List Entries
D QUSSEE 137 140B 0
D* Size Each Entry
D QUSSIDLE 141 144B 0
D* CCSID List Ent
D QUSCID 145 146
D* Country ID
D QUSLID 147 149
D* Language ID
D QUSSLI 150 150
D* Subset List Indicator
D QUSERVED00 151 192
D* Reserved
D*****************************************************************
D*
D* The following QUSLSPL include from QSYSINC is copied into
D* this program so that it can be declared as BASED
D*
D*****************************************************************
D******************************************************************
D*Type definition for the SPLF0200 format.
D*******
D*NOTE: The following type definition only defines the fixed
D* portion of the format. Any varying length field will
D* have to be defined by the user.
D******************************************************************
DQUSSPLKI DS 100 BASED(LSTPTR2)
D* Qus LSPL Key Info
D QUSLFIR02 1 4B 0
D* Len Field Info Retd
D QUSKFFFR00 5 8B 0
D* Key Field for Field Retd
D QUSTOD02 9 9
D* Type of Data
D QUSR300 10 12
D* Reserv3
D QUSDL02 13 16B 0
D* Data Length
D*QUSDATA08 17 17
D*
D* Varying length
D*QUSERVED34 18 18
D*
D* Varying length
DQUSF0200 DS BASED(LSTPTR)
D* Qus SPLF0200
D QUSNBRFR00 1 4B 0
D* Num Fields Retd
D*QUSKI00 18
D* QUSLFIR03 5 8B 0
D* QUSKFFFR01 9 12B 0
D* QUSTOD03 13 13
D* QUSR301 14 16
D* QUSDL03 17 20B 0
D* QUSDATA09 21 21
D* QUSERVED35 22 22
D*
D* Varying length
/FREE
QUSBPRV = 0;
// QUSLSPLで使うユーザースペースを作成します
USCRTUS('SPCNAME QTEMP ' :
'QUSLSPL ' :
2000 :
X'00' :
'*ALL ' :
*BLANKS :
'*YES ' :
QUSEC :
'*USER ' ) ;
// Call QUSLSPL to get all spooled files for *CURRENT user
USLSPL('SPCNAME QTEMP ' :
'SPLF0200' :
'*CURRENT' :
'*ALL' :
'*ALL' :
'*ALL' :
QUSEC :
*BLANKS :
KEYS :
KEY# ) ;
// Get a resolved pointer to the User Space for performance
USPTRUS('SPCNAME QTEMP ' : SPCPTR : QUSEC ) ;
// If valid information was returned
IF QUSSRL = '0100';
IF QUSIS = 'C'
OR QUSIS = 'P';
//エントリー数が０以上か？
IF QUSNBRLE > 0;
// LSTPTRにユーザースペース先頭のアドレスをセット
LSTPTR = SPCPTR;
// ユーザースペースのGeneric HaederのOffset List Dataを加算
LSTPTR = %ADDR(ARR(QUSOLD + 1));
//
// エントリの数だけループ
for i = 1 to QUSNBRLE ;
// set LSTPTR2 to the first variable length record for this entry
x = 5 ;
LSTPTR2 = %ADDR(ARR(X));
for j = 1 to QUSNBRFR00 ;
// process the data based on key type
IF QUSKFFFR00 = 201 ;
EXSR FILNAM ;
ELSEIF QUSKFFFR00 = 211 ;
EXSR PAGES ;
ELSEIF QUSKFFFR00 = 216 ;
EXSR AGE ;
ELSE ;
EXSR ERROR ;
ENDIF ;
// increment LSTPTR2 to next variable length record
X = X + QUSLFIR02 ;
LSTPTR2 = %ADDR(ARR(X));
ENDFOR;
EXCEPT PRTLIN;
//
// after each entry, increment LSTPTR to the next entry
//
LSTPTR = %ADDR(ARR(QUSSEE + 1));
ENDFOR;
ENDIF;
ELSE;
EXCEPT LSTERR;
ENDIF;
ELSE;
EXCEPT HDRERR;
ENDIF;
//
// Exit the program
//
*INLR = '1';
RETURN;
//****************************************************************
BEGSR FILNAM;
//
// extract spooled file name for report
//
PRTFIL = *BLANK ;
PRTFIL = %SUBST(QUSSPLKI:17:QUSDL02);
ENDSR;
//****************************************************************
BEGSR PAGES;
//
// extract number of pages for report
//
PAGESA = %SUBST(QUSSPLKI:17:QUSDL02);
ENDSR;
//****************************************************************
BEGSR AGE;
//
// extract age of spooled file for report
//
OPNDAT = *BLANK ;
OPNDAT = %SUBST(QUSSPLKI:17:QUSDL02);
ENDSR;
//****************************************************************
BEGSR ERROR;
DSPLY QUSKFFFR00;
*INLR = '1';
RETURN;
ENDSR;
//****************************************************************
/END-FREE
OQPRINT E PRTLIN 1
O PRTFIL 10
O PAGES# 25
O OPNDAT 40
OQPRINT E LSTERR 1
O 22 'List data not valid'
OQPRINT E HDRERR 1
O 22 'Unknown Generic Header'
このページへのコメント
qmaUEF Im grateful for the article post.Really thank you! Much obliged.