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

QWCRSVAL - Retrieve system value Print E-mail
User Rating: / 0
PoorBest 
Written by Chamara Withanachchi   
     h Option(*SrcStmt: *NoDebugIO)                                                                 
      *                                                                                             
     FQSYSPRT   O    F  132        PRINTER OFLIND(*INOF)                                            
      *--------------------------------------------------------                                     
      //                                                                                            
      //  Entry Plist                                                                               
      //                                                                                            
                                                                                                    
     d @CHGPASS        pr                                                                           
     d  InCurrent                    10                                                             
     d  InNew                        10                                                             
                                                                                                    
     d @CHGPASS        pi                                                                           
     d  InCurrent                    10                                                             
     d  InNew                        10                                                             
                                                                                                    
      *                                                                                             
      * Variable Definition                                                                         
      *                                                                                             
     d letters         c                   CONST('AEIOUBCDFGHJKLMNPQRSTVWXZ012-                     
     d                                            3456789')                                         
     d lastchar        s              1                                                             
     d newpass         s             10                                                             
     d numbercorrect   s              2  0                                                          
     d numberrequired  s              2  0                                                          
     d oldpass         s             10                                                             
     d random          s              2  0                                                          
     d value           s             10                                                             
     d BinaryValue     s              4b 0                                                          
     d  w_SrlNbr       s              8                                                             
     d  w_Rcvr         s             36a                                                            
     d  w_RcvrLngth    s             10i 0 inz(%len(w_Rcvr))                                        
     d  w_NbrToRtv     s             10i 0 inz(1)                                                   
     d  w_SysVal       s             10a   inz('QPWDRQDDIF')                                        
     d workPass        s             10                                                             
                                                                                                    
     d DS_SysValTbl    ds                                                                           
     d  d_ValsRtn                    10i 0                                                          
     d  d_Offset                     10i 0                                                          
     d  d_filler                     08a                                                            
     d  d_SysVal                     10a                                                            
     d  d_ValType                     1a                                                            
     d  d_InfoSts                     1a                                                            
     d  d_DtaLngth                   10i 0                                                          
     d  d_Data                       10a                                                            
                                                                                                    
     d changePW        PR                  EXTpgm('QSYCHGPW')                                       
     d   userid                      10                                                             
     d   currentPW                   10                                                             
     d   newPW                       10                                                             
     d   error                       15                                                             
      *                                                                                             
     d ds_Error        Ds            15                                                             
     d  BytesProvided                10I 0 inz(%size(ds_Error))                                     
     d  BytesAvail                   10I 0                                                          
     d  ErrorId                       7                                                             
                                                                                                    
     d QWCRSVAL        pr                  extpgm('QWCRSVAL')                                       
     d  p_Rcvr                             Like(w_Rcvr)                                             
     d  p_RcvrLngth                        Like(w_RcvrLngth)                                        
     d  p_NbrToRtv                         Like(w_NbrToRtv)                                         
     d  p_SysVal                           Like(w_SysVal)                                           
     d  p_Error                            Like(DS_Error)                                           
                                                                                                    
      *                                                                                             
     d area51          ds                                                                           
     d  Whole9Yards                   4                                                             
     d  MinPassLength                10i 0 overlay(Whole9Yards:1)                                   
                                                                                                    
      *                                                                                             
      * Program Info                                                                                
      *                                                                                             
     d                SDS                                                                           
     d  @PGM                   1     10                                                             
     d  @PARMS                37     39  0                                                          
     d  @MSGDTA               91    170                                                             
     d  @MSGID               171    174                                                             
     d  @JOB                 244    253                                                             
     d  @USER                254    263                                                             
     d  @JOB#                264    269  0                                                          
      *                                                                                             
     d  Shorts       e ds                  extname(INRSHRT)                                         
                                                                                                    
      /Free                                                                                         
                                                                                                    
        //--------------------------------------------------------                                  
        // MAIN PROGRAM  - QPWDRQDDIF                                                               
        //--------------------------------------------------------                                  
                                                                                                    
                                                                                                    
                                                                                                    
            exsr Hskpg;                                                                             
                                                                                                    
          if %len(%trim(InNew)) >= MinPassLength and                                                
              %subst(InNew:1:1) >= 'A' and                                                          
              %subst(InNew:1:1) <= 'Z';                                                             
                                                                                                    
            oldpass = InCurrent;                                                                    
            newpass = InNew;                                                                        
                                                                                                    
            dou ErrorId = *blanks and numbercorrect >                                               
                                      numberrequired;                                               
                                                                                                    
                clear  workpass;                                                                    
                dou %len(%trim(WorkPass)) = MinPassLength;                                          
                                                                                                    
                  dou random <> *zeros;                                                             
                    exsr $getRandom;                                                                
                  enddo;                                                                            
                                                                                                    
                  lastchar = %subst(letters:Random:1);                                              
                  workpass = %trim(workPass) + lastchar;                                            
                enddo;                                                                              
                                                                                                    
              clear ErrorId;                                                                        
              changePW( @user : OldPass : WorkPass : ds_Error );                                    
                                                                                                    
              if *inof = *on;                                                                       
                except head;                                                                        
                *inof = *off;                                                                       
              endif;                                                                                
                                                                                                    
               except detail;                                                                       
                                                                                                    
              if ErrorId = *blanks;                                                                 
                numbercorrect +=1;                                                                  
                oldpass = workpass;                                                                 
              endif;                                                                                
                                                                                                    
            enddo;                                                                                  
              changePW( @user : OldPass : newpass : ds_Error );                                     
              except detail;                                                                        
          endif;                                                                                    
                                                                                                    
               *inlr = *on;                                                                         
                                                                                                    
        //--------------------------------------------------------                                  
        // $getRandom - Generate random number                                                      
        //--------------------------------------------------------                                  
                                                                                                    
             begsr $getRandom;                                                                      
                                                                                                    
                  clear  Random;                                                                    
      /end-free                                                                                     
                                                                                                    
     c/Exec SQL                                                                                     
     c+ Select Rand() * 036 Into :Random                                                            
     c+ From SYSIBM/SYSDUMMY1                                                                       
     c/End-Exec                                                                                     
                                                                                                    
      /free                                                                                         
                                                                                                    
                                                                                                    
             endsr;                                                                                 
                                                                                                    
        //--------------------------------------------------------                                  
        // Hskpg - one time run subroutine                                                          
        //--------------------------------------------------------                                  
                                                                                                    
             begsr Hskpg;                                                                           
                                                                                                    
             except head;                                                                           
                                                                                                    
             w_SysVal = 'QPWDRQDDIF';                                                               
             QWCRSVAL(w_Rcvr :                                                                      
                      w_RcvrLngth :                                                                 
                      w_NbrToRtv :                                                                  
                      w_SysVal :                                                                    
                      ds_Error );                                                                   
                                                                                                    
             DS_SysValTbl = w_Rcvr;                                                                 
             Value = %subst(d_Data:1:d_DtaLngth);                                                   
                                                                                                    
                                                                                                    
            //0=Can be the same as old passwords                                                    
            //1=Cannot be the same as last 32                                                       
            //2=Cannot be the same as last 24                                                       
            //3=Cannot be the same as last 18                                                       
            //4=Cannot be the same as last 12                                                       
            //5=Cannot be the same as last 10                                                       
            //6=Cannot be the same as last  8                                                       
            //7=Cannot be the same as last  6                                                       
            //8=Cannot be the same as last  4                                                       
                                                                                                    
              select;                                                                               
                when value = '1';                                                                   
                numberrequired = 32;                                                                
                when value = '2';                                                                   
                numberrequired = 24;                                                                
                when value = '3';                                                                   
                numberrequired = 18;                                                                
                when value = '4';                                                                   
                numberrequired = 12;                                                                
                when value = '5';                                                                   
                numberRequired = 10;                                                                
                when value = '6';                                                                   
                numberRequired = 8;                                                                 
                when value = '7';                                                                   
                numberRequired = 6;                                                                 
                when value = '8';                                                                   
                numberRequired = 4;                                                                 
              endsl;                                                                                
                                                                                                    
                                                                                                    
             w_SysVal = 'QPWDMINLEN';                                                               
             QWCRSVAL(w_Rcvr :                                                                      
                      w_RcvrLngth :                                                                 
                      w_NbrToRtv :                                                                  
                      w_SysVal :                                                                    
                      ds_Error );                                                                   
                                                                                                    
             DS_SysValTbl = w_Rcvr;                                                                 
                                                                                                    
               // this system value is actually in binary...                                        
                                                                                                    
               if d_ValType = 'B';                                                                  
                Whole9Yards =                                                                       
                   %subst(d_Data:1:d_DtaLngth);                                                     
               endif;                                                                               
                                                                                                    
             endsr;                                                                                 
                                                                                                    
      /End-Free                                                                                     
                                                                                                    
     OQSYSPRT   E            HEAD           1 03                                                    
     O                                           10 'workpass'                                      
     O                                           30 'error'                                         
     O                                           45 'Password'                                      
                                                                                                    
     O          E            DETAIL         1                                                       
     O                       workpass            20                                                 
     O                       ErrorId             30                                                 
     O                       newpass             45                                                 

User Comments

Please login or register to add comments

<Previous   Next>