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