|
midrange.com
Gordon,
The Unix-type API access() amy be what you want.
Here's a sample RPGLE. Most of the code is in fact to send an error msg for
testing.
Note: the permission parameter is a bitwise addition of each of the
permissions being checked.
Cheers, Peter
H DftActGrp(*No) BndDir( 'QC2LE' )
D SndPgmMsg PR N
D Qmsgid 7 CONST
D Qmsgf 20 CONST
D Qmsg 128 CONST
D Qmsgtp 10 CONST OPTIONS(*NOPASS)
*---------------------------------------------------------------------
* Prototypes for retrieving error generated by procedure call
*---------------------------------------------------------------------
D StrErr PR * ExtProc( 'strerror' )
D Err 10I 0 Value
D ErrTxt PR 79
D 1 Options( *Omit )
D GetErr PR * ExtProc( '__errno' )
D 1 Options( *Omit )
* Test for read permission
D R_OK S 10I 0 INZ(4)
* Test for write permission
D W_OK S 10I 0 INZ(2)
* Test for execute or search
D X_OK S 10I 0 INZ(1)
* Test for existence of a file
D F_OK S 10I 0 INZ(0)
D access PR 10I 0 EXTPROC('access')
D filename * VALUE
D mode 10I 0 VALUE
D FullName S 128A
D ReturnInt S 10I 0
C *Entry PList
C Parm FileIn 50
C Eval FullName = %trim(FileIn) + x'00'
C Eval ReturnInt = access(%ADDR(FullName)
C : R_OK + W_OK)
* Terminate if error occurred
C If ReturnInt < *zero
C Callp SndPgmMsg('CPF9898':'QCPFMSG'
C :ErrTxt(*Omit))
C Eval *inlr = *on
C Return
C Endif
C
C Eval *inLR = *on
*----------------------------------------------------------------*
* Send pgm message
*----------------------------------------------------------------*
P SndPgmMsg B
D PI N
D Msgid 7 CONST
D Msgf 20 CONST
D Msgdta 128 CONST
D Msgtp 10 CONST OPTIONS(*NOPASS)
* Work variables
D Qmsgid S 7
D Qmsgf S 20
D Qmsgdta S 128
D Qmsgln S 10I 0
D Qmsgtp S 10
D Qmsgq S 10
D Qmsgqn S 10I 0 INZ(3)
D Qmsgky S 4
D Qmsger S 15
* Insert default for library if msg file library is blank
C Eval Qmsgid = Msgid
C Eval Qmsgf = Msgf
C Eval Qmsgdta = Msgdta
C If %subst(Qmsgf:11:10) = *blank
C Eval %subst(Qmsgf:11:10) = '*LIBL'
C Endif
C Eval Qmsgln = %len(%trim(Qmsgdta))
C Eval Qmsgq = '*'
C Eval Qmsgtp = '*DIAG'
C If %parms > 3
C Eval Qmsgtp = Msgtp
C Endif
C If Qmsgtp = '*STATUS'
C Eval Qmsgq = '*EXT'
C Endif
C Call 'QMHSNDPM' 99
C Parm Qmsgid
Msg ID
C Parm Qmsgf
Msg file
C Parm Qmsgdta
Msg text
C Parm Qmsgln
Msg length
C Parm Qmsgtp
Msg type
C Parm Qmsgq
Pgm queue
C Parm Qmsgqn
Pgm lvl
C Parm Qmsgky
Msg key
C Parm *LOVAL Qmsger
Error field
C Return *on
P E
*----------------------------------------------------------------*
* Return the previous API function's error in text format
P ErrTxt B Export
D ErrTxt PI 79
D DummyParm 1 Options( *Omit )
* Local variable(s)
D ErrNo S 10I 0 Based( ErrNoPtr )
D RetChr S 79
D Chr300 S 300 Based( Chr300Ptr )
C Eval ErrNoPtr = GetErr( *Omit )
C Eval Chr300Ptr = StrErr( ErrNo )
C Eval RetChr = %Str( Chr300Ptr )
C Return RetChr
P ErrTxt E
-----Original Message-----
From: Gordon R. Robinson IV [mailto:GRobinson@ruger.com]
Sent: Thursday, March 29, 2001 4:02 AM
To: RPG400-L@midrange.com
Subject: Checking User's Authority to Files in Root File System
Does anyone know a way, particularly an API, to check if a user has
authority to a file? I found an API to check the user's authority to an
object in the QSYS.LIB file system, but I need to be able to check the
user's authority to a file in the Root file system. I'm writing a program
that will only show certain options if the users has access the authority to
use those files.
+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator:
david@midrange.com
+---
This communication is confidential and may be legally privileged.
If it is not addressed to you, you are on notice of its status.
Please immediately contact us at our cost and destroy it.
Please do not use, disclose, copy, distribute or retain any of it
without our authority - to do so could be a breach of confidence.
Thank you for your co-operation.
Please contact us on (09) 356 5800 if you need assistance.
+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
