2003-06-11 如何於程式執行時知道 Savf File 的內容(API QSRLSAVF) ?
有時候系統管理員需要控管哪些程式，檔案或程式原始檔成員可以 Restore 到系統中，
所以需要作確認，系統中提供 DSPSAVF 指令可以顯示 SAVF 內容，但無法於程式中直接
檢核，所以我利用 API QSRLSAVF 來達成這個目的，此範例僅顯示 SAVF 內容，並未提
供自動 Restore 物件功能，若有需要你可以於程式中自行建立 RSTOBJ 指令字串於程式
中，並加入所選取的物件字串，再執行整個 RSTOBJ 指令即可。
File : QDDSSRC
Member: RSTOBJD
Type : DSPF
Usage : CRTDSPF RSTOBJD
*===============================================================
*
* To compile:
*
* CRTDSPF FILE(XXX/RSTOBJD) SRCFILE(XXX/QDDSSRC)
*
*===============================================================
A*
A*%%EC
A DSPSIZ(24 80 *DS3)
A PRINT
A ERRSFL
A CA03
A CA12
A*
A R SFL1 SFL
A*
A SELECT 1 B 6 2
A OBJNAM 10 O 6 4
A OBJTYP 10 O 6 15
A OBJATR 10 O 6 26
A MBRNAM 10 O 6 37
A*
A*
A R SF1CTL SFLCTL(SFL1)
A SFLSIZ(0017)
A SFLPAG(0016)
A OVERLAY
A N32 SFLDSP
A N31 SFLDSPCTL
A 31 SFLCLR
A 90 SFLEND(*MORE)
A SFLCSRRRN(&CSRRRN1)
A RRN1 4S 0H SFLRCDNBR
A CSRRRN1 5S 0H
A 1 2'RSTOBJR '
A 1 28'DISPLAY SAVF FILE CONTENTS'
A COLOR(WHT)
A 1 71DATE
A EDTCDE(Y)
A 2 29'API QSRLSAVF SAMPLE'
A COLOR(WHT)
A 2 71TIME
A 4 1'INPUT X TO SELECT'
A 3 2'LIBRARY SAVED:'
A SAVLIB 10 O 3 17
A 3 29'SAVE COMMAND:'
A SAVCMD 10 O 3 43
A 3 54'RELEASE:'
A SAVRLS 6 O 3 63
A 4 54'SAVED DATE:'
A SAVDAT 8 O 4 66
A 5 4'OBJECT'
A COLOR(WHT)
A 5 15'OBJ TYPE'
A COLOR(WHT)
A 5 26'OBJ ATTR'
A COLOR(WHT)
A 5 37'MEMBER'
A COLOR(WHT)
A*
A R SFL3 SFL
A OBJNAM 10 O 6 4
A OBJTYP 10 O 6 15
A MBRNAM 10 O 6 26
*
A R SF3CTL SFLCTL(SFL3)
A SFLSIZ(0017)
A SFLPAG(0016)
A OVERLAY
A N32 SFLDSP
A N31 SFLDSPCTL
A 31 SFLCLR
A 90 SFLEND(*MORE)
A RRN3 4S 0H
A 1 2'TFROBJR '
A 1 28'DISPLAY SAVF FILE CONTENTS'
A COLOR(WHT)
A 1 71DATE
A EDTCDE(Y)
A 2 29'API QSRLSAVF SAMPLE'
A 2 71TIME
A 3 1'PRESS ENTER TO CONFIRM'
A 4 2'LIBRARY SAVED:'
A SAVLIB 10 O 4 17
A 4 29'SAVE COMMAND:'
A SAVCMD 10 O 4 43
A 5 4'OBJECT'
A COLOR(WHT)
A 5 15'OBJ TYPE'
A COLOR(WHT)
A 5 26'MEMBER'
A COLOR(WHT)
A R FKEY1
A*
A 23 2'F3=Exit'
A COLOR(BLU)
A 23 12'F12=Cancel'
A COLOR(BLU)
File : QDRPGLESRC
Member: RSTOBJR
Type : RPGLE
Usage : CRTBNDRPG RSTOBJR
*===============================================================
* To compile:
*
* CRTRPGPGM PGM(XXX/WRKSAVOBJR) SRCFILE(XXX/QRPGLESRC)
*
*===============================================================
*. 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO)
H DftActGrp(*NO) ActGrp(*CALLER)
FRSTOBJD cf e workstn
F sfile(sfl1:rrn1)
F sfile(sfl3:rrn3)
F infds(info)
* Information data structure to hold attention indicator (AID) byte.
* AID byte contains a code identifying the function
* key used to return control to the program from the display file.
* For more information see the DATA MANAGEMENT GUIDE.
Dinfo ds
D cfkey 369 369
* Constants to compare to AID - F3, F12, F6, and ENTER keys.
* Other values documented in DATA MANAGEMENT GUIDE.
Dexit C const(X'33')
Dcancel C const(X'3C')
Dadd C const(X'36')
Denter C const(X'F1')
D savrrn S 5S 0
D confirm S 1
D GENDS DS
D OFFLST 125 128B 0
D NUMLST 133 136B 0
D SIZENT 137 140B 0
D LIBINF DS 72
D SAVLIB 1 10
D SAVCMD 11 20
D SAVCM6 11 16
* The time at which the objects were saved in system time-stamp format
D SAVDAT 21 28
D SAVRLS 55 60
D OBJINF DS 204
D OBJNAM 1 10
D OBJTYP 21 30
D OBJATR 31 40
D OBJTXT 155 194
D MBRINF DS 40
D FILNAM 1 10
D FILLIB 11 20
D MBRNAM 21 30
D DS INZ
D USRSPC 1 20 INZ('DSPSAVF QTEMP ')
D STRPOS 41 44B 0
D STRLEN 45 48B 0
D LENSPC 49 52B 0
D STKCNT 53 56B 0
D APPSCP 57 60B 0
D EXTPRM 61 64B 0
D ERRCOD 65 68B 0
D FKEY 69 72B 0
D VARLEN 73 76B 0
* Parameters for Create User Space used
D ExtendAttr S 10 INZ('USRSPC ')
D InitialSiz S 10I 0 INZ(1024)
D InitialVal S 1 INZ(X'00')
D PublicAut S 10 INZ('*ALL ')
D ReplaceSpc S 10 INZ('*YES ')
D TextDescrp S 50 INZ('User space for SAVF ListAPI')
*
D DTS s 16a
D LongJul s 17a
D YYMD s 17a
**-- Convert date & time: -------------------------------------------
D CvtDtf Pr ExtPgm( 'QWCCVTDT' )
D CdInpFmt 10a Const
D CdInpVar 17a Const Options( *VarSize )
D CdOutFmt 10a Const Options( *VarSize )
D CdOutVar 17a Options( *VarSize )
D CdError 32767a Options( *VarSize )
**
**********************************************************************************************
* Standard error code DS for API error handling
D Error_Code DS
D BytesProvd 10I 0 INZ( %Size( Error_Code ))
D BytesAvail 10I 0 INZ(0)
D Except_ID 7
D Reserved 1
D Exception 256
*===============================================================
C *ENTRY PLIST
C PARM SAVF 20
C PARM OBJFLT 10
C PARM TYPFLT 10
*
* Create User Space
C EXSR CRTUSRSPC
*
* Load user space with library level information
C MOVEL 'SAVF0100' FMTNAM 8
C EXSR LODSPC
*
* Get library level information from user space
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM STRLEN
C PARM LIBINF
*
* Perform error checking selection
C SELECT
*
* If no data issue message
C SAVLIB WHENEQ *BLANKS
C MOVEL '*EMPTY' ERRDTA 10
*
* If unsupported save command issue message
C SAVCM6 WHENNE 'SAVLIB'
C SAVCM6 ANDNE 'SAVOBJ'
C SAVCM6 ANDNE 'SAVCHG'
C MOVEL SAVCMD ERRDTA
*
* Otherwise process data
C OTHER
* Convert Save Date & time to *MDY format
C CallP CvtDtf( '*DTS'
C : SAVDAT
C : '*MDY'
C : DTS
C : Error_Code
C )
C EVAL SAVDAT = %subst(DTS:2:6)
C EXSR PROCES
C ENDSL
*
C MOVE *ON *INLR
*===============================================================
C CRTUSRSPC BEGSR
* Create a user space to hold savf list entries
C CALL 'QUSCRTUS'
C PARM USRSPC
C PARM ExtendAttr
C PARM InitialSiz
C PARM InitialVal
C PARM PublicAut
C PARM TextDescrp
C PARM ReplaceSpc
C PARM Error_Code
C ENDSR
*===============================================================
C LODSPC BEGSR
*
* Call the list save file API
C CALL 'QSRLSAVF'
C PARM USRSPC
C PARM FMTNAM
C PARM SAVF
C PARM OBJFLT
C PARM TYPFLT
C PARM *BLANKS CNTHND 36
C PARM 0 ERRCOD
*
* Retrieve the generic header
C Z-ADD 1 STRPOS
C Z-ADD 140 STRLEN
*
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM STRLEN
C PARM GENDS
*
* Calculate starting position and length
C OFFLST ADD 1 STRPOS
C Z-ADD SIZENT STRLEN
*
C ENDSR
*===============================================================
C PROCES BEGSR
*
* Load user space with object level information
C MOVEL 'SAVF0200' FMTNAM
C EXSR LODSPC
*
C ExSr clrsfl
* Get object level information from user space
C DO NUMLST
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM STRLEN
C PARM OBJINF
*
* Exclude library objects from list
C OBJTYP IFNE '*LIB'
C move ' ' select
C MOVE *Blanks MBRNAM
*
* Add a OBJINF list entry to the screen
C Eval rrn1 = rrn1 + 1
C Write sfl1
C ENDIF
*
* Calculate position of next entry
C ADD SIZENT STRPOS
C ENDDO
* Load user space with member level information
C MOVEL 'SAVF0300' FMTNAM
C EXSR LODSPC
*
* Get object level information from user space
C DO NUMLST
C CALL 'QUSRTVUS'
C PARM USRSPC
C PARM STRPOS
C PARM STRLEN
C PARM MBRINF
*
C move ' ' select
C MOVEL FILNAM OBJNAM
C MOVE *Blanks OBJTYP
*
* Add a list entry to the screen
C Eval rrn1 = rrn1 + 1
C Write sfl1
C* ENDIF
*
* Calculate position of next entry
C ADD SIZENT STRPOS
C ENDDO
*
* Display Screen
C Eval savrrn = rrn1
C Eval rrn1 = 1
*
C Eval *In90 = *on
C If rrn1 = 0
C Eval *in32 = *on
C EndIf
* Simply redisplay subfile until user hits Exit or Cancel
C DoU (cfkey = exit) or (cfkey = cancel)
C Write fkey1
C ExFmt sf1ctl
C Exsr procesSlt
C If confirm = '1'
C leave
C EndIf
C EndDo
C
C ENDSR
*===============================================================
C procesSlt BEGSR
*
* clear sfl3
C Eval *in31 = *on
C Eval rrn3 = 0
c Write sf3ctl
C Eval *in31 = *off
*
C z-add 1 idx 5 0
C Eval confirm = '0'
C DoW idx <= savrrn
C idx Chain sfl1
C If select = 'X'
C Z-add idx strrrn 4 0
C Eval rrn3 = rrn3 + 1
C Write sfl3
C Eval select = ' '
C update sfl1
C EndIf
C Eval idx = idx + 1
C EndDo
C
C If rrn3 > 0
C z-add rrn3 savrrn3 4 0
C Write fkey1
C ExFmt sf3ctl
C If (cfkey <> exit) and (cfkey <> cancel)
C Eval confirm = '1'
C Eval idx = 1
C DoW idx <= savrrn3
C idx Chain sfl3
* write your process select obj or member step under here.
C Eval idx = idx + 1
C EndDo
C EndIf
C If cfkey = cancel
C Eval cfkey = ' '
C EndIf
C EndIf
C If strrrn > 0
C Z-add strrrn rrn1
C Else
C Z-add csrrrn1 rrn1
C EndIf
*
C ENDSR
*********************************************************************
C ClrSfl BegSr
* Clear the subfile by activating SFLCLR and writing the subfile control
* format. Reset the subfile relative record number.
C Eval *in31 = *on
C Eval rrn1 = 0
C Write sf1ctl
C Eval *in31 = *off
*
C EndSr
星期一, 11月 06, 2023
2003-06-11 如何於程式執行時知道 Savf File 的內容(API QSRLSAVF) ?
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言