Ich hatte da mal was zum Ermitteln des letzten Spoolfiles
Vielleicht kannst du ja was damit anfangen und dir was für deine Zwecke basteln
PHP-Code:
* ************************************************************************
* CRTRPGMOD MODULE(maylib/#GETSPLF) SRCFILE(mylib/QRPGLESRC)
* CRTPGM PGM(mylib/#GETSPLF) BNDSRVPGM(mylib/#USRSPAPI)
* ************************************************************************
d UserOK S 1A Error-Flag
d UserSpace S 20A Inz('QUSLSPL QTEMP ')
d UsrSpcExtA S 10A Inz('PROD')
d UsrSpcText S 50A Inz('Listing SPOOLs')
d LstFormat S 8A Inz('SPLF0300')
d UserName s 10A Inz(' ')
d OutQ s 20A Inz(' ')
d FormType s 10A Inz(' ')
d UsrSpcData s 10A Inz(' ')
d I_O_Err s *
d QualiJobName s 26A Inz('* ')
d FieldKeys s *
d NumFields s 4b 0
d SPLF0300 ds
d JobName 1 10
d User_Name 11 20
d JobNumber 21 26
d SPLFName 27 36
d SPLFNumber 37 40B 0
d SPLFStatus 41 44B 0
d DateOpend 45 51
d TimeOpend 52 57
d SPLFSchedule 58 58
d SPLFSyName 59 68
d UserSpecData 69 78
d Form_Type 79 88
d OutQName 89 98
d OutQLib 99 108
d AuxStorPool 109 112B 0
d SizeOfSPLF 113 116B 0
d SizeMult 117 120B 0
d TotalPages 121 124B 0
d SPLFSyName 59 68
d UserSpecData 69 78
d Form_Type 79 88
d OutQName 89 98
d OutQLib 99 108
d AuxStorPool 109 112B 0
d SizeOfSPLF 113 116B 0
d SizeMult 117 120B 0
d TotalPages 121 124B 0
d Copies 125 128B 0
d Pry 128 128
d Reserved 129 131
d
d NbrEntries s 10U 0
d Count s 10U 0
d Last_Nbr s Like( SPLFNumber )
d
d PR_PGM_Name s 10
d PR_SPLFile s 10
d PR_JobName s 10
d PR_User s 10
d PR_JobNr s 6
d PR_SPLNBR s 9
d
d True c *On
d False c *Off
* Prototype Lists
d/COPY dipsrvpgm/QRPGLESRC,FUSPCP
c Eval UserOK = CrtUsrSpc(UserSpace :
c UsrSpcExtA :
c UsrSpcText )
c
c Call (e) 'QUSLSPL'
c Parm UserSpace
c Parm LstFormat
c Parm UserName
c Parm OutQ
c Parm FormType
c Parm UsrSpcData
c Parm I_O_Err
c Parm QualiJobName
c Parm FieldKeys
c Parm NumFields
c
c Eval NbrEntries = GetNumEnt(UserSpace)
c
c For Count = 1 to NbrEntries
c Eval SPLF0300 = GetSpcEnt(UserSpace : Count)
c If PR_PGM_Name = UserSpecData
c ExSr SR_Work
c EndIf
c EndFor
c
c Eval UserOK = DltUsrSpc(UserSpace)
c
c Eval *InLr = True
c SR_Work BegSr
c*
c If Last_Nbr < SPLFNumber
c Eval PR_SPLFile = SPLFName
c Eval PR_JobName = JobName
c Eval PR_User = User_Name
c Eval PR_JobNr = JobNumber
c Eval PR_SPLNBR = %Trim( %EditC( SPLFNumber:'X'))
c EndIf
c*
c EndSr
c *InzSr BegSr
c*
c *Entry PList
c Parm PR_PGM_Name
c Parm PR_SPLFile
c Parm PR_JobName
c Parm PR_User
c Parm PR_JobNr
c Parm PR_SPLNBR
c*
c EndSr
und die dazu noch die Copy-Strecke FUSPCP
PHP-Code:
/IF NOT DEFINED(FUSPCP)
**************************************************************************
*
* Program Name: FunctUSPcp
* Program Title: Copy Member for User Space Prototypes
* Origin Date: 10/30/97
* Author:
* Revisions:
*
**************************************************************************
* Prototype for CrtUsrSpc procedure (Create User Space)
D CrtUsrSpc PR 1A
D UsrSpcName 20A VALUE
D UsrSpcExtA 10A VALUE
D UsrSpcText 50A VALUE
* Prototype for GetUsrSpcP procedure (Get User Space Pointer)
D GetUsrSpcP PR *
D UsrSpcName 20A VALUE
* Prototype for GetNumEnt procedure (Get Number of Entries in the User Space)
D GetNumEnt PR 9B 0
D UsrSpcName 20A VALUE
* Prototype for GetSpcEnt procedure (Get Specific Entry in the User Space)
D GetSpcEnt PR 32767A
D UsrSpcName 20A VALUE
D EntNumber 9B 0 VALUE
* Prototype for DltUsrSpc procedure (Delete User Space)
D DltUsrSpc PR 1A
D UsrSpcName 20A VALUE
/DEFINE FUSPCP
/ENDIF
und dem eingebundenen Service-PGM #USRSPAPI
PHP-Code:
* ************************************************************************
* Service - PGM erstellen mit:
* CRTRPGMOD MODULE(maylib/#USRSPAPI) SRCFILE(mylib/QRPGLESRC)
* CRTSRVPGM SRVPGM(mylib/#USRSPAPI) EXPORT(*ALL)
* ************************************************************************
*
**************************************************************************
*
* Program Name: FunctUsp
* Program Title: User Space Function Procedures
* Author:
* Origin Date: 1/23/1998
* Revisions:
*
**************************************************************************
H NOMAIN
* Prototype Lists
D/COPY dipsrvpgm/QRPGLESRC,FUSPCp
* Generic Error Structure
D/COPY dipsrvpgm/QRPGLESRC,QUSEC
* User Space Generic Structure
D/COPY dipsrvpgm/QRPGLESRC,QUSGEN
D DS_Error DS
D Bytpv 1 4b 0 inz(100)
D Bytav 5 8b 0 inz(0)
D MSgid 9 15
D Resvd 16 16
D Exdta 17 256
D Exdta52 17 67
**************************************************************************
*
* Procedure Name: CrtUsrSpc
*
**************************************************************************
P CrtUsrSpc B EXPORT
D CrtUsrSpc PI 1A
D UsrSpcName 20A VALUE
D UsrSpcExtA 10A VALUE
D UsrSpcText 50A VALUE
* Local Variables
* User Space API Fields
D SpaceName S 20A
D SpaceSize S 9B 0 INZ(8388608)
D SpaceInit S 1A INZ(x'00')
D SpaceExtA S 10A
D SpaceAut S 10A INZ('*ALL')
D SpaceText S 50A
D SpaceRepl S 10A INZ('*YES')
D SpaceDom S 10A INZ('*USER')
* Set error code structure to use basic feedback
C***** EVAL QUSBPRV = 16
* Set up imported variables
C EVAL SpaceName = UsrSpcName
C EVAL SpaceExtA = UsrSpcExtA
C EVAL SpaceText = UsrSpcText
C CALL 'QUSCRTUS'
C PARM SpaceName
C PARM SpaceExtA
C PARM SpaceSize
C PARM SpaceInit
C PARM SpaceAut
C PARM SpaceText
C PARM SpaceRepl
C PARM DS_Error
C PARM SpaceDom
C SELECT
C WHEN Bytav = 0
C RETURN 'Y'
C WHEN Bytav <> 0
C Bytav DSPLY 'OS400'
C MSgid DSPLY 'OS400'
C Exdta52 DSPLY 'OS400'
C RETURN 'N'
C ENDSL
P CrtUsrSpc E
**************************************************************************
*
* Procedure Name: GetUsrSpcP
*
**************************************************************************
P GetUsrSpcP B EXPORT
D GetUsrSpcP PI *
D UsrSpcName 20A VALUE
D SpaceName S 20A
D SpacePoint S *
* Set error code structure to use basic feedback
C EVAL QUSBPRV = 16
* Set up imported variables
C EVAL SpaceName = UsrSpcName
* Get the pointer for the user space
C CALL 'QUSPTRUS'
C PARM SpaceName
C PARM SpacePoint
C PARM QUSEC
C RETURN SpacePoint
P GetUsrSpcP E
**************************************************************************
*
* Procedure Name: GetNumEnt
*
**************************************************************************
P GetNumEnt B EXPORT
D GetNumEnt PI 9B 0
D UsrSpcName 20A VALUE
* Local Variables
D UsrSpcPntr S *
D BigField S 32767A BASED(UsrSpcPntr)
* Get the pointer for the user space
C EVAL UsrSpcPntr = GetUsrSpcP(UsrSpcName)
* Move the based on pointer to
C MOVEL BigField QUSH0100
* Return number of list entries
C RETURN QUSNBRLE
P GetNumEnt E
**************************************************************************
*
* Procedure Name: GetSpcEnt
*
**************************************************************************
P GetSpcEnt B EXPORT
D GetSpcEnt PI 32767A
D UsrSpcName 20A VALUE
D EntNumber 9B 0 VALUE
* Local Variables
D UsrSpcPntr S *
D ListPointr S *
D BigField S 32767A BASED(ListPointr)
D BigFldOut S 32767A
* Get the pointer for the user space
C EVAL UsrSpcPntr = GetUsrSpcP(UsrSpcName)
* Move the based on pointer to get header information
C EVAL ListPointr = UsrSpcPntr
C MOVEL BigField QUSH0100
* Check to see if entry requested is <= user space number entries
* If not, return a blank field
C IF EntNumber > QUSNBRLE
C EVAL BigFldOut = *BLANKS
C RETURN BigFldOut
C ENDIF
* Return specific list entry
C EVAL EntNumber = EntNumber - 1
C EVAL ListPointr = ListPointr + QUSOLD +
C (QUSSEE * EntNumber)
C EVAL BigFldOut = %SUBST(BigField:1:QUSSEE)
C RETURN BigFldOut
P GetSpcEnt E
**************************************************************************
*
* Procedure Name: DltUsrSpc
*
**************************************************************************
P DltUsrSpc B EXPORT
D DltUsrSpc PI 1A
D UsrSpcName 20A VALUE
* Local Variables
* User Space API Fields
D SpaceName S 20A
* Set error code structure to use basic feedback
C EVAL QUSBPRV = 16
* Set up imported variables
C EVAL SpaceName = UsrSpcName
C CALL 'QUSDLTUS'
C PARM SpaceName
C PARM QUSEC
C SELECT
C WHEN QUSBAVL = 0
C RETURN 'Y'
C WHEN QUSBAVL <> 0
C RETURN 'N'
C ENDSL
P DltUsrSpc E
Gruß
Ronald
![[NEWSboard IBMi Forum]](images/duke/nblogo.gif)
[professional_User]
Mit Zitat antworten
Bookmarks