如何確認 IFS 檔案沒有任何人使用中?(API QP0LROR)(RTVIFSLCK CMD)
於 AS/400 中有時需要確認物件是否為某一 job 鎖住, 可以用 WRKOBJLCK 查知, 但是於
IFS 檔案結構下, 系統並無提供指令查知, 例如使用 FTP 上傳 text 檔案至 /tmp 目錄時
, 若檔案很大需要些許時間才能完全上傳, 此時若有某一 AS/400 程式試著讀取該檔案, 此
時程式並不會當掉, 但並無法確認 FTP 上傳的檔案是否已完成, 有可能此時還在上傳中,
所讀取的資料並不完全. 所以系統提供一 API QP0LROR 取得 IFS 檔案的使用狀態.
本範例指令 RTVIFSLCK 使用 QP0LROR API 來查是否有其他Job 使用該 IFS 檔案.
File : QRPGLESRC
Member: RTVIFSLCK
Type : RPGLE
Usage : CRTBNDRPG RTVIFSLCK
H Option( *SrcStmt ) BndDir( 'QC2LE' ) DftActGrp(*NO)
D Idx s 10u 0
D BytAlc s 10u 0
D NbrRcds s 10u 0
D MsgKey s 4a
D ErrTxt s 256a Varying
**
D IfsObj s 112a
D ObjUse s 4a
D ChkUsr s 10a
**
D CurCcsId c 0
D CurCtrId c x'0000'
D CurLngId c x'000000'
D ChrDlm1 c 0
**-- Api error data structure: ----------------------------------
D ApiError Ds
D AeBytPrv 10i 0 Inz( %Size( ApiError ))
D AeBytAvl 10i 0 Inz
D AeMsgId 7a
D 1a
D AeMsgDta 128a
**-- Api path: --------------------------------------------------
D ApiPath Ds
D ApCcsId 10i 0 Inz( CurCcsId )
D ApCtrId 2a Inz( CurCtrId )
D ApLngId 3a Inz( CurLngId )
D 3a Inz( *Allx'00' )
D ApPthTypI 10i 0 Inz( ChrDlm1 )
D ApPthNamLen 10i 0
D ApPthNamDlm 2a Inz( '/ ' )
D 10a Inz( *Allx'00' )
D ApPthNam 1024a
**-- Object reference information: -------------------------------
D RORO0100 Ds Based( pObjRef )
D R1BytRtn 10u 0
D R1BytAvl 10u 0
D R1OfsSmpRef 10u 0
D R1LenSmpRef 10u 0
D R1RefCnt 10u 0
D R1InUseI 10u 0
**
D RORO0200 Ds Based( pObjRef )
D R2BytRtn 10u 0
D R2BytAvl 10u 0
D R2RefCnt 10u 0
D R2InUseI 10u 0
D R2OfsSmpRef 10u 0
D R2LenSmpRef 10u 0
D R2OfsExtRef 10u 0
D R2LenExtRef 10u 0
D R2OfsJobLst 10u 0
D R2NbrJobRtn 10u 0
D R2NbrJobAvl 10u 0
**-- Job using object structure: --------------------------------
D JobUsgObj Ds Based( pJobUsgObj )
D JuDplSmpRef 10u 0
D JuLenSmpRef 10u 0
D JuDplExtRef 10u 0
D JuLenExtRef 10u 0
D JuDplNxtJobE 10u 0
D JuJobNam 10a
D JuJobUsr 10a
D JuJobNbr 6a
**-- Simple object reference types structure: -------------------
D SmpObjRef Ds Based( pSmpObjRef )
D SoReadOnly 10u 0
D SoWrtOnly 10u 0
D SoReadWrt 10u 0
D SoExecute 10u 0
D SoShrRdOnly 10u 0
D SoShrWrtOnly 10u 0
D SoShrRdWrt 10u 0
D SoShrNoRdWrt 10u 0
D SoAtrLck 10u 0
D SoSavLck 10u 0
D SoSavLckInt 10u 0
D SoLnkChgLck 10u 0
D SoChkOut 10u 0
D SoChkOutUsrNm 10a
D 2a
**-- Extended object reference types structure: -----------------
D ExtObjRef Ds Based( pExtObjRef )
D XoRdOnShrRdOn 10u 0
D XoRdOnShrWtOn 10u 0
D XoRdOnShrRdWt 10u 0
D XoRdOnShrNoRW 10u 0
D XoWtOnShrRdOn 10u 0
D XoWtOnShrWtOn 10u 0
D XoWtOnShrRdWt 10u 0
D XoWtOnShrNoRW 10u 0
D XoRWonShrRdOn 10u 0
D XoRWonShrWtOn 10u 0
D XoRWonShrRdWt 10u 0
D XoRWonShrNoRW 10u 0
D XoExOnShrRdOn 10u 0
D XoExOnShrWtOn 10u 0
D XoExOnShrRdWt 10u 0
D XoExOnShrNoRW 10u 0
D XoXRonShrRdOn 10u 0
D XoXRonShrWtOn 10u 0
D XoXRonShrRdWt 10u 0
D XoXRonShrNoRW 10u 0
D XoAtrLck 10u 0
D XoSavLck 10u 0
D XoSavLckInt 10u 0
D XoLnkChgLck 10u 0
D XoCurDir 10u 0
D XoRootDir 10u 0
D XoFilSvrRef 10u 0
D XoFilSvrWrkDi 10u 0
D XoChkOut 10u 0
D XoChkOutUsrNm 10a
D 2a
**-- File stat-structure: ---------------------------------------
D Buf Ds Align
D st_mode 10u 0
D st_ino 10u 0
D st_nlink 5u 0
D 2a
D st_uid 10u 0
D st_gid 10u 0
D st_size 10i 0
D st_atime 10i 0
D st_mtime 10i 0
D st_ctime 10i 0
D st_dev 10u 0
D st_blksize 10u 0
D st_allocsize 10u 0
D st_objtype 11a
D 1a
D st_codepage 5u 0
D st_reserv1 62a
D st_ino_gen_id 10u 0
**
D pBuf s * Inz( %Addr( Buf ))
**-- Get file or link information: ------------------------------
D lstat Pr 10i 0 ExtProc( 'QlgLstat' )
D PthStr 4096a Const Options( *VarSize )
D Buf * Value
**-- Retrieve object references: --------------------------------
D RtvObjRef Pr ExtPgm( 'QP0LROR' )
D RoRcvVar 65535a Options( *VarSize )
D RoRcvVarLen 10u 0 Const
D RoFmtNam 8a Const
D RoPthStr 4096a Const Options( *VarSize )
D RoError 32767a Options( *VarSize: *NoPass)
**-- Send program message: ---------------------------------------------**
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D SpMsgId 7a Const
D SpMsgFq 20a Const
D SpMsgDta 128a Const
D SpMsgDtaLen 10i 0 Const
D SpMsgTyp 10a Const
D SpCalStkE 10a Const Options( *VarSize )
D SpCalStkCtr 10i 0 Const
D SpMsgKey 4a
D SpError 10i 0 Const
**-- Send escape message: ----------------------------------------------**
D SndEscMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- Send completion message: ------------------------------------------**
D SndCmpMsg Pr 10i 0
D PxMsgDta 512a Const Varying
**-- Error identification: ---------------------------------------------**
D errno Pr 10i 0
D strerror Pr 128a Varying
**-- Parameters: ------------------------------------------------
D PxPthNam s 300a Varying
D PxOut s 3a
**
C *Entry Plist
C Parm PxPthNam
C Parm PxOut
**
**-- Mainline: --------------------------------------------------
**
C Eval ApPthNam = PxPthNam
C Eval ApPthNamLen = %Len( PxPthNam )
**
C If lstat( ApiPath
C : pBuf
C ) = -1
**
C CallP SndEscMsg( %Char( Errno ) + ': ' + Strerror )
C Else
**
C Eval BytAlc = 65535
C Eval pObjRef = %Alloc( BytAlc )
**
C DoU R2BytAvl <= BytAlc
**
C If R2BytAvl > BytAlc
C Eval BytAlc = R2BytAvl
C Eval pObjRef = %ReAlloc( pObjRef: BytAlc )
C EndIf
**
C CallP(e) RtvObjRef( RORO0200
C : BytAlc
C : 'RORO0200'
C : ApiPath
C : ApiError
C )
**
C If %Error
C CallP SndEscMsg( 'Release must be V5R2 or higher.')
C EndIf
C EndDo
**
C If AeBytAvl = *Zero
C ExSr PrcObjRef2
C EndIf
**
C DeAlloc pObjRef
C EndIf
**
C Eval *InLr = *On
C Return
**-- Process object references - format RORO0200: ----------------------**
C PrcObjRef2 BegSr
**
C If R2OfsSmpRef > *Zero And
C R2LenSmpRef = %Size( SmpObjRef )
**
C Eval pSmpObjRef = %Addr( RORO0200 ) +
C R2OfsSmpRef
**
C* ExSr WrtLstHdr
C EndIf
**
C If R2OfsExtRef > *Zero And
C R2LenExtRef = %Size( ExtObjRef )
**
C Eval pExtObjRef = %Addr( RORO0200 ) +
C R2OfsExtRef
**
C EndIf
**
C If R2OfsJobLst > *Zero
**
C ExSr PrcJobLst
C EndIf
**
C EndSr
**-- Process job list: -------------------------------------------------**
C PrcJobLst BegSr
**
C Eval pJobUsgObj = %Addr( RORO0200 ) +
C R2OfsJobLst
**
C Move R2NbrJobRtn PxOut
C For Idx = 1 to R2NbrJobRtn
**
C If JuDplSmpRef > *Zero
C Eval pSmpObjRef = pJobUsgObj + JuDplSmpRef
**...
C EndIf
**
C If JuDplExtRef > *Zero
C Eval pExtObjRef = pJobUsgObj + JuDplExtRef
**...
C EndIf
**
C* ExSr WrtLckDtl
C CallP SndCmpMsg( 'IFS file ' +
C %trim(PxPthNam) + ' used by job ' +
C JuJobNam + ' ' +
C JuJobUsr + ' ' +
C JuJobNbr )
**
C If Idx < R2NbrJobRtn
C Eval pJobUsgObj += JuDplNxtJobE
C EndIf
C EndFor
**
C EndSr
**
**-- Send escape message: ----------------------------------------------**
P SndEscMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
**
C CallP(e) SndPgmMsg( 'CPF9897'
C : 'QCPFMSG *LIBL'
C : PxMsgDta
C : %Len( PxMsgDta )
C : '*ESCAPE'
C : '*PGMBDY'
C : 1
C : MsgKey
C : *Zero
C )
**
C If %Error
C Return -1
**
C Else
C Return 0
C EndIf
**
P SndEscMsg E
**-- Send completion message: ------------------------------------------**
P SndCmpMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
**
C CallP(e) SndPgmMsg( 'CPF9897'
C : 'QCPFMSG *LIBL'
C : PxMsgDta
C : %Len( PxMsgDta )
C : '*COMP'
C : '*PGMBDY'
C : 1
C : MsgKey
C : *Zero
C )
**
C If %Error
C Return -1
**
C Else
C Return 0
C EndIf
**
P SndCmpMsg E
**-- Get runtime error number: -----------------------------------------**
P Errno B
D Pi 10i 0
**
D sys_errno Pr * ExtProc( '__errno' )
**
D Error s 10i 0 Based( pError ) NoOpt
**
C Eval pError = sys_errno
C Return Error
**
P Errno E
**-- Get runtime error text: -------------------------------------------**
P Strerror B
D Pi 128a Varying
**
D sys_strerror Pr * ExtProc( 'strerror' )
D 10i 0 Value
**
C Return %Str( sys_strerror( Errno ))
**
P Strerror E
File : QCMDSRC
Member: RTVIFSLCK
Type : CMD
Usage : CRTCMD RTVIFSLCK PGM(RTVIFSLCK) ALLOW(*BPGM *IPGM)
/*-------------------------------------------------------------------*/
/* */
/* Compile options: */
/* */
/* CrtCmd Cmd( RTVIFSLCK ) */
/* Pgm( RTVIFSLCK ) */
/* SrcMbr( RTVIFSLCK) */
/* ALLOW(*BPGM *IPGM) */
/* */
/*-------------------------------------------------------------------*/
Cmd Prompt( 'Retrieve IFS Object Locks' )
Parm IFSOBJ *Pname 300 +
Min( 1 ) +
Expr( *YES ) +
Vary( *YES *INT2 ) +
Case( *MIXED ) +
Prompt( 'IFS object' )
Parm OUTPUT *Char 3 +
RTNVAL(*YES) +
Prompt( 'Number of job used')
File : QCLSRC
Member: RTVIFSLCKT
Type : CLP
Usage : 使用指令 WRKLNK 找一個 IFS 檔案將路徑及名稱記下, 並將此路徑及名稱輸入
至 CLP 參數 &IFSNAME 中, CRTCLPGM RTVIFSLCKT
CALL RTVIFSLCKT
RTVIFSLCKＴ 會回傳使用訊息.
RTVIFSLCK 指令回傳 有幾個 Job 正在使用所指定的IFS 檔案, 並將詳細內容寫入 Joblog 中.
PGM
DCL &NUMOFJOB *CHAR 3
DCL &IFSNAME *CHAR 32 '/home/USER/cf001s.txt'
RTVIFSLCK IFSOBJ(&IFSNAME) +
OUTPUT(&NUMOFJOB)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('IFS +
file' *BCAT &IFSNAME *BCAT 'used by' +
*BCAT &NUMOFJOB *BCAT 'jobs, please see +
job log for used jobs detail') TOPGMQ(*PRV)
ENDPGM
星期二, 11月 07, 2023
2005-10-17 如何確認 IFS 檔案沒有任何人使用中?(API QP0LROR)(RTVIFSLCK CMD)
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言