Kudos and appreciation to David Gibbs and all the contributors on this site.
The below exchange came just at the right time for a program I am writing.
Paul
-----Original Message-----
From: MIDRANGE-L [mailto:midrange-l-bounces@xxxxxxxxxxxx] On Behalf Of
Justin Taylor
Sent: Tuesday, August 15, 2017 1:07 PM
To: Midrange Systems Technical Discussion <midrange-l@xxxxxxxxxxxx>
Subject: RE: access API from CLLE
Perfect, thank you!
I never would have thought to put the procedure name in quotes.
-----Original Message-----
From: Scott Klement [mailto:midrange-l@xxxxxxxxxxxxxxxx]
Sent: Monday, August 14, 2017 5:47 PM
To: Midrange Systems Technical Discussion <midrange-l@xxxxxxxxxxxx>
Subject: Re: access API from CLLE
Hi Justin,
On 8/14/2017 4:57 PM, Justin Taylor wrote:
Can anyone share a sample of the access() IFS API from CLLE?
Sure, here's an example that I already had laying around... not sure what I
originally wrote this for, but I think it illustrates things well enough.
PGM
DCL VAR(&RtnVar) TYPE(*INT) LEN(4)
DCL VAR(&Null) TYPE(*CHAR) LEN(1) VALUE(X'00')
DCL VAR(&SomeFile) TYPE(*CHAR) LEN(64)
DCL VAR(&Mode) TYPE(*INT) LEN(4) VALUE(0)
DCL VAR(&ErrPtr) TYPE(*PTR)
DCL VAR(&Errno) TYPE(*INT) LEN(4) +
STG(*BASED) BASPTR(&ErrPtr)
DCL VAR(&MsgNo) TYPE(*DEC) LEN(4 0)
DCL VAR(&MsgNoC) TYPE(*CHAR) LEN(4)
DCL VAR(&MsgId) TYPE(*CHAR) LEN(7)
DCL VAR(&F_OK) TYPE(*INT) LEN(4) VALUE(0)
DCL VAR(&R_OK) TYPE(*INT) LEN(4) VALUE(4)
DCL VAR(&W_OK) TYPE(*INT) LEN(4) VALUE(2)
/* DCL VAR(&X_OK) TYPE(*INT) LEN(4) VALUE(1) */
CHGVAR VAR(&SomeFile) VALUE('/qibm/ProdData/Access/Windows+
/Install/Image/SETUP.EXE' *TCAT &NULL)
/*===================================== */
/* Check for file existence */
/*===================================== */
CALLPRC PRC('access') PARM((&SomeFile) +
(&F_OK *ByVal)) +
RTNVAL(&RtnVar)
if (&RtnVar *EQ 0) do
SNDPGMMSG MSG('Exists' *bcat &SomeFile)
enddo
ELSE DO
CALLPRC PRC('__errno') RTNVAL(&ERRPTR)
CHGVAR VAR(&MSGNO) VALUE(&ERRNO)
CHGVAR VAR(&MSGNOC) VALUE(&ERRNO)
CHGVAR VAR(&MSGID) VALUE(CPE *TCAT &MSGNOC)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGTYPE(*DIAG)
SNDPGMMSG MSG('Error, see diagnostic message')
enddo
/*===================================== */
/* Check for read/write access */
/*===================================== */
CHGVAR VAR(&Mode) VALUE(&R_OK + &W_OK)
CALLPRC PRC('access') PARM((&SomeFile) +
(&Mode *ByVal)) +
RTNVAL(&RtnVar)
if (&RtnVar *EQ 0) do
SNDPGMMSG MSG('You have read & write access!')
enddo
ELSE DO
CALLPRC PRC('__errno') RTNVAL(&ERRPTR)
CHGVAR VAR(&MSGNO) VALUE(&ERRNO)
CHGVAR VAR(&MSGNOC) VALUE(&ERRNO)
CHGVAR VAR(&MSGID) VALUE(CPE *TCAT &MSGNOC)
SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) MSGTYPE(*DIAG)
SNDPGMMSG MSG('Error, see diagnostic message')
enddo
ENDPGM
--
This is the Midrange Systems Technical Discussion (MIDRANGE-L) mailing list
To post a message email: MIDRANGE-L@xxxxxxxxxxxx To subscribe, unsubscribe,
or change list options,
visit:
http://lists.midrange.com/mailman/listinfo/midrange-l
or email: MIDRANGE-L-request@xxxxxxxxxxxx Before posting, please take a
moment to review the archives at
http://archive.midrange.com/midrange-l.
Please contact support@xxxxxxxxxxxx for any subscription related questions.
Help support midrange.com by shopping at amazon.com with our affiliate link:
http://amzn.to/2dEadiD
midrange.com
