ClCCHGPWD01C < DBG400

<verbatim>
/* ************************************************************************** */
/* CCHGPWD01C: Change password - 8x20 hand-held scanner version               */
/* ************************************************************************** */
PGM
  DCL        VAR(&ERROR) TYPE(*CHAR) LEN(4) +
               VALUE(X'00000000')
  DCL        VAR(&PWDLEN) TYPE(*CHAR) LEN(4)
  DCL        VAR(&NEWPWDLEN) TYPE(*CHAR) LEN(4)
  DCL        VAR(&PWDCCSID) TYPE(*CHAR) LEN(4)
  DCL        VAR(&NEWPWCCSID) TYPE(*CHAR) LEN(4)
  DCL        VAR(&CCSID) TYPE(*DEC) LEN(5 0)
  DCL        VAR(&QCCSID) TYPE(*DEC) LEN(5 0)
  DCLF       FILE(CCHGPWD01D) RCDFMT(CHGPWD)
/* ************************************************************************** */
/* GLOBAL MESSAGE MONITOR                                                     */
/* ************************************************************************** */
  MONMSG     MSGID(CPF0000 RPG0000 QRG0000 RSF0000 +
               MCH0000) EXEC(GOTO CMDLBL(##ERROR))
  GOTO       CMDLBL(##NOERROR)
##ERROR:
  MOVDIAGMSG
  MONMSG     MSGID(CPF0000)
  RSNESCMSG
  MONMSG     MSGID(CPF0000)
  RETURN
##NOERROR:
/* ************************************************************************** */
/* MAINLINE:                                                                  */
/* ************************************************************************** */
  RTVJOBA    USER(&USRPRF)
  CHGVAR     VAR(%BIN(&PWDLEN)) VALUE(10)
  CHGVAR     VAR(%BIN(&NEWPWDLEN)) VALUE(10)
  RTVUSRPRF  USRPRF(&USRPRF) CCSID(&CCSID)
  RTVSYSVAL  SYSVAL(QCCSID) RTNVAR(&CCSID)
  IF         COND(&CCSID = -2) THEN(CHGVAR VAR(&CCSID) +
               VALUE(&QCCSID))
  CHGVAR     VAR(%BIN(&PWDCCSID)) VALUE(&CCSID)
  CHGVAR     VAR(%BIN(&NEWPWCCSID)) VALUE(&CCSID)
DISPLAY:
  IF         COND(&FEEDBACK *NE *BLANKS) THEN(CHGVAR +
               VAR(&DAFEEDBACK) VALUE(X'21'))
  ELSE       CMD(CHGVAR VAR(&DAFEEDBACK) VALUE(X'20'))
  SNDRCVF    RCDFMT(CHGPWD)
             CHGVAR     VAR(&FEEDBACK) VALUE(' ')
  IF         COND(&IN03) THEN(GOTO CMDLBL(ENDPGM))
  IF         COND(&PWD *EQ '          ') THEN(DO)
    CHGVAR     VAR(&FEEDBACK) VALUE('Enter old password.')
    GOTO       CMDLBL(DISPLAY)
  ENDDO
  IF         COND(&NEWPWD *EQ '          ') THEN(DO)
    CHGVAR     VAR(&FEEDBACK) VALUE('Enter new password.')
    GOTO       CMDLBL(DISPLAY)
  ENDDO
  IF         COND(&IN07) THEN(DO)
/* Change the password, using details provided                                */
    CALL       PGM(QSYCHGPW) PARM(&USRPRF &PWD &NEWPWD &ERROR +
                 &PWDLEN &PWDCCSID &NEWPWDLEN &NEWPWCCSID)
/* New password cannot be same as current password                            */
    MONMSG     MSGID(CPD2356) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('New password = old.')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Password does not meet password rules                                      */
    MONMSG     MSGID(CPF22C0) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Invalid new passwd.')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Password less than &1 characters                                           */
    MONMSG     MSGID(CPF22C2) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Password too short.')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Password matches one of 32 previous passwords.                             */
    MONMSG     MSGID(CPF22C4) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Passwd used before.')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Password contains one of the following: &1.                                */
    MONMSG     MSGID(CPF22C5) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Invalid char found.')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Password contains two numbers next to each other.                          */
    MONMSG     MSGID(CPF22C6) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Two nbrs together. ')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Password contains a character used more than once                          */
    MONMSG     MSGID(CPF22C7) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Chr used twice/more')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Same character in same position as previous password.                      */
    MONMSG     MSGID(CPF22C8) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Same chr/pos as b4.')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Password must contain a number.                                            */
    MONMSG     MSGID(CPF22C9) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Must have digit(s).')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Password contains a character repeated consecutively.                      */
    MONMSG     MSGID(CPF22D0) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Same ltrs together.')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Password cannot be same as user ID                                         */
    MONMSG     MSGID(CPF22D1) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Password = username')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Password not correct for user profile &1.                                  */
    MONMSG     MSGID(CPF22E2) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Old password wrong.')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* User profile &1 is disabled.                                               */
    MONMSG     MSGID(CPF22E3) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Profile disabled.  ')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Value &1 for new password not allowed.                                     */
    MONMSG     MSGID(CPF22F5) EXEC(DO)
      CHGVAR     VAR(&FEEDBACK) VALUE('Passwd not allowed.')
      GOTO       CMDLBL(DISPLAY)
    ENDDO
/* Drop the passwords ASAP                                                    */
    CHGVAR     VAR(&PWD) VALUE('          ')
    CHGVAR     VAR(&NEWPWD) VALUE('          ')
    GOTO       CMDLBL(ENDPGM)
  ENDDO
/* Finally run the user request                                               */
  GOTO       CMDLBL(DISPLAY)
ENDPGM:
  RETURN
ENDPGM
</verbatim>



-- Main.MartinRowe - 02 Oct 2008
This topic: DBG400 > SourceCodeList > ClSource > ClCCHGPWD01C
Topic revision: r1 - 02 Oct 2008 - 16:16:10 - MartinRowe
Copyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400? Send feedback