Verify User Password - CL/400 Program

Note: You need to have *SECOFR Special Authority to run this program

         *************** Beginning of data *************************************
0001.00              PGM
0002.00
0003.00              DCL        VAR(&USRPRF) TYPE(*CHAR) LEN(10)
0004.00              DCL        VAR(&HANDLE) TYPE(*CHAR) LEN(12)
0005.00              DCLF       FILE(QSYS/QADSPOBJ)
0006.00
0007.00              DCL        VAR(&HEX00) TYPE(*CHAR) LEN(1) VALUE(X'00')
0008.00
0009.00              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)
0010.00              DCL        VAR(&MSG) TYPE(*CHAR) LEN(256)
0011.00              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(256)
0012.00              DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)
0013.00              DCL        VAR(&MSGL) TYPE(*CHAR) LEN(10)
0014.00              DCL        VAR(&APIERR) TYPE(*CHAR) LEN(10)
0015.00              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0016.00
0017.00              DSPOBJD    OBJ(QSYS/*ALL) OBJTYPE(*USRPRF) +
0018.00                           OUTPUT(*OUTFILE) OUTFILE(QTEMP/QADSPOBJ)
0019.00              OVRDBF     FILE(QADSPOBJ) TOFILE(QTEMP/QADSPOBJ)
0020.00
0021.00  REREAD:     RCVF
0022.00              MONMSG     MSGID(CPF0864) EXEC(DO)
0023.00              RCVMSG     MSGTYPE(*EXCP)
0024.00              RETURN
0025.00              ENDDO
0026.00
0027.00              CHGVAR     VAR(&APIERR) VALUE(' ')
0028.00              CHGVAR     VAR(%SST(&APIERR 1 8)) +
0029.00                           VALUE(X'0000011000000000')
0030.00              CHGVAR     VAR(&USRPRF) VALUE(&ODOBNM)
0031.00              CALL       PGM(QSYGETPH) PARM(&USRPRF &USRPRF &HANDLE +
0032.00                           &APIERR)
0033.00              IF         COND(%SST(&APIERR 8 1) = &HEX00) THEN(DO)
0034.00              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('PROFILE +
0035.00                           NAME AND PASSWORD MATCH FOR USER: ' || +
0036.00                           &USRPRF)
0037.00              CHGVAR     VAR(&APIERR) VALUE(' ')
0038.00              CHGVAR     VAR(%SST(&APIERR 1 8)) +
0039.00                           VALUE(X'0000011000000000')
0040.00              CALL       PGM(QSYRLSPH) PARM(&HANDLE &APIERR)
0041.00              ENDDO
0042.00              GOTO       CMDLBL(REREAD)
0043.00
0044.00  ERROR:
0045.00  MSGD:       RCVMSG     MSGTYPE(*DIAG) MSG(&MSG) MSGDTA(&MSGDTA) +
0046.00                           MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGL)
0047.00              IF         COND(&MSGID *NE ' ') THEN(DO)
0048.00              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGL/&MSGF) +
0049.00                           MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
0050.00              GOTO       CMDLBL(MSGD)
0051.00              ENDDO
0052.00  MSGE:       RCVMSG     MSGTYPE(*EXCP) MSG(&MSG) MSGDTA(&MSGDTA) +
0053.00                           MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGL)
0054.00              IF         COND(&MSGID *NE ' ') THEN(SNDPGMMSG +
0055.00                           MSGID(&MSGID) MSGF(&MSGL/&MSGF) +
0056.00                           MSGDTA(&MSGDTA) MSGTYPE(*ESCAPE))
0057.00              ENDPGM