|
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.