midrange.com code scratchpad
Name:
UCHKLCK
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
06/10/2021 12:18:03 pm
IP:
Logged
Description:
CL Program to check for locks on a member.
Code:
  1. PGM  PARM(&OBJ &LIB &OBJTYPE &MBRNAME &JOB &USER &JOBNBR)
  2.                                                          
  3.       DCL VAR(&OBJ)       TYPE(*CHAR) LEN(10)            
  4.       DCL VAR(&LIB)       TYPE(*CHAR) LEN(10)            
  5.       DCL VAR(&OBJTYPE)   TYPE(*CHAR) LEN(10)            
  6.       DCL VAR(&MBRNAME)   TYPE(*CHAR) LEN(10)            
  7.       DCL VAR(&JOB)       TYPE(*CHAR) LEN(10)            
  8.       DCL VAR(&USER)      TYPE(*CHAR) LEN(10)            
  9.       DCL VAR(&JOBNBR)    TYPE(*CHAR) LEN( 6)            
  10.                                                          
  11.       DCL VAR(&USRSPC)    TYPE(*CHAR) LEN(20)            
  12.       DCL VAR(&EXTATR)    TYPE(*CHAR) LEN(10)            
  13.       DCL VAR(&INITSIZE)  TYPE(*CHAR) LEN( 4)            
  14.       DCL VAR(&INITVALUE) TYPE(*CHAR) LEN( 1)            
  15.       DCL VAR(&PUBAUTH)   TYPE(*CHAR) LEN(10)            
  16.       DCL VAR(&TEXT)      TYPE(*CHAR) LEN(50)            
  17.       DCL VAR(&ERRCODE)   TYPE(*CHAR) LEN( 8)            
  18.       DCL VAR(&QUALOBJ)   TYPE(*CHAR) LEN(20)            
  19.       DCL VAR(&POS)       TYPE(*CHAR) LEN( 4)            
  20.       DCL VAR(&LEN)       TYPE(*CHAR) LEN( 4)                       
  21.       DCL VAR(&TEMP)      TYPE(*CHAR) LEN( 4)                       
  22.       DCL VAR(&OFFSET)    TYPE(*DEC)  LEN(10 0)                     
  23.       DCL VAR(&ENTCOUNT)  TYPE(*DEC)  LEN(10 0)                     
  24.       DCL VAR(&ENTSIZE)   TYPE(*DEC)  LEN(10 0)                     
  25.       DCL VAR(&ENTRY)     TYPE(*CHAR) LEN(64)                       
  26.                                                                     
  27.                                                                     
  28.       DCL VAR(&LOCKSTATE)  TYPE(*CHAR) LEN(10)                      
  29.       DCL VAR(&LOCKSTATUS) TYPE(*DEC)  LEN(10 0)                    
  30.       DCL VAR(&LOCKTYPE)   TYPE(*DEC)  LEN(10 0)                    
  31.       DCL VAR(&SHARE)      TYPE(*CHAR) LEN(1)                       
  32.       DCL VAR(&SCOPE)      TYPE(*CHAR) LEN(1)                       
  33.       DCL VAR(&THREAD)     TYPE(*CHAR) LEN(8)                       
  34.                                                                     
  35.                                                                     
  36.       /********************************************************** + 
  37.        * CREATE A USER SPACE TO STORE THE LIST OF JOBS THAT ARE   + 
  38.        * LOCKING AN OBJECT.                                       + 
  39.        ************************************************************/
  40.                                                                 
  41.      CHGVAR VAR(%BIN(&INITSIZE)) VALUE(65536)                   
  42.      CHGVAR VAR(&INITVALUE) VALUE(X'00')                        
  43.      CHGVAR VAR(&USRSPC)    VALUE('OBJLOCKS  QTEMP')            
  44.      CHGVAR VAR(&EXTATR)    VALUE('MYPGM')                      
  45.      CHGVAR VAR(&PUBAUTH)   VALUE('*EXCLUDE')                   
  46.      CHGVAR VAR(&TEXT)      VALUE('USER SPACE TO CONTAIN OUTPUT 
  47.                                    FROM QWCLOBJL API')          
  48.      CHGVAR VAR(%BIN(&ERRCODE 1 4)) VALUE(0)                    
  49.                                                                 
  50.      CALL PGM(QUSCRTUS) PARM(&USRSPC    +                       
  51.                              &EXTATR    +                       
  52.                              &INITSIZE  +                       
  53.                              &INITVALUE +                       
  54.                              &PUBAUTH   +                       
  55.                              &TEXT      +                       
  56.                              '*YES'     +                       
  57.                              &ERRCODE   )                       
  58.                                                                 
  59.                                                                 
  60.                                                                     
  61.       /********************************************************** + 
  62.        * TELL THE QWCLOBJL API TO PUT A LIST OF LOCKS FOR THE     + 
  63.        * GIVEN OBJECTS INTO THE USER SPACE                        + 
  64.        ************************************************************/
  65.       CHGVAR VAR(&QUALOBJ) VALUE(&OBJ *CAT &LIB)                    
  66.       CHGVAR VAR(%BIN(&ERRCODE 1 4)) VALUE(0)                       
  67.                                                                     
  68.       CALL PGM(QWCLOBJL) PARM(&USRSPC    +                          
  69.                               'OBJL0100' +                          
  70.                               &QUALOBJ   +                          
  71.                               &OBJTYPE   +                          
  72.                               &MBRNAME   +                          
  73.                               &ERRCODE   )                          
  74.                                                                     
  75.       /********************************************************** + 
  76.        * RETRIEVE INFORMATION ABOUT WHERE THE LIST ENTRIES ARE    + 
  77.        * LOCATED IN THE USER SPACE                                + 
  78.        *                                                          + 
  79.        *  POSITION 125-128 = OFFSET TO THE LIST DATA              + 
  80.                                                                     
  81.        *           133-136 = NUMBER OF ENTRIES IN LIST            + 
  82.        *           137-140 = SIZE OF EACH LIST ENTRY              + 
  83.        ************************************************************/
  84.                                                                     
  85.       CHGVAR VAR(%BIN(&POS)) VALUE(125)                             
  86.       CHGVAR VAR(%BIN(&LEN)) VALUE(4)                               
  87.       CALL   PGM(QUSRTVUS) PARM(&USRSPC &POS &LEN &TEMP)            
  88.       CHGVAR VAR(&OFFSET) VALUE(%BIN(&TEMP))                        
  89.                                                                     
  90.       CHGVAR VAR(%BIN(&POS)) VALUE(133)                             
  91.       CALL   PGM(QUSRTVUS) PARM(&USRSPC &POS &LEN &TEMP)            
  92.       CHGVAR VAR(&ENTCOUNT) VALUE(%BIN(&TEMP))                      
  93.       CHGVAR VAR(%BIN(&POS)) VALUE(137)                             
  94.       CALL   PGM(QUSRTVUS) PARM(&USRSPC &POS &LEN &TEMP)            
  95.       CHGVAR VAR(&ENTSIZE) VALUE(%BIN(&TEMP))                       
  96.                                                                     
  97.                                                                     
  98.       /********************************************************** + 
  99.        * READ THE LIST OF ENTRIES FROM THE USER SPACE             + 
  100.        ************************************************************/
  101.                                                                
  102.       CHGVAR VAR(%BIN(&POS)) VALUE(1 + &OFFSET)                
  103.       CHGVAR VAR(%BIN(&LEN)) VALUE(64) /* SIZE OF &ENTRY VAR */
  104.                                                                
  105. LOOP: IF (&ENTCOUNT *GT 0) DO                                  
  106.                                                                
  107.          /* READ A SINGLE ENTRY FROM THE USER SPACE */         
  108.                                                                
  109.          CALL PGM(QUSRTVUS) PARM(&USRSPC &POS &LEN &ENTRY)     
  110.          CHGVAR VAR(&JOB)        VALUE(%SST(&ENTRY  1 10))     
  111.          CHGVAR VAR(&USER)       VALUE(%SST(&ENTRY 11 10))     
  112.          CHGVAR VAR(&JOBNBR)     VALUE(%SST(&ENTRY 21  6))     
  113.          CHGVAR VAR(&LOCKSTATE)  VALUE(%SST(&ENTRY 27 10))     
  114.          CHGVAR VAR(&LOCKSTATUS) VALUE(%BIN(&ENTRY 37  4))     
  115.          CHGVAR VAR(&LOCKTYPE)   VALUE(%BIN(&ENTRY 41  4))     
  116.          CHGVAR VAR(&MBRNAME)    VALUE(%SST(&ENTRY 45 10))     
  117.          CHGVAR VAR(&SHARE)      VALUE(%SST(&ENTRY 55  1))     
  118.          CHGVAR VAR(&SCOPE)      VALUE(%SST(&ENTRY 56  1))     
  119.          CHGVAR VAR(&THREAD)     VALUE(%SST(&ENTRY 57  8))     
  120.                                                                
  121.          /* AT THIS POINT, THE FIELDS ABOVE SHOULD BE CORRECT +        
  122.             FOR ONE OF THE JOBS IN THE LIST.  YOU CAN NOW     +        
  123.             ISSUE A SNDMSG, SNDBRKMSG OR ENDJOB AS NEEDED     */       
  124.                                                                        
  125. /*  FOR EXAMPLE:                                                     */
  126.          GOTO END                                                      
  127.                                                                        
  128.          SNDMSG MSG('YOU HAVE 5 SECONDS TO GET OUT OF THAT +           
  129.                     PROGRAM, BUDDY.') TOUSR(&USER)                     
  130.                                                                        
  131.          ENDJOB JOB(&JOBNBR/&USER/&JOB) OPTION(*CNTRLD) DELAY(5)       
  132.          MONMSG MSGID(CPF1362 CPF1363)                                 
  133.                                                                        
  134.                                                                        
  135.          /* ADVANCE TO NEXT ENTRY IN LIST */                           
  136.                                                                        
  137.          CHGVAR VAR(%BIN(&POS))  VALUE(%BIN(&POS) + &ENTSIZE)          
  138.          CHGVAR VAR(&ENTCOUNT)   VALUE(&ENTCOUNT - 1)                  
  139.          GOTO LOOP                                                     
  140.       ENDDO                                                            
  141.                                                                        
  142. END:                                                                   
  143. /*  DELETE THE USER SPACE, WE'RE DONE!                               */
  144.                                                                        
  145.       CALL PGM(QUSDLTUS) PARM(&USRSPC &ERRCODE)                        
  146.                                                                        
  147. ENDPGM                                                                 
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css