|
midrange.com
Folks:
I've been assigned the task of find an API or C routine that replaces a MI
program we currently use to set the file level id for PF's & LF's.
We want to replace the MI routine because it won't run on a system at level
40 security.
Here's the current routine ... I have absolutely NO idea what it's going...
if someone can point me to an API or C routine that can do the same thing,
it would be greatly appreciated.
Thanks!
david
----------------------------------------------------------------------------
---------------------------
ENTRY * (*ENTRY) EXT;
/* -----------------------------------------------------------------*/
/* PARAMETERS PASSED IN TO PROGRAM */
/* -----------------------------------------------------------------*/
DCL SPCPTR P_FIL_PTR PARM; /* FILE NAME */
DCL SPCPTR P_LIB_PTR PARM; /* *LIBL, QTEMP */
/* *LIBL & QTEMP NOT YET */
/* SUPPORTED */
DCL SPCPTR P_FILEID_PTR PARM; /* MEMBER NAME */
DCL SPCPTR P_FUNCT_PTR PARM; /* FUNCTION '*CHG', '*RTV' */
DCL SPCPTR P_RETURN_PTR PARM;
DCL OL *ENTRY (P_FIL_PTR,P_LIB_PTR,P_FILEID_PTR,
P_FUNCT_PTR,P_RETURN_PTR) EXT PARM;
DCL DD P_FIL CHAR(10) BAS(P_FIL_PTR);
DCL DD P_LIB CHAR(10) BAS(P_LIB_PTR);
DCL DD P_FILEID CHAR(13) BAS(P_FILEID_PTR);
DCL DD P_FUNCT CHAR(10) BAS(P_FUNCT_PTR);
DCL DD P_RETURN CHAR(10) BAS(P_RETURN_PTR);
/* -----------------------------------------------------------------*/
/* PROCESS COMMUNICATION OBJECT (PCO) */
/* -----------------------------------------------------------------*/
DCL SYSPTR QTEMP BASPCO POS(65);
/* -----------------------------------------------------------------*/
/* CONSTANTS */
/* -----------------------------------------------------------------*/
DCL DD *FILE CHAR(2) INIT(X'1901');
DCL DD *LIB CHAR(2) INIT(X'0401');
/*------------------------------------------------------------------*/
/* WORK VARIABLES */
/*------------------------------------------------------------------*/
/* RESOLVE TO SYSTEM POINTER - OPERAND FOR RSLVSP */
DCL DD R CHAR(34);
DCL DD RTYP CHAR(2) DEF(R) POS(1);
DCL DD ROBJ CHAR(30) DEF(R) POS(3);
DCL DD RAUT CHAR(2) DEF(R) POS(33) INIT(X'0800');
/* FILE INFORMATION */
DCL DD FI CHAR(74) BAS(*) BDRY(16);
DCL DD FI_FILEID CHAR(13) DEF(FI) POS(62);
/* LIBRARY INFO - POINTERS */
DCL DD FI CHAR(74) BAS(*) BDRY(16);
DCL DD FI_FILEID CHAR(13) DEF(FI) POS(62);
/* LIBRARY INFO - POINTERS */
DCL SYSPTR LIB_PTR;
DCL SYSPTR SYSFILE_PTR;
DCL SPCPTR FILE_PTR;
/*------------------------------------------------------------------*/
/* RESOLVE TO THE LIBRARY (CONTEXT) */
/*------------------------------------------------------------------*/
CPYBLAP ROBJ,P_LIB,' ';
CPYBLAP RTYP,*LIB,' ';
RSLVSP LIB_PTR,R,*,*;
/*------------------------------------------------------------------*/
/* RESOLVE TO THE FILE INFORMATION */
/*------------------------------------------------------------------*/
CPYBLAP ROBJ,P_FIL,' ';
CPYBLA RTYP,*FILE;
RSLVSP SYSFILE_PTR,R,LIB_PTR,*;
/*------------------------------------------------------------------*/
/* POINT TO ASSOCIATED MEMBER SPACE */
/*------------------------------------------------------------------*/
SETSPPFP FILE_PTR,SYSFILE_PTR;
BRK 'MH';
/* -----------------------------------------------------------------*/
/* UPDATE FILE INFORMATION */
/* -----------------------------------------------------------------*/
/* DETERMINE IF THE FILE ID SHOULD BE CHANGED OR RETURNED */
CMPBLAP(B) P_FUNCT,'*RTV',' '/EQ(RETRIEVE);
/* CHANGE THE FILE IDENTIFIER IF VALUE IS NOT '*SAME' */
CMPBLAP(B) P_FILEID,'*SAME',' '/EQ(ENDIF01);
CPYBLA FILE_PTR->FI_FILEID,P_FILEID;
RETRIEVE:
/* RETRIEVE THE FILE IDENTIFIER */
CPYBLA P_FILEID,FILE_PTR->FI_FILEID;
ENDIF01:
NOOP;
PEND;
----------------------------------------------------------------------------
---------------------------
--
David Gibbs
Sr. Software Engineer
Mortice Kern Systems US, Inc.
2500 S. Highland Ave., Suite 200
Lombard, IL 60148
phone: (630) 495-2108 x5004
http://www.mks.com <http://www.mks.com/>
mailto:dgibbs@mks.com <mailto:dgibbs@mks.com>
Opinions expressed are strictly my own and do
not necessarily reflect those of my employer.
+---
| This is the MI Programmers Mailing List!
| To submit a new message, send your mail to MI400@midrange.com.
| To subscribe to this list send email to MI400-SUB@midrange.com.
| To unsubscribe from this list send email to MI400-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: dr2@cssas400.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.
