• Subject: Routine to set file level id's
  • From: David Gibbs <dgibbs@xxxxxxx>
  • Date: Wed, 26 Jan 2000 09:12:20 -0600

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


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2022 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.