ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

Querying the password expiration date

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Querying the password expiration date

    I can see the password expiration interval, but is there a way to query the password expiration date or could someone tell me if it's stored in a table?

  • #2
    Re: Querying the password expiration date

    Hi prosportal

    Run the command:
    DSPUSRPRF USRPRF(*ALL) TYPE(*BASIC) OUTPUT(*OUTFILE) OUTFILE(QTEMP/JUNK)

    Qry the qtemp/junk file looking for the fields:
    UPPWCD
    UPEXPD

    That should get you most of the info you are looking for.

    Best of Luck
    GLS
    The problem with quotes on the internet is that it is hard to verify their authenticity.....Abraham Lincoln

    Comment


    • #3
      Re: Querying the password expiration date

      Originally posted by prosportal
      ...could someone tell me if it's stored in a table?
      Welcome to the forum!

      That particular question is an indication that you're somewhat familiar with at least one other platform, but not with this series of systems (the AS/400 line).

      This series doesn't store attributes of objects in files or tables. Things are defined as one type of 'object' or another, and methods are used to retrieve attribute values. A password expiration interval would be an attribute of a user profile object (object type '*USRPRF). The DSPUSRPRF command is one way to retrieve attributes of user profile objects and to route them according to the OUTPUT() parameter of the command.

      Names of commands generally take the form of verb-object. For this, "DSP" is for the verb 'display', and "USRPRF" is for the *USRPRF object type. So, if you know that a user profile exists that is named 'JULIUS', you could issue this command:
      Code:
      DSPUSRPRF JULIUS
      That would display the attributes of the *USRPRF object named 'JULIUS' on the local display device. The reason the output would go to a display device rather than to a printer or disk file is because the OUTPUT() parameter wasn't specified, so it took its default value. Default values can be seen by typing the command and pressing the <F4> key instead of <Enter>.

      You could issue the command this way:
      Code:
      DSPUSRPRF JULIUS OUTPUT(*OUTFILE)
      That would route the output to an output database file. The command would complain, though, because it's necessary also to provide a name for the file to use:
      Code:
      DSPUSRPRF JULIUS OUTPUT(*OUTFILE) OUTFILE(QTEMP/JUNK)
      That shows a library-qualified file name, where QTEMP is the library and JUNK is the intended file name. (QTEMP is a temporary library that is created for every job, and is destroyed when the job ends. Anything that gets put into it will automatically go away at end of job, e.g., when you sign off.)

      Some 'special values' can be used for various command parameters. When you prompt a command with <F4>, the allowed values are shown to you. You could find find out that this is possible:
      Code:
      DSPUSRPRF *ALL OUTPUT(*OUTFILE) OUTFILE(QTEMP/JUNK)
      You are allowed to specify "*ALL" instead of a single profile name. That will retrieve attributes of all profiles you're authorized to see and place their attributes into QTEMP/JUNK. The attributes aren't stored by the system in a file, but many object types have similar methods to extract attributes into files.

      The simplest way to see records from a file is probably to use the RUNQRY command:
      Code:
      DSPUSRPRF JULIUS OUTPUT(*OUTFILE) OUTFILE(QTEMP/JUNK)
      RUNQRY *N QTEMP/JUNK
      Parameters can be specified in two general ways, by name or by position. That shows two parameters specified positionally. The "*N" indicates a missing positional parameter that is intended to provide the name of a named query. Since there was no query that was previously created and saved, the command can skip over it to get to the name of the file to be queried. The names of the parameters are left off, so the position is what determines what the values indicate. (The earlier DSPUSRPRF command mixed positional and named parameters when 'JULIUS' was supplied for the unnamed USRPRF() parameter.) The RUNQRY command could be specified this way:
      Code:
      RUNQRY QRYFILE(QTEMP/JUNK)
      Since all needed parameter values are specifically named in that example, there's no need for a positional placeholder.

      Note that the command could also be specified this way:
      Code:
      runqry *n qtemp/junk
      In general, upper- or lower-case isn't relevant unless a quoted value is called for. Usually you'll know when case is meaningful.

      The use of <F4> for prompting lets you see all potential parameters for a command. By moving the cursor to some area of the screen and pressing <F1>, you can see any 'Help' text that is associated with wherever the cursor is placed. Use <F1> on essentially any screen supplied by the system whenever you want to know more about anything you see. (In-house applications should also support <F1>, but that's up to the developers.) The <F4> and <F1> keys should be the two most used keys for you for some time to come. Make them a habit until you feel more comfortable and start learning shortcuts or until you start creating your own scripts and extensions. You might also use them to learn about other F-keys that will be available for different panels.

      All of that's probably more than you wanted to know, but it'll apply to just about everything you do on the system for as long as you're involved with it. Many future questions will possibly relate back to one part or another of this.
      Tom

      There are only two hard things in Computer Science: cache invalidation, naming things and off-by-one errors.

      Why is it that all of the instruments seeking intelligent life in the universe are pointed away from Earth?

      Comment


      • #4
        Re: Querying the password expiration date

        Wow Tom -- excellent write up!!

        here is a procedure that used the API -QSYRUSRI
        You would most likely have to create an authorization list to use this as profiles should be secured.

        PHP Code:
             H NOMAIN EXPROPTS(*RESDECPOS)                                                                  
              * 
        Beginning of procedure                                                                      
                                                                                                            
              
        /COPY QSECURESRC,USRDATA_CP                                                                   
                                                                                                            
             P usrdata         B                   EXPORT                                                   
                                                                                                            
              
        *------------------------------------------------                                             
              **  
        E N T R Y   P A R M S                      **                                             
              *------------------------------------------------                                             
                                                                                                            
             
        d usrdata         pi          1000                                                             
             d  inUser                       10a   
        const                                                    
                                                                                                            
             
        d $GetUsrInf      PR                  ExtPgm('QSYRUSRI')                                       
             
        d   RcvVar                      53                                                             
             d   RcvVarLen                   10i 0                                                          
             d   Format                       8    
        const                                                    
             
        d   UserPrf                     10    const                                                    
             
        d   Error                        1    const                                                    
                                                                                                            
             
        d QWCCVTDT        pr                  ExtPgm('QWCCVTDT')                                       
             
        d   infmt                       10a   const                                                    
             
        d   invar                       65a   const options(*varsize)                                  
             
        d   outfmt                      10a   const                                                    
             
        d   outvar                      65a   options(*varsize)                                        
             
        d   ErrCode                  32767a   options(*varsize)                                        
                                                                                                            
             
        d ErrorCode       ds                  qualified                                                
             d   BytesProv                   10i 0 inz
        (0)                                                   
             
        d   BytesAvail                  10i 0 inz(0)                                                   
                                                                                                            
             
        d YYMD            DS                  qualified                                                
             d   date                         8a                                                            
             d   time                         6a                                                            
             d   milli                        3a                                                            
                                                                                                            
             d count           s              2  0 inz                                                      
             d isodate         s               d                                                            
             d VarLength       s             10i 0 inz
        (1000)                                                
                                                                                                            
              /
        free                                                                                         
                                                                                                            
               clear profiledata
        .Suppgroups;                                                                
               
        $GetUsrInf(ProfileData:VarLength:'USRI0300':INUSER:' ');                                     
                                                                                                            
               
        // fix supplemental groups using PROFILEDATA.NUMBSUPGRPS                                     
               
        for count 1 to 13;                                                                         
                if 
        count PROFILEDATA.NUMBSUPGRPS;                                                         
                 
        profiledata.Suppgroups(count) = *blanks;                                                   
                endif;                                                                                      
               endfor;                                                                                      
                                                                                                            
               
        QWCCVTDT'*DTS'                                                                             
                         
        profiledata.PWExpDate                                                            
                         
        '*YYMD'                                                                          
                         
        YYMD                                                                             
                         
        ErrorCode );                                                                     
                                                                                                            
               
        ISodate = %date(YYMD.date:*iso0);                                                            
               
        profiledata.PWExpDate = %editc(%dec(Isodate:*iso):'X');                                      
                                                                                                            
               
        QWCCVTDT'*DTS'                                                                             
                         
        profiledata.PWChageDate                                                          
                         
        '*YYMD'                                                                          
                         
        YYMD                                                                             
                         
        ErrorCode );                                                                     
                                                                                                            
               
        ISodate = %date(YYMD.date:*iso0);                                                            
               
        profiledata.PWChageDate = %editc(%dec(Isodate:*iso):'X');                                    
                                                                                                            
               return  
        ProfileData;                                                                         
                                                                                                            
              /
        end-free                                                                                     
                                                                                                            
             P usrdata         E 
        The copy book
        PHP Code:
                                                                                                            
              
        USRDATA_CP Get user profile information                                                   
                                                                                                            
             d USRDATA         pr          1000                                                             
             d  inUser                       10a   
        const                                                    
                                                                                                            
             **-- 
        UserProfile Data                                                                          
             d ProfileData     ds                  Qualified                                                
             d  BytesReturned                10i 0                                                          
             d  BytesAvail                   10i 0                                                          
             d  Profile                      10a                                                            
             d  PreviousSO                   13a                                                            
             d  Reserved1                     1a                                                            
             d  InvalidSO
        #                   10i 0                                                          
             
        d  Status                       10a                                                            
             d  PWChageDate                   8a                                                            
             d  NoPassword                    1a                                                            
             d  Reserved2                     1a                                                            
             d  PWExpInt                     10i 0                                                          
             d  PWExpDate                     8a                                                            
             d  PWDaysToEXP                  10i 0                                                          
             d  SetPW2Exp                     1a                                                            
             d  UserClass                    10a                                                            
             d  SpecialAuth                  15a                                                            
             d  GroupProfile                 10a                                                            
             d  Owner                        10a                                                            
             d  GrpAuthority                 10a                                                            
             d  AssitanceLevl                10a                                                            
             d  CurrentLib                   10a                                                            
             d  InitalMenu                   10a                                                            
             d  InitalMenuLib                10a                                                            
             d  InitalPgm                    10a                                                            
             d  InitalPgmLib                 10a                                                            
             d  LimitCap                     10a                                                            
             d  TextDesc                     50a                                                            
             d  DspSignOnInf                 10a                                                            
             d  LimitSessions                10a                                                            
             d  KeyBoardBuff                 10a                                                            
             d  Reserved3                     2a                                                            
             d  MaxStorage                   10i 0                                                          
             d  StorageUsed                  10i 0                                                          
             d  HighestSchd                   1a                                                            
             d  JobDesc                      10a                                                            
             d  JobDescLib                   10a                                                            
             d  AccountCode                  15a                                                            
             d  MsgQ                         10a                                                            
             d  MsgqLib                      10a                                                            
             d  MsgqDelv                     10a                                                            
             d  Reserved4                     2a                                                            
             d  MsgqSev                      10i 0                                                          
             d  OutQ                         10a                                                            
             d  OutqLib                      10a                                                            
             d  PrintDev                     10a                                                            
             d  SpecialEnv                   10a                                                            
             d  AttnPgm                      10a                                                            
             d  AttnPgmLib                   10a                                                            
             d  Language                     10a                                                            
             d  Country                      10a                                                            
             d  CharCode                     10i 0                                                          
             d  UserOpts                     36a                                                            
             d  SortSeqTbl                   10a                                                            
             d  SortSeqTblLib                10a                                                            
             d  ObjectAudVal                 10a                                                            
             d  UserActAudLvl                64a                                                            
             d  GrpAuthType                  10a                                                            
             d  Offset2SupGrp                10i 0                                                          
             d  NumbSupGrps                  10i 0                                                          
             d  UserID
        #                      10i 0                                                          
             
        d  GroupID#                     10i 0                                                          
             
        d  OffsetHomeDir                10i 0                                                          
             d  LengthHomeDir                10i 0                                                          
             d  LocalJobAtrb                 16                                                             
             d  OffsetLocPath                10i 0                                                          
             d  LengthLocPath                10i 0                                                          
             d  GroupMbrInd                   1                                                             
             d  DigitalCert                   1                                                             
             d  CharIDCntrl                  10                                                             
             d  OffsetASPUsg                 10i 0                                                          
             d  NbrASPStgUsg                 10i 0                                                          
             d  NbrASPStgUsgD                10i 0                                                          
             d  LenASPStgUsgD                10i 0                                                          
             d  Reserved5                     2a                                                            
             d  MoreInfo                    500                                                             
             d  Thirty32paces                32    overlay
        (MoreInfo:1)                                      
             
        d  Suppgroups                   10    dim(15overlay(MoreInfo:*next

        here is stripped down version of program using it .. .
        I have a full modify profile application running but it would require some work stripping out
        company specific details.
        On the screen it shows next password change in days
        PHP Code:

             
        /copy qsecuresrc,usrdata_cp          

               
        //--------------------------------------------------------                                  
                // $loadsfl - load up the entire subfile                -                                   
                //--------------------------------------------------------                                  
                
        begsr $loadsfl;                                                                             
                                                                                                            
                 if  
        SavRrn  > *zeros;                                                                      
                  
        RRN  =  SavRrn;                                                                           
                  
        SCRRN =  SavRrn;                                                                          
                 endif;                                                                                     
                                                                                                            
                   
        read(nmsausera;                                                                        
                   
        dow not%eof(msausera);                                                                   
                                                                                                            
                    
        s1userid mauser;                                                                      
                    
        ProfileData usrdata(mauser);                                                          
                    if 
        ProfileData.BytesReturned > *zeros;                                                  
                     
        s1uname ProfileData.TextDesc;                                                        
                    endif;                                                                                  
                                                                                                            
                    
        s1status PROFILEDATA.STATUS;                                                          
                    
        s1outq PROFILEDATA.OUTQ;                                                              
                    
        h1outql PROFILEDATA.OUTQLIB;                                                          
                                                                                                            
                    
        h1msgL profiledata.msgqlib;                                                           
                    
        h1msgQ profiledata.msgq;                                                              
                                                                                                            
                    if 
        s1status '*DISABLED';                                                              
                     *
        in80 = *on;                                                                           
                     
        h1status 'D';                                                                        
                    endif;                                                                                  
                                                                                                            
                    
        //determine number of days until password change required                               
                    
        dec8 = %dec(profiledata.PWExpDate:8:0);                                                 
                    
        Isodate = %date(dec8:*iso);                                                             
                    
        monitor;                                                                                
                     
        s1days = %diff(Isodate:%date():*days);                                                 
                    
        on-error;                                                                               
                     
        s1days = *zeros;                                                                       
                    
        endmon;                                                                                 
                                                                                                            
                    
        setll (@USERmausermsagroupa;                                                        
                    if 
        AllAccess or ( Not(AllAccess) and  %equal(msagroupa));                               
                     if 
        OnlyDisabled = *off or                                                              
                        
        OnlyDisabled = *on and H1Status 'D';                                              
                      
        RRN += 1;                                                                             
                      
        SCRRN RRN;                                                                          
                      
        write SUB01;                                                                          
                     endif;                                                                                 
                    endif;                                                                                  
                                                                                                            
                    *
        in80 = *off;                                                                           
                    
        clear h1status;                                                                         
                                                                                                            
                    
        read(nmsausera;                                                                       
                   
        enddo;                                                                                   
                                                                                                            
                 *
        in33 = *on;                                                                               
                 
        savrrn SCRRN;                                                                            
                                                                                                            
                 
        //  If no records in subfile then do not disply the subfile.                               
                 
        if SavRrn = *zeros;                                                                        
                  *
        in31 = *off;                                                                             
                 else;                                                                                      
                  
        RRN  1;                                                                                 
                  
        SCRRN  1;                                                                               
                 endif;                                                                                     
                                                                                                            
                
        endsr
        All my answers were extracted from the "Big Dummy's Guide to the As400"
        and I take no responsibility for any of them.

        www.code400.com

        Comment


        • #5
          Re: Querying the password expiration date

          There also is a new view in tech refresh 7 QSYS2.USER_INFO as documented here.

          Jim

          Comment


          • #6
            Re: Querying the password expiration date

            Thanks Jim that is nice!! Don't see the QSYS2 View on V5R3 -- Do you know when it was added?


            Example


            Determine which users are having trouble signing on.
            PHP Code:
            SELECT FROM QSYS2.USER_INFO
              WHERE SIGN_ON_ATTEMPTS_NOT_VALID 


            Click image for larger version

Name:	USER_INFO example.jpg
Views:	1
Size:	89.1 KB
ID:	126750

            All my answers were extracted from the "Big Dummy's Guide to the As400"
            and I take no responsibility for any of them.

            www.code400.com

            Comment


            • #7
              Re: Querying the password expiration date

              Jamie, the User_Info view is only available on v7r1 TR7.

              What IBM is trying to do is provide many of the CL functions as a table functions, views or some other db2 object, but it is easy to build these functions yourself.

              PHP Code:
                    *====================================================================
                    *                                                                   |
                    *  
              Compile instructions:                                            |
                    *    
              CRTBNDRPG PGM(xxxxxxx/UDFUSRPRF)                               |
                    *              
              SRCFILE(xxxxxxx/QRPGLESRC)                           |
                    *              
              DBGVIEW(*SOURCE)                                     |
                    *                                                                   |
                    *     
              CREATE FUNCTION xxxxxxx.UDFUSRPRF (                           |
                    *     
              VARCHAR(10))                                                  |
                    *     
              RETURNS Table(USER_PROF Varchar(10),                          |
                    *                   
              ACCT_CODE Varchar(15),                          |
                    *                   
              STATUS Varchar(10),                             |
                    *                   
              LAST_LOGIN Timestamp,                           |
                    *                   
              EXPIREDATE Date,                                |
                    *                   
              USER_CLASS Varchar(10),                         |
                    *                   
              SPEC_AUT Varchar(88),                           |
                    *                   
              LIMIT_CAP Varchar(10))                          |
                    *     
              LANGUAGE RPGLE                                                |
                    *     
              SPECIFIC xxxxxxx.UDFUSRPRF                                    |
                    *     
              NOT DETERMINISTIC                                             |
                    *     
              NO SQL                                                        |
                    *     
              RETURNS NULL ON NULL INPUT                                    |
                    *     
              SCRATCHPAD 4                                                  |
                    *     
              NO EXTERNAL ACTION                                            |
                    *     
              EXTERNAL NAME 'xxxxxxx/UDFUSRPRF'                             |
                    *     
              PARAMETER STYLE SQL                                           |
                    *                                                                   |
                    *  
              DB2 function usage:                                              |
                    *    
              Select                                                         |
                    *    *                                                              |
                    *    
              From                                                           |
                    *    
              Table(xxxxxxx.UDFUSRPRF('MYPROFILE')) As A                     |
                    *                                                                   |
                    *====================================================================
                     
              ctl-opt dftactgrp(*noactgrp(*callermain($main);
                    /
              copy qsysinc/qrpglesrc,qsyrusri
                    
              /copy qsysinc/qrpglesrc,qusec

                     dcl
              -proc $main;
                     
              dcl-pi *n extpgm;
                    * 
              Input Parameters
                       pUserProfile varchar
              (10) const;
                    * 
              Output Parameters
                       UserProfile varchar
              (10);
                       
              AccountingCode varchar(15);
                       
              Status varchar(10);
                       
              LastLogin timestamp;
                       
              ExpireDate Date;
                       
              UserClass varchar(10);
                       
              SpecialAuthorities varchar(88);
                       
              LimitCapabilities varchar(10);
                    * 
              NULL Indicators
                       niinpUsrPrf int
              (5);
                       
              nioutUsrPrf int(5);
                       
              nioutAcctCde int(5);
                       
              nioutStatus int(5);
                       
              nioutLastLogin int(5);
                       
              niExpireDate int(5);
                       
              nioutUserCls int(5);
                       
              nioutSpecAut int(5);
                       
              nioutLimitCap int(5);
                    * 
              SQL Info
                       SQLState char
              (5);
                       
              FunctName varchar(517);
                       
              SpecName varchar(128);
                       
              SQLMsg varchar(70);
                       
              ScratchPad int(10);
                       
              CallType int(10);
                     
              end-pi;

                     
              dcl-pr CvtDate extpgm'QWCCVTDT' );
                       
              CvtInputFmt char(10);
                       
              CvtInputDate char(8);
                       
              CvtOutputFmt char(10);
                       
              CvtOutputDate char(26);
                       
              CvtAPIError char(272);
                     
              end-pr;

                    *  
              UDTF call parameter constants
                       dcl
              -s UDTF_FirstCall int(10inz(-2);
                       
              dcl-s UDTF_Open int(10inz(-1);
                       
              dcl-s UDTF_Fetch int(10inz(0);
                       
              dcl-s UDTF_Close int(10inz(1);
                       
              dcl-s UDTF_LastCall int(10inz(2);

                    *  
              SQL States
                       dcl
              -c SQLSTATEOK '00000';
                       
              dcl-c ENDOFTABLE '02000';
                       
              dcl-c UDTF_ERROR 'US001';
                       
              dcl-s FirstTime int(10);

                      
              dcl-ds dsQSYI0300 qualified;
                        
              dsIbm likedsQSYI0300 );
                      
              end-ds;

                      
              dcl-pr RtvUsrPrf extpgm('QSYRUSRI');
                        
              RcvVar char(32766options(*VarSize);
                        
              RcvVarLen int(10) const;
                        
              Format char(8) const;
                        
              UserID char(10) const;
                        
              ApiError likeds(dsErrorData);
                      
              end-pr;

                      
              dcl-ds dsErrorData qualified;
                        
              dsIbm likedsqusec );
                        
              dsMsgDta char(32766);
                      
              end-ds;

                      
              dcl-s NumericLL packed(26:0);

                      
              dcl-s InputFmt char(10inz('*DTS');
                      
              dcl-s InputDate char(8);
                      
              dcl-s OutputFmt char(10inz('*YYMD');
                      
              dcl-s OutputDate char(26);

                          
              Select;
                          
              When CallType UDTF_Fetch;
                            If 
              ScratchPad = *hival;
                              
              SqlState ENDOFTABLE;
                            Else;
                              
              ScratchPad = *hival;
                              
              RtvUsrPrfdsQSYI0300
                                       
              : %sizedsQSYI0300 )
                                       : 
              'USRI0300'
                                       
              pUserProfile
                                       
              dsErrorData );
                              If 
              dsErrorData.dsIbm.QUSBAVL <> 0;
                                
              SQLStateUDTF_Error;
                                
              SQLMsg 'Error retrieving User Profile';
                                *
              inlr=*on;
                              Else;
                                
              UserProfile dsQSYI0300.dsIbm.QSYUP03;
                                
              AccountingCode dsQSYI0300.dsIbm.QSYAC;
                                
              Status dsQSYI0300.dsIbm.QSYUS02;
                                
              UserClass dsQSYI0300.dsIbm.QSYUC00;
                                
              LimitCapabilities dsQSYI0300.dsIbm.QSYLC00;
                                
              InputDate dsQSYI0300.dsIbm.QSYPD03;

                                
              CvtDateInputFmt
                                       
              InputDate
                                       
              OutputFmt
                                       
              OutputDate
                                       
              dsErrorData );

                                
              ExpireDate = %date(%timestamp(OutputDate:*ISO0));

                                If 
              dsQSYI0300.dsIbm.QSYAOBJ01 'Y';
                                  
              SpecialAuthorities += '*ALLOBJ ';
                                EndIf;
                                If 
              dsQSYI0300.dsIbm.QSYSA05 'Y';
                                  
              SpecialAuthorities += '*SECADM ';
                                EndIf;
                                If 
              dsQSYI0300.dsIbm.QSYJC01 'Y';
                                  
              SpecialAuthorities += '*JOBCTL ';
                                EndIf;
                                If 
              dsQSYI0300.dsIbm.QSYSC01 'Y';
                                  
              SpecialAuthorities += '*SPLCTL ';
                                EndIf;
                                If 
              dsQSYI0300.dsIbm.QSYSS02 'Y';
                                  
              SpecialAuthorities += '*SAVSYS ';
                                EndIf;
                                If 
              dsQSYI0300.dsIbm.QSYRVICE01 'Y';
                                  
              SpecialAuthorities += '*SERVICE ';
                                EndIf;
                                If 
              dsQSYI0300.dsIbm.QSYAUDIT01 'Y';
                                  
              SpecialAuthorities += '*AUDIT ';
                                EndIf;
                                If 
              dsQSYI0300.dsIbm.QSYISC01 'Y';
                                  
              SpecialAuthorities += '*IOSYSCFG ';
                                EndIf;
                                
              SpecialAuthorities = %trim(SpecialAuthorities);
                                If 
              dsQSYI0300.dsIbm.QSYPS00 <> *blanks;
                                  
              monitor;
                                  
              NumericLL = (%dec(dsQSYI0300.dsIbm.QSYPS00:15:0)+
                                               
              19000000000000)*1000000;
                                  
              on-error *all;
                                    
              LastLogin = *loval;
                                    
              nioutLastLogin = -1;
                                    return;
                                  
              endmon;
                                  
              Test(ez) *ISO NumericLL;
                                  If 
              not %error;
                                    
              LastLogin = %timestamp(NumericLL);
                                  Else;
                                    
              LastLogin = *loval;
                                    
              nioutLastLogin = -1;
                                  EndIf;
                                Else;
                                  
              LastLogin = *loval;
                                EndIf;
                              EndIF;
                            EndIf;

                          
              When CallType=UDTF_Close;
                            
              UserProfile = *blanks;
                            
              AccountingCode = *blanks;
                            
              Status = *blanks;
                            
              LastLogin = *loval;
                            
              UserClass = *blanks;
                            
              SpecialAuthorities = *blanks;
                            
              LimitCapabilities = *blanks;
                            *
              inlr=*on;
                        
              EndSl;
                        return;

                     
              end-proc
              Outputs:

              MYPROFILE MYPROFILE *ENABLED 2014-04-12 17:08:46.0 2014-05-28 *SECOFR *ALLOBJ *SECADM *JOBCTL *SPLCTL *SAVSYS *SERVICE *IOSYSCFG *NO
              Oh and can I say how much I like the new RPG format? It feels so much more natural.

              Jim
              Last edited by Jim_IT; April 12, 2014, 07:58 PM.

              Comment


              • #8
                Re: Querying the password expiration date

                Another simple example of retrieving a Password Expiration Interval attribute from a supplied user profile name, this time in CL:
                Code:
                /* +
                   Retrieve a *USRPRF Password Expiration Interval.                     +
                     Parms:                                                             +
                        In:   &p_UsrPrf    User to retrieve value for                   +
                                                                                        +
                   Retrieves the PwdExpItv value for the given user, creates a message  +
                   format, places user ID and expiration interval into the message data +
                   buffer and sends the formatted message.                              +
                                                                                        +
                   The RTVUSRPRF command returns the value as packed numeric, but there +
                   is no "packed" data type for message data types. We convert it to    +
                   integer (binary) just to make it a little easier to get the value    +
                   into the buffer. The %BIN() function works between *INT and *CHAR    +
                   variable declarations.                                               +
                */
                
                pgm    ( +
                         &p_UsrPrf    +
                       )
                
                   dcl   &p_UsrPrf    *char    10
                
                
                   dcl   &pwdExpItv   *dec  (   5 0 )              /* Required definition */
                
                   dcl   &genMsgTxt   *char    50
                   dcl   &genMsgInt   *int
                
                
                   /* Ignore any 'MsgF exists' and 'MsgD exists' errors */
                   /*   in case we call this program more then once in  */
                   /*   the same job.                                   */
                
                   monmsg    ( cpf2112 cpf2412 )
                
                
                   rtvusrprf   &p_UsrPrf  pwdexpitv( &pwdExpItv )  /* Get PwdExpItv for user */
                
                   callsubr    CrtTmpMsgD                          /* Create temp msg file */
                
                   /* Put values into message data buffer */
                   chgvar               &genMsgTxt                        &p_UsrPrf
                   /* Convert packed->int to use the %BIN() function */
                   chgvar               &genMsgInt                        &pwdExpItv
                   chgvar         %bin( &genMsgTxt  11 4 )                &genMsgInt
                
                   /* Send a message to previous level */
                   sndpgmmsg   msgid( gen0001 ) msgf( QTEMP/GenMsgF ) msgdta( &genMsgTxt )
                
                   return
                
                
                /* Subroutine just gets these statements out of the way */
                /*   If this kind of message would be used often or in  */
                /*   multiple programs, we should create a message      */
                /*   description in some permanent MsgF and use that    */
                /*   MsgD instead of this temporary one.                */
                
                subr   CrtTmpMsgD
                
                   /* Create a temporary message file */
                   crtmsgf     QTEMP/GenMsgF
                
                   /* Add a message description to the temp MsgF */
                   addmsgd     gen0001  msgf( QTEMP/GENMSGF ) +
                                 msg( 'User &1 password expires in &2 days.') +
                                 fmt( (*CHAR 10) (*BIN 4) )
                
                   rtnsubr rtnval( 0 )
                
                endsubr
                
                endpgm
                It's written with a minor need for at least V5R4 because it (unnecessarily) uses a simple subroutine that could easily be placed in-line, and needs at least V5R3 for the *INT data type (which could be reworked into a *CHAR (4)). But it's a sample of programming in the system Control Language (CL) and might be useful to a new member.

                Next would be discussionss on what to do with source code in any language.
                Tom

                There are only two hard things in Computer Science: cache invalidation, naming things and off-by-one errors.

                Why is it that all of the instruments seeking intelligent life in the universe are pointed away from Earth?

                Comment


                • #9
                  Re: Querying the password expiration date

                  Even though I agree using an system API is more elegant ...
                  But if it's an CL command with an output file, there is an easier way creating a UDTF by using the SQL programming language:

                  Code:
                  CREATE FUNCTION MySchema/DSPUSRPRF_FNC (PARUSER VARCHAR(10) ) 
                  	RETURNS TABLE ( USRPRF CHAR(10) ,
                                          ... List all output table columns with their definitions 
                                         )   
                  	LANGUAGE SQL 
                  	NOT DETERMINISTIC 
                  	MODIFIES SQL DATA 
                  	CALLED ON NULL INPUT 
                  	NOT FENCED 
                  	SET OPTION  COMMIT = *NONE , 
                  	            DBGVIEW = *SOURCE 
                  BEGIN 
                     DECLARE CLCMD VARCHAR ( 256 ) NOT NULL DEFAULT '' ;
                   
                      -- you may add some error handling here
                  
                      -- Create and execute the CL command
                      SET CLCMD = 'DSPUSRPRF USRPRF(' CONCAT UPPER(TRIM(PARUSER)) CONCAT ') ' CONCAT 
                                          ' OUTPUT(*OUTFILE) '            CONCAT  
                                          ' OUTFILE(QTEMP/TMPUSRPRF) '    CONCAT 
                                          ' OUTMBR(*FIRST *REPLACE) ' ; 
                     
                      CALL QCMDEXC ( CLCMD , LENGTH ( CLCMD ) ) ; 
                  
                     -- Return the output table
                     RETURN SELECT UPUPRF, ... List all columns to be selected from the TMPUSRPRF file 
                                               (must match (number/data type) with the output columns 
                                                specified after TABLE()  
                              FROM QTEMP / TMPUSRPRF ; 
                  END  ;
                  The UDTF will be called as follows:
                  Code:
                  Select * From Table(DSPURSPRF_Fnc('*ALL')) x;
                  Select * From Table(DSPUSRPRF_Fnc('HAUSER')) x;
                  Select * From Table(DSPURSPRF_Fnc('HA*')) x;
                  BTW the QCMDEXC Stored Procedure was not introduced before Release V5R4.
                  Before release V5R4 you may declare the SQL command string with fixed length, e.g. CHAR(256)
                  and call the QCMDEXC program as follows:
                  Code:
                  CALL QCMDEXC(CLCMD, 0000000256.00000);
                  And ... beginning with Release 7.1 TR7, specifying the length for the QCMDEXC command is no longer required.

                  Birgitta
                  Last edited by B.Hauser; April 13, 2014, 01:23 AM.

                  Comment

                  Working...
                  X