RPGIV @ Work

A unique site for RPG and System i Lovers

Welcome!

Hi, this site will provide all what you need in System i and RPG developments.

My Name is Chamara Withanachchi, System i Expert and RPG Developer. And in the field for last 11 years.

I hope you will find lot of valuable information from this site

Retrieve User Profile Print E-mail
User Rating: / 2
PoorBest 
Written by Chamara Withanachchi   
      *---------------------------------------------------------------------  
      * Get the User Details                                                  
      * getUser()                                                             
      * Parameters : NONE                                                     
      * Returns    : Status                                                   
      *---------------------------------------------------------------------  
     P getUser         B                                                      
                                                                              
     D getUser         PI             1a                                      
                                                                              
     D usrErr          s              1a                                      
                                                                              
      *---------------------------------------------------------------------  
      * Procedure Working Variables                                           
      *---------------------------------------------------------------------  
     D objNam          s             10a                                      
     D objLib          s             10a                                      
     D objTyp          s             10a                                      
                                                                              
      *---------------------------------------------------------------------  
      * Api error data structure                                             
      *--------------------------------------------------------------------- 
     D apiError        Ds                                                    
     D  aeBytPro                     10i 0 Inz( %Size( apiError ))           
     D  aeBytAvl                     10i 0 Inz                               
     D  aeMsgId                       7a                                     
     D                                1a                                     
     D  aeMsgDta                    128a                                     
                                                                             
      *--------------------------------------------------------------------- 
      * Object description structure OBJD0200                                
      *--------------------------------------------------------------------- 
     D roData          Ds                                                    
     D  roBytRtn                     10i 0                                   
     D  roBytAvl                     10i 0                                   
     D  roObjNam                     10a                                     
     D  roObjLib                     10a                                     
     D  roObjTypRt                   10a                                     
     D  roObjLibRt                   10a                                     
     D  roObjASP                     10i 0                                  
     D  roObjOwn                     10a                                    
     D  roObjDmn                      2a                                    
     D  roObjCrtDts                  13a                                    
     D  roObjChgDts                  13a                                    
     D  roExtAtr                     10a                                    
     D  roTxtDsc                     50a                                    
     D  roSrcF                       10a                                    
     D  roSrcLib                     10a                                    
     D  roSrcMbr                     10a                                    
                                                                            
      *---------------------------------------------------------------------
      * Retrieve object description                                         
      *---------------------------------------------------------------------
     D rtvObjD         Pr                  ExtPgm( 'QUSROBJD' )             
     D  roRcvVar                  32767a         Options( *VarSize )        
     D  roRcvVarLen                  10i 0 Const                            
     D  roFmtNam                      8a   Const                            
     D  roObjNamQ                    20a   Const                            
     D  roObjTyp                     10a   Const                            
     D  roError                   32767a         Options( *VarSize )        
                                                                            
      *---------------------------------------------------------------------
      * User Information                                                    
      *---------------------------------------------------------------------
     D rtvUsrPrf       Pr                  ExtPgm( 'QSYRUSRI' )             
     D  rcvvar                    32767a   options(*varsize)                
     D  rcvvarlen                    10I 0 const                            
     D  format                        8a   const                            
     D  usrprf                       10a   const                            
     D  errorCode                 32767a   options(*varsize)                
                                                                            
      * User information  arguments (QSYRUSRI)                              
     D qodarg          DS                                                   
     D  fmtNam                 1      8a   inz('USRI0300')                  
     D  usrPrf                 9     18a                                    
     D  dtaLen                19     22i 0 inz(%size(rcvDta))               
     D  rcvDta               101   1000a                                    
     D  status               137    146a                    
     D  class                174    183a                    
     D  spclA                184    193a                    
                                                            
     D error           DS                                   
     D  size                   1      4I 0 inz(%size(error))
     D  bytAvl                 5      8I 0                  
     D  msgID                  9     15A                    
                                                            
      /Free                                                 
                                                            
         usrErr = '0';                                      
         objNam = %Trim($$USER);                            
         objLib = '*LIBL';                                  
         objTyp = '*USRPRF';                                
                                                            
         rtvObjD( roData                                    
                : %Size( roData )                           
                : 'OBJD0200'                                
                : objNam + objLib                       
                : objTyp                                
                : apiError                              
                );                                      
                                                        
          If aeBytAvl > *Zero and aeMsgId = 'CPF9801';  
             usrErr = '1';                              
          Else;                                         
             $$USRNM = roTxtDsc;                        
             kUser = objNam;                            
             Chain kUser SCP0011;                       
             If %Found(SCP001L1);                       
                $$LIBL = SCLLST;                        
                kLibl = SCLLST;                         
                Chain (kUser : kLibl : kBank) SCP0101;  
                If %Found(SCP010L1);                    
                   $$USRROL = SCGRPP;                   
                EndIf;                                  
             EndIf;                                     
                                               
             // Get the User Status            
             rtvUsrPrf( rcvDta                 
                      : dtaLen                 
                      : fmtNam                 
                      : kUser                  
                      : error                  
                      );                       
             $$STS = status;                   
             $$CLASS = class;                  
                                               
             Select;                           
             When %Subst(spclA : 1 : 1) = 'Y'; 
                $$AUTH = '*ALLOBJ';            
             When %Subst(spclA : 2 : 1) = 'Y'; 
                $$AUTH = '*SECADM';            
             When %Subst(spclA : 3 : 1) = 'Y'; 
                $$AUTH = '*JOBCTL';            
             When %Subst(spclA : 4 : 1) = 'Y'; 
                $$AUTH = '*SPLCTL';            
             When %Subst(spclA : 5 : 1) = 'Y'; 
                $$AUTH = '*SAVSYS';            
             When %Subst(spclA : 6 : 1) = 'Y'; 
                $$AUTH = '*SERVICE';           
             When %Subst(spclA : 7 : 1) = 'Y'; 
                $$AUTH = '*AUDIT';             
             When %Subst(spclA : 8 : 1) = 'Y'; 
                $$AUTH = '*IOSYSCFG';          
             EndSl;                            
                                               
          EndIf;                               
                                               
          Return usrErr;                       
                                               
      /End-Free                                
                                               
     P getUser         E 
                      

User Comments

Please login or register to add comments

<Previous   Next>