Log message to IFS file with command LOGTOIFS
File : QRPGLESRC
Member: LOGTOIFS
Type : RPGLE
Usage : CRTBNDRPG PGM(LOGTOIFS) SRCFILE(LIBxx/QRPGLESRC) SRCMBR(LOGTOIFS)
**===============================================================
** Command....... LogToIfs =
** CPP........... LogToIfs RPGLE =
** Description... Log Message to IFS File =
**===============================================================
** Date : 2016/12/26 =
** Author: Vengoal Chang =
**===============================================================
** =
** To compile: =
** CRTBNDRPG LOGTOIFS SRCFILE(lib/QRPGLESRC) DBGVIEW(*LIST) =
** =
**===============================================================
H DftActGrp(*NO)
H Debug Option(*SrcStmt:*NoDebugIo)
* PGM SDS
D SDS
D psdsPgmName *Proc
D psdsPgmLib 81 90 * Program library
D JobNam 244 253
D JobUsr 254 263
D JobNbr 264 269
D CurUsr 358 367
** API call to open a stream file
**
D open PR 10I 0 ExtProc('open')
D path * value options(*string)
D openflags 10I 0 value
D mode 10U 0 value options(*nopass)
D ccsid 10U 0 value options(*nopass)
D txtcreatid 10U 0 value options(*nopass)
D**********************************************************************
D* Flags for use in open()
D*
D* More than one can be used -- add them together.
D**********************************************************************
D* Writing Only
D O_WRONLY C 2
D* Create File if not exist
D O_CREAT C 8
D* Truncate File to 0 bytes
D O_TRUNC C 64
* Append to file
D O_APPEND C 256
D* Convert text by code-page
D O_CODEPAGE C 8388608
D* Convert text by ccsid
D O_CCSID C 32
D* Open in text-mode
D O_TEXTDATA C 16777216
* Note: O_TEXT_CREAT requires all of the following flags to work:
* O_CREAT+O_TEXTDATA+(O_CODEPAGE or O_CCSID)
D O_TEXT_CREAT C 33554432
D* owner authority
D**********************************************************************
D* Mode Flags.
D* basically, the mode parm of open(), creat(), chmod(),etc
D* uses 9 least significant bits to determine the
D* file's mode. (peoples access rights to the file)
D*
D* user: owner group other
D* access: R W X R W X R W X
D* bit: 8 7 6 5 4 3 2 1 0
D*
D* (This is accomplished by adding the flags below to get the mode)
D**********************************************************************
D S_IRUSR C 256
D S_IWUSR C 128
D S_IXUSR C 64
D S_IRWXU C 448
D* group authority
D S_IRGRP C 32
D S_IWGRP C 16
D S_IXGRP C 8
D S_IRWXG C 56
D* other people
D S_IROTH C 4
D S_IWOTH C 2
D S_IXOTH C 1
D S_IRWXO C 7
** API call to write data to a stream file
**
D write PR 10I 0 extproc('write')
D fildes 10I 0 value
D buf * value
D nbyte 10U 0 value
** API call to close a stream file
**
D close PR 10I 0 extproc('close')
D fildes 10I 0 value
D @__ERRNO PR * EXTPROC('__errno')
D STRERROR PR * EXTPROC('strerror')
D ERRNUM 10I 0 VALUE
D ERRNO PR 10I 0
D DIE PR
D PEMSG 256A CONST
D GetCaller PR
D CallingPgmNam 10
D CallingPgmLib 10
D fd S 10I 0
D data S 4096A
D IfsPath S 256A
D Curtime S Z
D PgmNam S 10
D PgmLib S 10
D Proc S 32
* Program parameters - title and page length in lines
D paIfsFile S 64
D paPath S 256
D paMessage S 2048
D paIncludeJob S 4
* Program parameters
C *Entry Plist
C Parm paIfsFile
C Parm paPath
C Parm paMessage
C Parm paIncludeJob
c eval *inlr = *on
C eval IfsPath = %trim(paPath) + '/' +
C %trim(paIfsFile)
C* Create an empty file
c eval fd = open(%trim(IfsPath)
c : O_CREAT + O_APPEND + O_WRONLY
c + O_CCSID + O_TEXT_CREAT
c + O_TEXTDATA
c : S_IWUSR+S_IRUSR+S_IRGRP+S_IROTH
c : 0
c : 0 )
c if fd < 0
c callp die('open(): ' + %Char(ERRNO) + ' ' +
c %trim(IfsPath) + ' ' +
c %STR(STRERROR(ERRNO)))
c return
c endif
C Time Curtime
C If paIncludeJob = '*YES'
C callp GetCaller ( PgmNam
C : PgmLib
C )
C eval data = %SubSt(%Char(Curtime):1:23)+ ' ' +
C JobNam + ' ' +
C JobUsr + ' ' +
C JobNbr + ' ' +
C PgmLib + ' ' +
C PgmNam + ' ' +
C %trimR(paMessage) + x'0D25'
C Else
C eval data = %SubSt(%Char(Curtime):1:23)+ ' ' +
C %trimR(paMessage) + x'0D25'
C EndIf
C
c callp write(fd: %addr(data): %len(%trim(data)))
C* Close the file:
c callp close(fd)
**********************************************************************
* Get Caller with Retrieve Call Stack API
**********************************************************************
P GetCaller B
D GetCaller PI
D CallingPgmNam 10
D CallingPgmLib 10
D RtvCallStack PR Extpgm('QWVRCSTK')
D 2000
D 10I 0
D 8 CONST
D 56
D 8 CONST
D 15
D Var DS 2000
D BytAvl 10I 0
D BytRtn 10I 0
D Entries 10I 0
D Offset 10I 0
D EntryCount 10I 0
D VarLen S 10I 0 Inz(%size(Var))
D ApiErr S 15
D JobIdInf DS
D JIDQName 26 Inz('*')
D JIDIntID 16
D JIDRes3 2 Inz(*loval)
D JIDThreadInd 10I 0 Inz(1)
D JIDThread 8 Inz(*loval)
D Entry DS 256
D EntryLen 10I 0
D PgmNam 10 Overlay(Entry:25)
D PgmLib 10 Overlay(Entry:35)
c eval CallingPgmNam = *blanks
c eval CallingPgmLib = *blanks
c callp RtvCallStack ( Var
c : VarLen
c : 'CSTK0100'
c : JobIdInf
c : 'JIDF0100'
c : ApiErr
c )
C Do EntryCount
C Eval Entry = %subst(Var:Offset + 1)
c if CallingPgmNam = *blanks and
c CallingPgmLib = *blanks
c if PgmNam = psdsPgmName and
c PgmLib = psdsPgmLib
C Else
c eval CallingPgmNam = Pgmnam
c eval CallingPgmLib = Pgmlib
C Endif
C Endif
C Eval Offset = Offset + EntryLen
C Enddo
C
C Return
P GetCaller E
**********************************************************************
* This ends this program abnormally, and sends back an escape.
* message explaining the failure.
**********************************************************************
P DIE B
D DIE PI
D PeMsg 256A CONST
D SndPgmMsg PR ExtPgm('QMHSNDPM')
D MessageId 7A Const
D QualMsgF 20A Const
D MsgData 256A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCct 10I 0 Const
D MessageKey 4A
D ErrorCode 32766A Options(*VarSize)
D Dsec DS
D DsecBytesP 1 4I 0 Inz(256)
D DsecBytesA 5 8I 0 Inz(0)
D DsecMsgId 9 15
D DsecReserv 16 16
D DsecMsgDta 17 256
D WWMsgLen S 10I 0
D WWTheKey S 4A
C EVAL WWMsgLen = %Len(%TrimR(PeMsg))
C IF WWMsgLen<1
C RETURN
C ENDIF
C Callp SndPgmMsg('CPF9897': 'QCPFMSG *LIBL':
C PeMsg: WWMsgLen: '*ESCAPE':
C '*PGMBDY': 1: WWTheKey: Dsec)
C RETURN
P DIE E
**********************************************************************
* This procedure return call socket C API errno
**********************************************************************
P ErrNo B
D ErrNo PI 10I 0
D P_EeeNo S *
D WWReturn S 10I 0 Based(P_Errno)
C EVAL P_Errno = @__Errno
C RETURN WWReturn
P Errno E
File : QCMDSRC
Member: LOGTOIFS
Type : CMD
Usage : CrtCmd Cmd( LogToIfs )
Pgm( LogToIfs )
SrcFile( QCMDSRC )
/* =============================================================== */
/* = Command....... LogToIfs = */
/* = CPP........... LogToIfs RPGLE = */
/* = Description... Log Message to IFS File = */
/* = = */
/* = CrtCmd Cmd( LogToIfs ) = */
/* = Pgm( LogToIfs ) = */
/* = SrcFile( QCMDSRC ) = */
/* =============================================================== */
/* = Date : 2016/12/26 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
Cmd Prompt('Log Message To IFS File')
Parm Kwd(ToStmf) +
Type(*Name) Len(64) Min(1) +
Prompt('To stream file name')
Parm Kwd(ToDir) +
Type(*Pname) LEN(256) MIN(1) +
Prompt('To directory')
Parm Kwd(LogMsg) +
Type(*Char) Len(2048) Min(1) +
Prompt('Log message')
Parm Kwd(InCldJob) +
Type(*Char) Len(4) +
Rstd(*Yes) +
Dft(*No ) +
Values(*YES *NO) +
Prompt('Log include job info')
Usage example:
Log Message To IFS File (LOGTOIFS)
Type choices, press Enter.
To stream file name . . . . . .
To directory . . . . . . . . . .
Log message . . . . . . . . . .
...
Log include job info . . . . . . *NO *YES, *NO
LOGTOIFS TOSTMF(AP1LOG.TXT) TODIR('/tmp') LOGMSG('test 2') INCLDJOB(*YES)
LOGTOIFS TOSTMF(AP1LOG.TXT) TODIR('/tmp') LOGMSG('test 3') INCLDJOB(*YES)
LOGTOIFS TOSTMF(AP1LOG.TXT) TODIR('/tmp') LOGMSG('test 3')
LOGTOIFS TOSTMF(AP1LOG.TXT) TODIR('/tmp') LOGMSG('test 4')
DSPF STMF('/tmp/AP1LOG.TXT')
Browse : /tmp/AP1LOG.TXT
Record : 1 of 4 by 14 Column : 1 59 by 79
Control :
....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....
************Beginning of data**************
2016-12-26-15.25.45.104 QPADEV0047 USRTEST 317148 QSYS QUOCMD test 2
2016-12-26-15.25.50.561 QPADEV0047 USRTEST 317148 QSYS QUOCMD test 3
2016-12-26-15.25.57.791 test 3
2016-12-26-15.26.02.863 test 4
************End of Data********************
星期四, 11月 09, 2023
2016-12-26 Log message to IFS file with command LOGTOIFS
2013-12-17 如何將 CPYTOPCD 指令所產生的文件檔案同步複製至另一部 AS/400的相同目錄中？
如何將 CPYTOPCD 指令所產生的文件檔案同步複製至另一部 AS/400的相同目錄中？
(How to synchronize CPYTOPCD PC document to another AS/400 Folder)
ile : QCLSRC
Member: CPY2PCDXPC
Type : CLP
Usage : Change CL source &TCPHOST value to your target AS/400 host name
CRTCLPGM QGPL/CPY2PCDXPC TGTRLS(V7R1M0)
OS : V7R1 later
Check PTF SI45985
DSPPTF LICPGM(5770SS1) SELECT(SI45985)
/* ==================================================================*/
/* */
/* Program . . : CPY2PCDXPC */
/* Description : CPYTOPCD Command Exit Program */
/* Author . . : Vengoal Chang */
/* Published . : AS400ePaper */
/* Date . . . : December 17, 2013 */
/* */
/* Program function: Copy PC Document to Another AS/400 */
/* */
/* Usage: */
/* */
/* ADDEXITPGM EXITPNT(QIBM_QCA_RTV_COMMAND) */
/* FORMAT(RTVC0100) PGMNBR(*LOW) */
/* PGM(QGPL/CPY2PCDXPC) */
/* PGMDTA(*JOB 30 'CPYTOPCD QSYS *AFTER ') */
/* */
/* Compile options: */
/* Change CL &TCPHOST value to your target AS/400 host name */
/* CrtClPgm Pgm( QGPL/CPY2PCDXPC ) */
/* SrcFile( QCLSRC ) */
/* SrcMbr( *PGM ) */
/* Log( *YES ) */
/* */
/* ================================================================= */
Pgm ( &Cmd_Info )
Dcl &Cmd_Info *Char 4000
Dcl &Ep_Name *Char 20 Stg( *Defined ) DefVar(&Cmd_Info 1)
Dcl &Ep_Format *Char 8 Stg( *Defined ) DefVar(&Cmd_Info 21)
Dcl &Cmd_Name *Char 10 Stg( *Defined ) DefVar(&Cmd_Info 29)
Dcl &Cmd_Lib *Char 10 Stg( *Defined ) DefVar(&Cmd_Info 39)
Dcl &Reserved1 *Char 2 Stg( *Defined ) DefVar(&Cmd_Info 49)
Dcl &Before_Aft *Char 1 Stg( *Defined ) DefVar(&Cmd_Info 51)
Dcl &Reserved2 *Char 1 Stg( *Defined ) DefVar(&Cmd_Info 52)
Dcl &Off_InlCmd *Int Stg( *Defined ) DefVar(&Cmd_Info 53)
Dcl &Len_InlCmd *Int Stg( *Defined ) DefVar(&Cmd_Info 57)
Dcl &Off_RplCmd *Int Stg( *Defined ) DefVar(&Cmd_Info 61)
Dcl &Len_RplCmd *Int Stg( *Defined ) DefVar(&Cmd_Info 65)
Dcl &Off_Prx *Int Stg( *Defined ) DefVar(&Cmd_Info 69)
Dcl &Nbr_Prx *Int Stg( *Defined ) DefVar(&Cmd_Info 73)
Dcl &Offset *Int
Dcl &Length *Int
Dcl &Cmd *Char 256
Dcl &ToFlr *Char 63
Dcl &ToDoc *Char 12
Dcl &PKD_INLCMD *Dec (3 0)
Dcl &STRPOS *Dec (3 0) VALUE(1)
Dcl &LEN_OPTION *Dec (3 0) VALUE(7)
Dcl &RESULT *Dec (3 0)
Dcl &STRLEN *Dec (3 0)
Dcl "E *Char 1 VALUE(X'7D')
Dcl &TCPHOST *Char 10 VALUE('AS400HOST')
Dcl &CPYSTR *Char 256
Dcl &CPYSTRLEN *Dec (15 5) VALUE(256)
Dcl &MDSTR *Char 256
Dcl &I *Int
Dcl &MsgTxt *Char 256
Dcl &MsgId *Char 7
Dcl &FromMbr *Char 10
Dcl &File *Char 10
Dcl &FileLib *Char 10
Dcl &FileLibStr *Char 21
Dcl &PKD_FrmF *dec (3 0)
Dcl &IfsObj *Char 256
Dcl &RtnValDec *dec (5 0)
Dcl &DirName *Char 256
MonMsg (CPC0000 CPD0000 CPF0000 HAE0000) *N (GOTO ERROR)
If ( &BEFORE_AFT *EQ '1' ) Do
If ( &OFF_RPLCMD = 0 ) Do
ChgVar &OFFSET ( &OFF_INLCMD + 1 )
ChgVar &LENGTH &LEN_INLCMD
EndDo
Else Do
ChgVar &OFFSET (&OFF_RPLCMD + 1)
ChgVar &LENGTH &LEN_RPLCMD
EndDo
EndDo
If ( &CMD_NAME *EQ 'CPYTOPCD ') Do
ChgVar &CMD %SST(&CMD_INFO &OFFSET &LENGTH)
ChgVar &PKD_INLCMD &LENGTH
/*-- Search FROMFILE: -----------------------------------------------*/
ChgVar &STRPOS 1
ChgVar &LEN_OPTION 9
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
'FROMFILE(' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
If (&Result > 0 ) Do
ChgVar &STRPOS &RESULT
ChgVar &LEN_OPTION 1
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
')' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
ChgVar &STRPOS (&STRPOS + 9)
ChgVar &STRLEN (&RESULT - &STRPOS)
ChgVar &FileLibStr %SST(&CMD &STRPOS &STRLEN)
ChgVar &STRPOS 1
ChgVar &PKD_FrmF 21
ChgVar &LEN_OPTION 1
CALL QCLSCAN ( &FileLibStr +
&PKD_FrmF +
&STRPOS +
'/' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
If ( &Result > 0 ) Do
ChgVar &STRLEN (&RESULT - 1)
ChgVar &FileLib %SST(&FileLibStr 1 &StrLen)
ChgVar &STRPOS (&RESULT + 1)
ChgVar &File %SST(&FileLibStr &StrPos 10)
RtvMbrD File(&FILELIB/&FILE) RtnLib(&FILELIB)
MonMsg CPF0000 *N (Goto Return)
EndDo
Else Do
ChgVar &File %SST(&FileLibStr 1 10)
RtvMbrD File(&FILE) RtnLib(&FILELIB)
MonMsg CPF0000 *N (Goto Return)
EndDo
ChkObj Obj(&FILELIB/&FILE) ObjType(*FILE)
MonMsg CPF0000 *N (Goto Return)
EndDo
/*-- Search TOFLR: -------------------------------------------------*/
ChgVar &LEN_OPTION 6
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
'TOFLR(' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
ChgVar &STRPOS &RESULT
ChgVar &LEN_OPTION 1
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
')' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
ChgVar &STRPOS (&STRPOS + 6)
ChgVar &STRLEN (&RESULT - &STRPOS)
ChgVar &TOFLR %SST(&CMD &STRPOS &STRLEN)
DoFor &I 1 63
If (%SST(&TOFLR &I 1) *EQ "E) +
ChgVar %SST(&TOFLR &I 1) ' '
EndDo
ChgVar &ToFlr %Trim(&ToFlr)
/*-- Search FROMMBR: ------------------------------------------------*/
ChgVar &STRPOS 1
ChgVar &LEN_OPTION 8
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
'FROMMBR(' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
If (&Result > 0 ) Do
ChgVar &STRPOS &RESULT
ChgVar &LEN_OPTION 1
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
')' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
ChgVar &STRPOS (&STRPOS + 8)
ChgVar &STRLEN (&RESULT - &STRPOS)
ChgVar &FromMbr %SST(&CMD &STRPOS &STRLEN)
If ( &FromMbr = '*FIRST' ) Do
RtvMbrD File(&FILELIB/&FILE) Mbr(*FIRST) RtnMbr(&FromMbr)
MonMsg CPF0000 *N (Goto Return)
EndDo
Else Do
RtvMbrD File(&FILELIB/&FILE) Mbr(&FromMbr) RtnMbr(&FromMbr)
MonMsg CPF0000 *N (Goto Return)
EndDo
EndDo
Else Do
RtvMbrD File(&FILELIB/&FILE) Mbr(*FIRST) RtnMbr(&FromMbr)
MonMsg CPF0000 *N (Goto Return)
EndDo
/*-- Search TODOC: -------------------------------------------------*/
ChgVar &STRPOS 1
ChgVar &LEN_OPTION 6
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
'TODOC(' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
If (&Result > 0 ) Do
ChgVar &STRPOS &RESULT
ChgVar &LEN_OPTION 1
CALL QCLSCAN ( &CMD +
&PKD_INLCMD +
&STRPOS +
')' +
&LEN_OPTION +
'0' +
'0' +
' ' +
&RESULT)
ChgVar &STRPOS (&STRPOS + 6)
ChgVar &STRLEN (&RESULT - &STRPOS)
ChgVar &TODOC %SST(&CMD &STRPOS &STRLEN)
If ( &FromMbr = '*FROMMBR' ) Do
ChgVar &TODOC &FromMbr
EndDo
EndDo
Else Do
ChgVar &TODOC &FromMbr
EndDo
DoFor &I 1 12
If (%SST(&ToDoc &I 1) *EQ "E) +
ChgVar %SST(&ToDoc &I 1) ' '
EndDo
ChgVar &ToDoc %Trim(&ToDoc)
/*-------------------------------------------------------------------*/
/*-- Check IFS Object exist ? ---------------------------------------*/
/*-- The IFS object must exist before CPY operation, because the */
/*-- exit program run after CPYTOPCD completed. */
/*-- But that command completed : */
/*-- 1. normal completed. => We do CPY for this */
/*-- 2. normal completed with exception. => We ignore this */
/*-------------------------------------------------------------------*/
ChgVar &IfsObj ('/QDLS/' *CAT +
&TOFLR *TCAT '/' *CAT &TODOC)
Call ChkIfsObj (&IfsObj &RtnValDec)
If (&RtnValDec *NE 0 ) (Goto Return)
ChgVar &CpyStr ('CPY OBJ(' *CAT "E *CAT +
'/QDLS/' *CAT +
&TOFLR *TCAT '/' *CAT &TODOC *TCAT +
"E *CAT ')' *BCAT +
'TODIR(' *CAT "E *CAT +
'/QFileSvr.400/' *CAT &TCPHOST *TCAT +
'/QDLS/' *CAT +
&TOFLR *TCAT +
"E *CAT ')' *BCAT +
'DTAFMT(*BINARY) REPLACE(*YES)')
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&CpyStr) -
TOUSR(*SYSOPR)
ChgVar &MDSTR ( '/QFileSvr.400/' *CAT &TCPHOST )
MD &MDSTR
MonMsg CPFA0A0
Call QCMDEXC ( &CPYSTR +
&CPYSTRLEN +
)
EndDo
Return:
Return
/*-- Error handling: -----------------------------------------------*/
Error:
DmpClPgm
Call QMHMOVPM ( ' ' +
'*DIAG' +
x'00000001' +
'*PGMBDY' +
x'00000001' +
x'0000000800000000' +
)
Call QMHRSNEM ( ' ' +
x'0000000800000000' +
)
EndPgm:
ChgVar &DirName ('/QFileSvr.400/' *CAT &TCPHOST)
Rmdir dir(&DirName) Rmvlnk(*Yes)
EndPgm
File : QCLSRC
Member: CHKIFSOBJ
Type : CLLE
Usage : CRTBNDCL CHKIFSOBJ
Pgm (&IfsObj &RtnValDec)
Dcl VAR(&IFSOBJ) TYPE(*CHAR) LEN(256)
Dcl VAR(&IFSOBJS) TYPE(*CHAR) LEN(256)
Dcl VAR(&RTNVALBIN) TYPE(*CHAR) LEN(4)
Dcl VAR(&RTNVALDEC) TYPE(*DEC) LEN(5 0)
Dcl VAR(&PATH) TYPE(*CHAR) LEN(100)
Dcl VAR(&RECEIVER) TYPE(*CHAR) LEN(4096)
Dcl VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00')
Dcl VAR(&OBJTYPE) TYPE(*CHAR) LEN(7)
ChgVar &IFSOBJS &IFSOBJ
ChgVar &IFSOBJ (&IFSOBJ *TCAT &NULL)
CallPrc Prc('stat') Parm(&IFSOBJ &RECEIVER) +
RtnVal(%BIN(&RTNVALBIN))
ChgVar &RtnValDec (%BIN( &RTNVALBIN ))
If (&RtnValDec *NE 0) THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('IFS +
Object ' *CAT &IFSOBJS *TCAT ' not found') +
MSGTYPE(*DIAG))
EndPgm
參考資訊:
This new support allows you to designate a program that is to be called when the command processing program (CPP) of a CL command completes.
This new support—which is available as PTFs for V5R4 (SI45987), 6.1 (SI45986), and 7.1 (SI45985).
The CL Corner: New Support for CL Commands Lets You Know When a Command Ends
星期三, 11月 08, 2023
2012-03-19 如何擷取使用者的預設 home 目錄(home directory) ?(getpwnam API or QSYRUSRI API)
如何擷取使用者的預設 home 目錄(home directory) ?
有二種方法:
1. 使用 getpwnam() API
2. 使用 RETRIEVE USER INFORMATION (QSYRUSRI) API format USRI0300，
由於此 API 所擷取的是 UCS-2 內碼，所以需要 CDRCVRT API 將 UCS-2 轉換為
EBCDIC
1. 使用 getpwnam() API
File : QCLSRC
Member: RTVUSRHOMC
Type : CLLE
Usage : CRTCLPGM yourlib/RTVUSRHOMC
OS : V5R4
Note : 此範例來自 Scott Klement
PGM PARM(&USRPRF)
DCL VAR(&USRPRF) TYPE(*CHAR) LEN(10)
DCL VAR(&NULL) TYPE(*CHAR) LEN(1 ) VALUE(x'00')
DCL VAR(&USRNULL) TYPE(*CHAR) LEN(11)
DCL VAR(&NULLPTR) TYPE(*PTR)
DCL VAR(&RESULT) TYPE(*PTR)
DCL VAR(&PASSWD) TYPE(*CHAR) LEN(64) +
STG(*BASED) BASPTR(&RESULT)
DCL VAR(&PW_DIR) TYPE(*PTR) +
STG(*DEFINED) DEFVAR(&PASSWD 33)
DCL VAR(&BUFPTR) TYPE(*PTR)
DCL VAR(&BUFFER) TYPE(*CHAR) LEN(5000) +
STG(*BASED) BASPTR(&BUFPTR)
DCL VAR(&BUFLEN) TYPE(*UINT) LEN(4)
DCL VAR(&HOMEDIR) TYPE(*CHAR) LEN(5000)
CHGVAR VAR(&NULLPTR) VALUE(*NULL)
/* Call the getpwnam() API to get a pointer to the Unix +
'passwd' structure, which contains the home directory */
CHGVAR VAR(&USRNULL) VALUE(&USRPRF *TCAT &NULL)
CALLPRC PRC('getpwnam') +
PARM(&USRNULL) +
RTNVAL(&RESULT)
IF (&RESULT *EQ &NULLPTR) DO
/* ack */
ENDDO
/* The &PW_DIR variable should now point to storage +
that contains a null-terminated home directory. +
+
The strlen() API will provide the length of that +
home directory. I've limited this length to 5000 +
chars so it fits in the &HOMEDIR variable. +
+
Finally, copy it from the memory buffer into the +
&HOMEDIR variable. */
CHGVAR VAR(&BUFPTR) VALUE(&PW_DIR)
CALLPRC PRC('strlen') +
PARM((&BUFPTR *BYVAL)) +
RTNVAL(&BUFLEN)
IF (&BUFLEN *GT 5000) DO
CHGVAR VAR(&BUFLEN) VALUE(5000)
ENDDO
CHGVAR VAR(&HOMEDIR) VALUE(%SST(&BUFFER 1 &BUFLEN))
/* Now, &HOMEDIR has the home directory that was needed. +
+
Just to prove it works, I'll send it as a *COMP msg. */
SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGTYPE(*COMP) +
MSGDTA(&HOMEDIR)
ENDPGM
2. 使用 RETRIEVE USER INFORMATION (QSYRUSRI) API format USRI0300，
由於此 API 所擷取的是 UCS-2 內碼，所以需要 CDRCVRT API 將 UCS-2 轉換為
EBCDIC
File : QCLSRC
Member: RTVUSRHOME
Type : CLP
Usage : CRTCLPGM yourlib/RTVUSRHOMC
OS : ALL
Note : 此範例來自 RTVUSRHOME
RTVUSRHOME: PGM PARM(&USRPRF &HOMEDIRN)
DCL VAR(&USRPRF) TYPE(*CHAR) LEN(10) /**/
DCL VAR(&RCV) TYPE(*CHAR) LEN(9999) /**/
DCL VAR(&RCVLEN) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&ERR) TYPE(*CHAR) LEN(100) /**/
DCL VAR(&FORMAT) TYPE(*CHAR) LEN(8) +
VALUE('USRI0300') /**/
DCL VAR(&OFSHOME) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&OFSHOMED) TYPE(*DEC) LEN(9) /**/
DCL VAR(&HOMEDIR) TYPE(*CHAR) LEN(512) /*IN UCS*2*/
DCL VAR(&CCSID) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&LOHOME) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&ST1) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&L1) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&CCSIDN) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&CCSIDNN) TYPE(*DEC) LEN(5 0) /**/
DCL VAR(&ST2) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&GCCASN) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&L2) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&HOMEDIRN) TYPE(*CHAR) LEN(256) /*IN EBCDIC*/
DCL VAR(&L3) TYPE(*CHAR) LEN(4) /**/
DCL VAR(&L4) TYPE(*CHAR) LEN(4) /**/
CHGVAR VAR(%BIN(&RCVLEN)) VALUE(9999)
IF COND(&USRPRF = '*CURRENT ') THEN(RTVJOBA +
CURUSER(&USRPRF) DFTCCSID(&CCSIDNN))
/* RETRIEVE USER INFORMATION (QSYRUSRI) API */
CALL PGM(QSYRUSRI) PARM(&RCV &RCVLEN &FORMAT +
&USRPRF &ERR)
CHGVAR VAR(&OFSHOME) VALUE(%SST(&RCV 601 4))
/* OFFSET TO HOMEDIR-BLOCK */
CHGVAR VAR(&OFSHOMED) VALUE(%BIN(&OFSHOME))
CHGVAR VAR(&OFSHOMED) VALUE(&OFSHOMED + 1)
/* CCSID OF HOMEDIR IS 61952 UCS-2 */
CHGVAR VAR(&CCSID) VALUE(%SST(&RCV &OFSHOMED 4))
CHGVAR VAR(&OFSHOMED) VALUE(&OFSHOMED +4+2+3+3+4)
/* NUMBER OF BYTES HOMEDIR UCS*2 */
CHGVAR VAR(&LOHOME) VALUE(%SST(&RCV &OFSHOMED 4))
CHGVAR VAR(&OFSHOMED) VALUE(&OFSHOMED +4+2+10)
/* HOMEDIR IN UCS*2 */
CHGVAR VAR(&HOMEDIR) VALUE(%SST(&RCV &OFSHOMED 512))
CHGVAR VAR(%BIN(&ST1)) VALUE(0)
/* NUMBER OF BYTES INPUT STRING */
CHGVAR VAR(&L1) VALUE(&LOHOME)
/* CONVERT IN DFT JOB CCSID */
RTVJOBA DFTCCSID(&CCSIDNN)
CHGVAR VAR(%BIN(&CCSIDN)) VALUE(&CCSIDNN)
/* 2 = SPACE PADDED, SO L2 = L3 */
CHGVAR VAR(%BIN(&ST2)) VALUE(2)
CHGVAR VAR(%BIN(&GCCASN)) VALUE(0)
/* ALLOCATED OUTPUT LENGTH IN BYTES */
CHGVAR VAR(%BIN(&L2)) VALUE(256)
/* CONVERT A GRAPHIC CHARACTER STRING (CDRCVRT) API */
CALL PGM(CDRCVRT) PARM(&CCSID &ST1 &HOMEDIR &L1 +
&CCSIDN &ST2 &GCCASN &L2 &HOMEDIRN &L3 +
&L4 &ERR)
SNDPGMMSG MSG(&HOMEDIRN)
ENDPGM
詳細資訊參照：
getpwnam()--Get User Information for User Name
Retrieve User Information (QSYRUSRI) API
2008-07-30 如何快速顯示 IFS 目錄或檔案的使用者權限？(Command: DSPIFSAUT with API Qp0lGetAttr)
如何快速顯示 IFS 目錄或檔案的使用者權限？(Command: DSPIFSAUT with API Qp0lGetAttr)
File : QRPGLESRC
Member : DSPIFSAUT
Type : RPGLE
Usage : CRTBNDRPG PGM(DSPIFSAUT) TGTRLS(V5R2M0)
**
** Program . . : DspIfsAut
** Description : Display IFS File Authority (CPP of command DspIfsAut)
** Author . . : Vengoal Chang
** Date . . : 2008/07/30
**
** Input parameters
** Description Type Size How Used
** ----------- ---- ---- --------
** PxIfsObj Char 5002 IFS object authority for display
**
**
** Compile options:
**
** CrtBndRpg Pgm( DspIfsAut )
** DbgView( *LIST ) TgtRls(V5R1M0)
**
**
**-- Control specification: --------------------------------------------**
H Option( *SrcStmt ) BndDir( 'QC2LE' ) DecEdit( *JOBRUN )
H DftActGrp(*NO)
**-- Printer file:
FQSYSPRT O F 132 Printer InfDs( PrtLinInf ) OflInd( *InOf )
F UsrOpn
**-- Printer file information:
D PrtLinInf Ds
D PlOvfLin 5i 0 Overlay( PrtLinInf: 188 )
D PlCurLin 5i 0 Overlay( PrtLinInf: 367 )
D PlCurPag 5i 0 Overlay( PrtLinInf: 369 )
**-- System information:
D SDs
D PsPgmNam *Proc
**-- API error information:
D ERRC0100 Ds Qualified
D BytPro 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 256a
**-- Global variables:
D LstTim s 6s 0
D IfsObj s 109a
D LinTxt s 40a
D LinVal s 50a
D LinVal2 s 105a
**
D BufSizAvl s 10u 0 Inz( 0 )
D NbrBytRtn s 10u 0 Inz( 0 )
D ApiRcvSiz s 10u 0
D rc s 10i 0
D Idx s 10i 0
D pBuffer s *
D ErrTxt s 256a
D MsgKey s 4a
**
D ObjOwn s 10a
D ObjPgp s 10a
D AutLstNam s 10a
D UsrNam s 10a
D UsrDtaAut s 10a
**
D AutObjMgm s 1a
D AutObjExs s 1a
D AutObjAlt s 1a
D AutObjRef s 1a
D AutObjOpr s 1a
D AutDtaRead s 1a
D AutDtaAdd s 1a
D AutDtaUpd s 1a
D AutDtaDlt s 1a
D AutDtaExe s 1a
D AutDtaExcl s 1a
**-- Spooled file information:
D SPRL0100 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D SplfNam 10a
D JobNam 10a
D UsrNam 10a
D JobNbr 6a
D SplfNbr 10i 0
D JobSysNam 8a
D SplfCrtDat 7a
D 1a
D SplfCrtTim 6a
**-- File attributes:
D QP0L_ATTR_AUTH c 11
**-- API path constants:
D CUR_CCSID c 0
D CUR_CTRID c x'0000'
D CUR_LNGID c x'000000'
D CHR_DLM_1 c 0
**-- General authority format:
D GenAut Ds Qualified Align Based( pGenAut )
D ObjOwn 10a
D PriGrp 10a
D AutL 10a
D 10a
D OfsUsrE 10i 0
D NbrUsrE 10i 0
D SizUsrE 10i 0
D 12a
**
D UsrAut Ds Qualified Align Based( pUsrAut )
D UsrNam 10a
D UsrDtaAut 10a
D ObjMgm 1a
D ObjExs 1a
D ObjAlt 1a
D ObjRef 1a
D 10a
D ObjOpr 1a
D DtaRead 1a
D DtaAdd 1a
D DtaUpd 1a
D DtaDlt 1a
D DtaExe 1a
D DtaExclude 1a
D 7a
**-- API path:
D Path Ds Qualified Align
D CcsId 10i 0 Inz( CUR_CCSID )
D CtrId 2a Inz( CUR_CTRID )
D LngId 3a Inz( CUR_LNGID )
D 3a Inz( *Allx'00' )
D PthTypI 10i 0 Inz( CHR_DLM_1 )
D PthNamLen 10i 0
D PthNamDlm 2a Inz( '/ ' )
D 10a Inz( *Allx'00' )
D PthNam 5000a
**
D AtrIds Ds Qualified Align
D NbrAtr 10i 0
D AtrId 10i 0 Dim( 32 )
**
D Buffer Ds Qualified Align Based( pBufferE )
D OfsNxtAtr 10i 0
D AtrId 10i 0
D SizAtr 10i 0
D 4a
D AtrDta 1024a
D AtrInt2 5i 0 Overlay( AtrDta: 1 )
D AtrInt 10i 0 Overlay( AtrDta: 1 )
D AtrUint 10u 0 Overlay( AtrDta: 1 )
D AtrUint8 20u 0 Overlay( AtrDta: 1 )
**-- Get attributes:
D GetAtr Pr 10i 0 ExtProc( 'Qp0lGetAttr' )
D GaFilNam * Value
D GaAtrLst * Value
D GaBuffer * Value
D GaBufSizPrv 10u 0 Value
D GaBufSizAvl 10u 0
D GaBufSizRtn 10u 0
D GaFlwSymLnk 10u 0 Value
D GaDots 10i 0 Options( *NoPass )
**-- Initialize memory:
D memset Pr 10i 0 ExtProc( 'memset' )
D pStg * Value
D InzVal 1a Value
D InzByt 10i 0 Value
**-- Copy memory:
D memcpy Pr * ExtProc( '_MEMMOVE' )
D MemOut * Value
D MemInp * Value
D MemSiz 10u 0 Value
**-- 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 32767a Options( *VarSize )
**-- Retrieve last spooled file identity:
D RtvLstSplfId Pr ExtPgm( 'QSPRILSP' )
D RsRcvVar 32767a Options( *VarSize )
D RsRcvVarLen 10i 0 Const
D RsFmtNam 8a Const
D RsError 32767a Options( *VarSize )
**-- Run system command:
D system Pr 10i 0 ExtProc( 'system' )
D command * Value Options( *String )
**-- Write attribute line:
D WrtAtrLin Pr
D PxLinTxt 40a Const
D PxLinVal 50a Const
**-- Write attribute line:
D WrtAtrLin2 Pr
D PxLinVal 100a Const
**-- Write blank line:
D WrtBlkLin Pr
**-- Write list header:
D WrtLstHdr Pr
D PxOvrFlwRel 10i 0 Const Options( *NoPass )
**-- 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
D DSPIFSAUT Pr
D PxIfsObj 5002a Varying
**
D DSPIFSAUT Pi
D PxIfsObj 5002a Varying
/Free
Path.PthNam = PxIfsObj;
Path.PthNamLen = %Len( PxIfsObj );
AtrIds.NbrAtr = 1;
AtrIds.AtrId = QP0L_ATTR_AUTH;
If GetAtr( %Addr( Path )
: %Addr( AtrIds )
: *Null
: *Zero
: BufSizAvl
: NbrBytRtn
: 0
) = 0;
ApiRcvSiz = BufSizAvl;
pBuffer = %Alloc( ApiRcvSiz );
memset( pBuffer: x'00': ApiRcvSiz );
If GetAtr( %Addr( Path )
: %Addr( AtrIds )
: pBuffer
: ApiRcvSiz
: BufSizAvl
: NbrBytRtn
: 0
) = 0;
pBufferE = pBuffer;
//When Buffer.AtrId = QP0L_ATTR_AUTH;
pGenAut = %Addr( Buffer.AtrDta );
ObjOwn = GenAut.ObjOwn;
ObjPgp = GenAut.PriGrp;
AutLstNam = GenAut.AutL;
Open QSYSPRT;
WrtAtrLin( 'Authorization list . . . . . . . . . . :': AutLstNam );
WrtAtrLin( 'Object primary group . . . . . . . . . :': ObjPgp );
WrtBlkLin();
WrtAtrLin( 'User authority . . . . :' : ' ');
LinVal2 = ' Data --Object Authorities-- ' +
'-------------Data Authorities------------';
WrtAtrLin2(LinVal2);
LinVal2 = 'User Authority Exist Mgt Alter Ref ' +
'Objopr Read Add Update Delete Execute';
WrtAtrLin2(LinVal2);
WrtBlkLin();
pUsrAut = pBuffer + GenAut.OfsUsrE;
For Idx = 1 to GenAut.NbrUsrE;
// Authorization entry available here
LinVal2 = ' ';
%SubSt(LinVal2:1 :10) = UsrAut.UsrNam;
%SubSt(LinVal2:13:10) = UsrAut.UsrDtaAut;
If UsrAut.ObjExs = X'01';
%SubSt(LinVal2:26: 1) = 'X';
EndIf;
If UsrAut.ObjMgm = X'01';
%SubSt(LinVal2:32: 1) = 'X';
EndIf;
If UsrAut.ObjAlt = X'01';
%SubSt(LinVal2:38: 1) = 'X';
EndIf;
If UsrAut.ObjRef = X'01';
%SubSt(LinVal2:44: 1) = 'X';
EndIf;
If UsrAut.ObjOpr = X'01';
%SubSt(LinVal2:50: 1) = 'X';
EndIf;
If UsrAut.DtaRead= X'01';
%SubSt(LinVal2:57: 1) = 'X';
EndIf;
If UsrAut.DtaAdd = X'01';
%SubSt(LinVal2:63: 1) = 'X';
EndIf;
If UsrAut.DtaUpd = X'01';
%SubSt(LinVal2:69: 1) = 'X';
EndIf;
If UsrAut.DtaDlt = X'01';
%SubSt(LinVal2:77: 1) = 'X';
EndIf;
If UsrAut.DtaExe = X'01';
%SubSt(LinVal2:86: 1) = 'X';
EndIf;
WrtAtrLin2( LinVal2 );
WrtBlkLin();
If Idx < GenAut.NbrUsrE;
pUsrAut += GenAut.SizUsrE;
EndIf;
EndFor;
Close QSYSPRT;
ExSr DspSplf;
EndIf;
Else;
SndEscMsg( %Char( Errno ) + ': ' + Strerror );
EndIf;
DeAlloc pBuffer;
*InLr = *On;
Return;
BegSr DspSplf;
RtvLstSplfId( SPRL0100: %Size( SPRL0100 ): 'SPRL0100': ERRC0100 );
system( 'DSPSPLF FILE(' + %Trim( SPRL0100.SplfNam ) + ')' +
' JOB(' + %Trim( SPRL0100.JobNbr ) + '/' +
%Trim( SPRL0100.UsrNam ) + '/' +
%Trim( SPRL0100.JobNam ) + ')' +
' SPLNBR(' + %Char( SPRL0100.SplfNbr ) + ')'
);
system( 'DLTSPLF FILE(' + %Trim( SPRL0100.SplfNam ) + ')' +
' JOB(' + %Trim( SPRL0100.JobNbr ) + '/' +
%Trim( SPRL0100.UsrNam ) + '/' +
%Trim( SPRL0100.JobNam ) + ')' +
' SPLNBR(' + %Char( SPRL0100.SplfNbr ) + ')'
);
SndCmpMsg( 'IFS authority list has been displayed and deleted.' );
EndSr;
BegSr *InzSr;
LstTim = %Int( %Char( %Time(): *ISO0));
If %Len( PxIfsObj ) > %Size( IfsObj );
EvalR IfsObj = PxIfsObj;
%Subst( IfsObj: 1: 3 ) = '...';
Else;
IfsObj = PxIfsObj;
EndIf;
EndSr;
/End-Free
**-- Printer file definition: ------------------------------------------**
OQSYSPRT EF Header 2 2
O UDATE Y 8
O LstTim 18 ' : : '
O 70 'Display IFS File Attribute-
O s'
O 107 'Program:'
O PsPgmNam 118
O 126 'Page:'
O PAGE + 1
OQSYSPRT EF LstHdr 1
O 20 'Object . . . . . . :'
O IfsObj 132
OQSYSPRT EF DtlLin 1
O LinTxt 40
O LinVal 93
OQSYSPRT EF DtlLin2 1
O LinVal2 130
OQSYSPRT EF DtlBlk 1
**
OQSYSPRT EF LstTrl 1
O 26 '* E N D O F L I S T *'
**-- 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
/Free
pError = sys_errno;
Return Error;
/End-Free
P Errno E
**-- Get runtime error text: -------------------------------------------**
P strerror B
D Pi 128a Varying
D sys_strerror Pr * ExtProc( 'strerror' )
D 10i 0 Value
/Free
Return %Str( sys_strerror( Errno ));
/End-Free
P strerror E
**-- Write attribute line: ---------------------------------------------**
P WrtAtrLin B
D Pi
D PxLinTxt 40a Const
D PxLinVal 50a Const
/Free
WrtLstHdr( 3 );
LinTxt = PxLinTxt;
LinVal = PxLinVal;
Except DtlLin;
/End-Free
P WrtAtrLin E
**-- Write attribute line2: ---------------------------------------------**
P WrtAtrLin2 B
D Pi
D PxLinVal2 100a Const
/Free
WrtLstHdr( 3 );
LinVal2= PxLinVal2;
Except DtlLin2;
/End-Free
P WrtAtrLin2 E
**-- Write blank line: -------------------------------------------------**
P WrtBlkLin B
D Pi
/Free
WrtLstHdr( 2 );
Except DtlBlk;
/End-Free
P WrtBlkLin E
**-- Write list header: ------------------------------------------------**
P WrtLstHdr B
D Pi
D PxOvrFlwRel 10i 0 Const Options( *NoPass )
/Free
If %Parms = *Zero;
Except Header;
Except LstHdr;
Else;
If PlCurLin > PlOvfLin - PxOvrFlwRel;
Except Header;
Except LstHdr;
EndIf;
EndIf;
/End-Free
P WrtLstHdr E
**-- Send escape message: ----------------------------------------------**
P SndEscMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
/Free
SndPgmMsg( 'CPF9897'
: 'QCPFMSG *LIBL'
: PxMsgDta
: %Len( PxMsgDta )
: '*ESCAPE'
: '*PGMBDY'
: 1
: MsgKey
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return -1;
Else;
Return 0;
EndIf;
/End-Free
P SndEscMsg E
**-- Send completion message: ------------------------------------------**
P SndCmpMsg B
D Pi 10i 0
D PxMsgDta 512a Const Varying
/Free
SndPgmMsg( 'CPF9897'
: 'QCPFMSG *LIBL'
: PxMsgDta
: %Len( PxMsgDta )
: '*COMP'
: '*PGMBDY'
: 1
: MsgKey
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
Return -1;
Else;
Return 0;
EndIf;
/End-Free
**
P SndCmpMsg E
File : QCMDSRC
Member : DSPIFSAUT
Type : CMD
Usage : CRTCMD CMD(DSPIFSAUT) PGM(DSPIFSAUT)
Sample : DSPIFSAUT OBJ('/tmp')
/* =============================================================== */
/* = Command....... DspIfsAut = */
/* = CPP........... DspIfsAut = */
/* = Description... Display IFS File Authority = */
/* = = */
/* = CrtCmd Cmd( DspIfsAut ) = */
/* = Pgm( DspIfsAut ) = */
/* = SrcFile( YourSourceFile ) = */
/* = = */
/* =============================================================== */
/* = Date : 2008/07/30 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('DISPLAY IFS FILE AUTHORITY')
PARM OBJ *PNAME 5000 +
MIN( 1 ) +
VARY( *YES *INT2 ) +
CASE( *MIXED ) +
PROMPT( 'OBJECT' )
星期二, 11月 07, 2023
2005-10-17 如何確認 IFS 檔案沒有任何人使用中?(API QP0LROR)(RTVIFSLCK CMD)
如何確認 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月 06, 2023
2003-09-25 如何取得 IFS 檔案的日期資訊?(C API stat)(Command IFSSTAT)
如何取得 IFS 檔案的日期資訊?(C API stat)
在現在的網路環境中，時常會有資料儲存於 AS/400 上的 IFS 目錄中，你可以使用
WRKLNK 指令瀏覽 AS/400 系統的 IFS 檔案系統目錄。
有時候可能需要於程式中檢查 IFS 檔案的日期，即可以使用 C API stat() 函數取得檔案的資訊。
File : QRPGLESRC
Member: STATR
Type : RPGLE
Usage : CRTBNDRPG STATR
OS Version: V4 或 V5
H DFTACTGRP(*NO) ACTGRP(*NEW) DEBUG
D**********************************************************************
D* File Information Structure (stat)
D*
D* struct stat {
D* mode_t st_mode; /* File mode */
D* ino_t st_ino; /* File serial number */
D* nlink_t st_nlink; /* Number of links */
D* uid_t st_uid; /* User ID of the owner of file */
D* gid_t st_gid; /* Group ID of the group of file */
D* off_t st_size; /* For regular files, the file
D* * size in bytes */
D* time_t st_atime; /* Time of last access */
D* time_t st_mtime; /* Time of last data modification */
D* time_t st_ctime; /* Time of last file status change */
D* dev_t st_dev; /* ID of device containing file */
D* size_t st_blksize; /* Size of a block of the file */
D* unsigned long st_allocsize; /* Allocation size of the file */
D* qp0l_objtype_t st_objtype; /* AS/400 object type */
D* unsigned short st_codepage; /* Object data codepage */
D* char st_reserved1[66]; /* Reserved */
D* };
D*
D p_statds S *
D statds DS BASED(p_statds)
D st_mode 10U 0
D st_ino 10U 0
D st_nlink 5U 0
D st_pad 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_alctize 10U 0
D st_objtype 12A
D st_codepag 5U 0
D st_resv11 62A
D st_ino_gen_id 10U 0
D*--------------------------------------------------------------------
D* Main procedure declaration
D*
D*--------------------------------------------------------------------
D STATR PR EXTPGM('STATR')
D FileName 100a const
D STATR PI
D FileName 100a const
D*--------------------------------------------------------------------
D* Get File Information
D*
D* int stat(const char *path, struct stat *buf)
D*--------------------------------------------------------------------
D stat PR 10I 0 ExtProc('stat')
D path * value options(*string)
D buf * value
D GetTimeZone PR 5A
D timezone DS
D tzDir 1A
D tzHour 2S 0
D tzFrac 2S 0
D statsize S 10I 0
d Msg S 50A
D AccessTime S Z
D ModifyTime S Z
D ChgStsTime S Z
D charTS S 26A
D Epoch S Z INZ(z'1970-01-01-00.00.00')
c eval *inlr = *on
c eval statsize = %size(statds)
c alloc statsize p_statds
c* if stat('/JAVA/mail.jar' : p_statds) < 0
c if stat(%trimr(FileName) : p_statds) < 0
c dump
c eval Msg = 'stat() failed? Check errno!'
c dsply Msg
c return
c endif
** times in statds are seconds from the "epoch" (Jan 1, 1970)
** and are in GMT (Greenwich Mean Time)...
** Hey! Lets convert them to RPG timestamps!
c Epoch adddur st_atime:*S AccessTime
c Epoch adddur st_mtime:*S ModifyTime
c Epoch adddur st_ctime:*S ChgStsTime
** adjust timestamps for timezone:
c eval timezone = GetTimeZone
c if tzDir = '-'
c subdur tzHour:*H AccessTime
c subdur tzHour:*H ModifyTime
c subdur tzHour:*H ChgStsTime
c else
c adddur tzHour:*H AccessTime
c adddur tzHour:*H ModifyTime
c adddur tzHour:*H ChgStsTime
c endif
C* display the relevant times:
c move AccessTime charTS
c eval Msg = 'Last Access ' + charTS
c dsply Msg
c move ModifyTime charTS
c eval Msg = 'Last Modified ' + charTS
c dsply Msg
c move ChgStsTime charTS
c eval Msg = 'Status Changed ' + charTS
c dsply Msg
c dealloc p_statds
c eval *inlr = *on
P*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P* This gets the offset from Universal Coordinated Time (UTC)
P* from the system value QUTCOFFSET
P*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P GetTimeZone B
D GetTimeZone PI 5A
D peRcvVar S 1A DIM(100)
D peRVarLen S 10I 0
D peNumVals S 10I 0
D peSysValNm S 10A
D p_Offset S *
D wkOffset S 10I 0 BASED(p_Offset)
D p_SV S *
D dsSV ds BASED(p_SV)
D dsSVSysVal 10A
D dsSVDtaTyp 1A
D dsSVDtaSts 1A
D dsSVDtaLen 10I 0
D dsSVData 5A
D dsErrCode DS
D dsBytesPrv 1 4B 0 INZ(256)
D dsBytesAvl 5 8B 0 INZ(0)
D dsExcpID 9 15
D dsReserved 16 16
D dsExcpData 17 256
C CALL 'QWCRSVAL' 99
C PARM peRcvVar
C PARM 100 peRVarLen
c PARM 1 peNumVals
c PARM 'QUTCOFFSET' peSysValNm
c PARM dsErrCode
c if dsBytesAvl > 0 or *IN99 = *On
c return *blanks
c endif
c eval p_Offset = %addr(peRcvVar(5))
c eval p_SV = %addr(peRcvVar(wkOffset+1))
c return dsSVData
P E
File : QCMDSRC
Member: IFSSTAT
Type : CMD
Usage : CRTCMD CMD(IFSSTAT) PGM(STATR)
IFSSTAT IFSPATHNME('/tmp/***')
'*' 星號表示位於目錄 /tmp 下的檔案，
例如使用 WRKLNK ('/tmp') 即可找到要查詢的檔名。
OS Version: V4 或 V5
CMD PROMPT(' Display IFS stat ')
PARM KWD(IFSPATHNME) TYPE(*CHAR) LEN(100) +
PROMPT('Enter IFS PATH and File name')
2003-04-28 如何快速得知 IFS 目錄下的檔案大小？
如何快速得知 IFS 目錄下的檔案大小？
IBM 提供 V5R1 PTF SI05156 (superseded by SI05856) 及 V5R2 PTF SI05155
可以執行程式指定目錄及可以快速得知該目錄下檔案大小。
For the full report:
call qsrsrv parm("METRICS" '/')
To omit QNTC, QNETWARE, QLANSRV use the following.
call qsrsrv parm("METRICS" '/' "EPFS")
Or for a specific directory.
call qsrsrv parm("METRICS" '/mydir/mysubdir')
星期二, 10月 24, 2023
星期三, 10月 04, 2023
Get IFS file stat() epoch to RPG timestamps
STATPGM.RPGLE
000001160318 /* THE INFORMATION CONTAINED IN THIS DOCUMENT HAS NOT BEEN SUBMITTE D */
000002160318 /* TO ANY FORMAL TESTS AND IS DISTRIBUTED ON AN 'AS IS' BASIS */
000003160318 /* WITHOUT ANY WARRANTY EITHER EXPRESSED OR IMPLIED. THE USE OF THI S */
000004160318 /* INFORMATION OR THE IMPLEMENTATION OF ANY OF THESE TECHNIQUES IS A */
000005160318 /* CUSTOMER RESPONSIBILITY AND DEPENDS ON THE CUSTOMER'S ABILITY TO */
000006160318 /* EVALUATE AND INTEGRATE THEM INTO THE CUSTOMER'S OPERATION */
000007160318 /* ENVIRONMENT. WHILE EACH ITEM MAY HAVE BEEN REVIEWED BY IBM */
000008160318 /* FOR ACCURACY IN A SPECIFIC SITUATION, THERE IS NO GUARANTEE THAT THE */
000009160318 /* SAME OR SIMILAR RESULTS WILL BE OBTAINED ELSEWHERE. CUSTOMERS */
000010160318 /* ATTEMPTING TO ADAPT THESE TECHNIQUES TO THEIR ENVIRONMENTS DO SO */
000011160318 /* AT THEIR OWN RISK. */
000012160317 // ----------------------------------------------------------------------
000100160317 Ctl-Opt DFTACTGRP(*NO) ACTGRP(*NEW);
000101160317 // *********************************************************************
000102160317 // File Information Structure (stat)
000103160317 //
000104160317 // struct stat {
000105160317 // mode_t st_mode; /* File mode */
000106160317 // ino_t st_ino; /* File serial number */
000107160317 // nlink_t st_nlink; /* Number of links */
000108160317 // uid_t st_uid; /* User ID of the owner of file */
000109160317 // gid_t st_gid; /* Group ID of the group of file */
000110160317 // off_t st_size; /* For regular files, the file
000111160317 // * size in bytes */
000112160317 // time_t st_atime; /* Time of last access */
000113160317 // time_t st_mtime; /* Time of last data modification */
000114160317 // time_t st_ctime; /* Time of last file status change */
000115160317 // dev_t st_dev; /* ID of device containing file */
000116160317 // size_t st_blksize; /* Size of a block of the file */
000117160317 // unsigned long st_allocsize; /* Allocation size of the file */
000118160317 // qp0l_objtype_t st_objtype; /* AS/400 object type */
000119160317 // unsigned short st_codepage; /* Object data codepage */
000120160317 // char st_reserved1[66]; /* Reserved */
000121160317 // };
000122160317 //
000123160317 Dcl-S p_statds Pointer;
000124160317 Dcl-Ds statds BASED(p_statds);
000125160317 st_mode Uns(10);
000126160317 st_ino Uns(10);
000127160317 st_nlink Uns(5);
000128160317 st_pad Char(2);
000129160317 st_uid Uns(10);
000130160317 st_gid Uns(10);
000131160317 st_size Int(10);
000132160317 st_atime Int(10);
000133160317 st_mtime Int(10);
000134160317 st_ctime Int(10);
000135160317 st_dev Uns(10);
000136160317 st_blksize Uns(10);
000137160317 st_alctize Uns(10);
000138160317 st_objtype Char(12);
000139160317 st_codepag Uns(5);
000140160317 st_resv11 Char(62);
000141160317 st_ino_gen_id Uns(10);
000142160317 End-Ds;
000143160317
000144160317 // --------------------------------------------------------------------
000145160317 // Get File Information
000146160317 //
000147160317 // int stat(const char *path, struct stat *buf)
000148160317 // --------------------------------------------------------------------
000149160317 Dcl-Pr stat Int(10) ExtProc('stat');
000150160317 path Pointer value options(*string);
000151160317 buf Pointer value;
000152160317 End-Pr;
000153160317
000154160317 Dcl-Pr GetTimeZone Char(5) End-Pr;
000155160317
000156160317 Dcl-Ds timezone;
000157160317 tzDir Char(1);
000158160317 tzHour Zoned(2:0);
000159160317 tzFrac Zoned(2:0);
000160160317 End-Ds;
000161160317
000162160317
000163160317 Dcl-S statsize Int(10);
000164160317 Dcl-S Msg Char(50);
000165160317 Dcl-S AccessTime TimeStamp;
000166160317 Dcl-S ModifyTime TimeStamp;
000167160317 Dcl-S ChgStsTime TimeStamp;
000168160317 Dcl-S charTS Char(26);
000169160317 Dcl-S Epoch TimeStamp INZ(z'1970-01-01-00.00.00');
000170160317 // Prototype for QWCRSVAL
000171160317 Dcl-Pr Pgm_QWCRSVAL ExtPgm('QWCRSVAL');
000172160317 peRcvVar Char(1) Dim(100);
000173160317 peRVarLen Int(10);
000174160317 peNumVals Int(10);
000175160317 peSysValNm Char(10);
000176160317 dsErrCode Char(256);
000177160317 End-Pr;
000178160317
000179160317 *inlr = *on;
000180160317
000181160317 statsize = %size(statds);
000182160317 p_statds = %Alloc(statsize);
000183160317
000184160317 If stat('/temp/jt400.jar': p_statds) < 0;
000185160317 Msg = 'stat() failed? Check errno!';
000186160317 // ...--> dsply Msg
000187160317 c dsply Msg
000188160317 Return;
000189160317 EndIf;
000190160317
000191160317 // * times in statds are seconds from the "epoch" (Jan 1, 1970)
000192160317 // * and are in GMT (Greenwich Mean Time)...
000193160317 // * Hey! Lets convert them to RPG timestamps!
000194160317 AccessTime = Epoch + %Seconds(st_atime);
000195160317 ModifyTime = Epoch + %Seconds(st_mtime);
000196160317 ChgStsTime = Epoch + %Seconds(st_ctime);
000197160317
000198160317 // * adjust timestamps for timezone:
000199160317 timezone = GetTimeZone;
000200160317 If tzDir = '-';
000201160317 AccessTime -= %Hours(tzHour);
000202160317 ModifyTime -= %Hours(tzHour);
000203160317 ChgStsTime -= %Hours(tzHour);
000204160317 Else;
000205160317 AccessTime += %Hours(tzHour);
000206160317 ModifyTime += %Hours(tzHour);
000207160317 ChgStsTime += %Hours(tzHour);
000208160317 EndIf;
000209160317
000210160317 // display the relevant times:
000211160317 charTS = %Char(AccessTime);
000212160317 Msg = 'Last Access ' + charTS;
000213160317 // ...--> dsply Msg
000214160317 c dsply Msg
000215160317
000216160317 charTS = %Char(ModifyTime);
000217160317 Msg = 'Last Modified ' + charTS;
000218160317 // ...--> dsply Msg
000219160317 c dsply Msg
000220160317
000221160317 charTS = %Char(ChgStsTime);
000222160317 Msg = 'Status Changed ' + charTS;
000223160317 // ...--> dsply Msg
000224160317 c dsply Msg
000225160317
000226160317 DeAlloc p_statds;
000227160317 *inlr = *on;
000228160317
000229160317
000230160317 // ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
000231160317 // This gets the offset from Universal Coordinated Time (UTC)
000232160317 // from the system value QUTCOFFSET
000233160317 // ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
000234160317 Dcl-Proc GetTimeZone;
000235160317 Dcl-Pi GetTimeZone Char(5) End-Pi;
000236160317 Dcl-S peRcvVar Char(1) DIM(100);
000237160317 Dcl-S peRVarLen Int(10);
000238160317 Dcl-S peNumVals Int(10);
000239160317 Dcl-S peSysValNm Char(10);
000240160317 Dcl-S p_Offset Pointer;
000241160317 Dcl-S wkOffset Int(10) BASED(p_Offset);
000242160317 Dcl-S p_SV Pointer;
000243160317 Dcl-Ds dsSV BASED(p_SV);
000244160317 dsSVSysVal Char(10);
000245160317 dsSVDtaTyp Char(1);
000246160317 dsSVDtaSts Char(1);
000247160317 dsSVDtaLen Int(10);
000248160317 dsSVData Char(5);
000249160317 End-Ds;
000250160317 Dcl-Ds dsErrCode;
000251160317 dsBytesPrv BinDec(9:0) Pos(1) INZ(256);
000252160317 dsBytesAvl BinDec(9:0) Pos(5) INZ(0);
000253160317 dsExcpID Char(7) Pos(9);
000254160317 dsReserved Char(1) Pos(16);
000255160317 dsExcpData Char(240) Pos(17);
000256160317 End-Ds;
000257160317 peRVarLen = 100;
000258160317 peNumVals = 1;
000259160317 peSysValNm = 'QUTCOFFSET';
000260160317 CallP(e) Pgm_QWCRSVAL(peRcvVar : peRVarLen :
000261160317 peNumVals : peSysValNm : dsErrCode);
000262160317 *In99 = %Error;
000263160317 If dsBytesAvl > 0 or *IN99 = *On;
000264160317 Return *blanks;
000265160317 EndIf;
000266160317 p_Offset = %addr(peRcvVar(5));
000267160317 p_SV = %addr(peRcvVar(wkOffset+1));
000268160317 Return dsSVData;
000269160317 End-Proc;
訂閱：
文章 (Atom)