【AS400系列】通过程序例子说明检查AS400用户密码的API-QSYGETPH

A*%%TS  SD  20130903  154540  XXXZL       REL-V5R3M0  5722-WDS
A*%%EC
A                                      DSPSIZ(24 80 *DS3)
A          R @@BODY
A*%%TS  SD  20130903  154540  XXXZL       REL-V5R3M0  5722-WDS
A                                      CA03(03 'Exit')
A                                  7 10'Please Enter Your UserName and Use-
A                                      rPassword:'
A                                      COLOR(WHT)
A                                 14 10'F3=Exit'
A                                      COLOR(BLU)
A                                  9 27'UserName    :'
A                                      COLOR(TRQ)
A                                 10 27'UserPassword:'
A                                      COLOR(TRQ)
A            FLD001        10A  B  9 41
A            FLD002        10A  B 10 41DSPATR(ND)
A                                      DSPATR(UL)
A            FLD003        60A  O 12 10COLOR(RED)

H* ------------------------------------------------------------------------
* MEMBER   : XXCHKPWDRI
* AUTHOR   : XIAOZL
* DESCRIBE : XX - Check User Login Password
* DATE     : 2013-09-03
H* ------------------------------------------------------------------------
HNOMAIN DATFMT(*ISO)
*
D/DEFINE XXCHKPWDR
D/COPY XXXZL2/QRPGSRC,XXCHKPWDRT
*
P XXCHKPWDR       B                   EXPORT
D XXCHKPWDR       PI             7A
D iChkPswPrf                    10A   VALUE
D iChkUsrPrf                    10A   VALUE
D XXCHKPWDR       PR             7A
D iChkPswPrf                    10A   VALUE
D iChkUsrPrf                    10A   VALUE
*
D dApiRtnDDS      DS
D  sArtPrvSiz                   10I 0 INZ(%SIZE(dApiRtnDDS))
D  sArtAvlSiz                   10I 0
D  sArtRtnCod                    7A
D                                1A
D  sArtMsgDta                  128A
*
D oChkRtnCod      S              7A
D wChkUsrPrf      S             10A
D wChkPrfHdl      S             12A
D wChkPwdLen      S             10I 0
D wChkPwdCid      S             10I 0
*
C                   EVAL      wChkUsrPrf = iChkUsrPrf
C                   EVAL      wChkPwdLen = %LEN(%TRIM(iChkPswPrf))
C                   EVAL      wChkPwdCid = 0
*
C                   CALL      'QSYGETPH'
C                   PARM                    wChkUsrPrf
C                   PARM                    iChkPswPrf
C                   PARM                    wChkPrfHdl
C                   PARM                    dApiRtnDDS
C                   PARM                    wChkPwdLen
C                   PARM                    wChkPwdCid
*
C                   IF        sArtRtnCod <> *BLANK
C                   EVAL      oChkRtnCod = sArtRtnCod
C                   RETURN    sArtRtnCod
C                   ELSE
C                   EVAL      oChkRtnCod = 'SUC0000'
C                   RETURN    sArtRtnCod
C                   ENDIF
*
P XXCHKPWDR       E

H* ------------------------------------------------------------------------
* MEMBER   : XXCHKPWDRI
* AUTHOR   : XIAOZL
* DESCRIBE : XX - Check User Login Password
* DATE     : 2013-09-03
H* ------------------------------------------------------------------------
HDATFMT(*ISO)
FXXCHKPWDR@CF   E             WORKSTN
*
D/DEFINE XXCHKPWDR
D/COPY XXXZL2/QRPGSRC,XXCHKPWDRT
*
D*               SDS
D*wJobPgmNam              1     10
D*wJobUsrPrf            254    263
*
D wChkRtnCod      S              7A
*
C                   EVAL      FLD003 = *BLANK
C                   DOW       NOT *IN03
C                   EXFMT     @@BODY
*
C                   IF        FLD001 = *BLANK
C                   EVAL      FLD003 = 'Please Enter Your UserName!'
C                   ITER
C                   ENDIF
*
C                   IF        FLD002 = *BLANK
C                   EVAL      FLD003 = 'Please Enter Your UserPassword!'
C                   ITER
C                   ENDIF
*
C                   EVAL      wChkRtnCod = XXCHKPWDR(FLD002:FLD001)
C                   IF        wChkRtnCod <> *BLANK
C                   EVAL      FLD001 = *BLANK
C                   EVAL      FLD002 = *BLANK
C                   EVAL      FLD003 = 'Your UserName or UserPassword -
C                                      is Wrong!'
C                   ELSE
C                   EVAL      FLD001 = *BLANK
C                   EVAL      FLD002 = *BLANK
C                   EVAL      FLD003 = 'Thanks for Your Login!'
C                   ENDIF
*
C                   ENDDO
*
C                   EVAL      *INLR = *ON
C                   RETURN

* ------------------------------------------------------------------------
* MEMBER   : XXCHKPWDRT
* AUTHOR   : XIAOZL
* DESCRIBE : XX - Prototype Define for XXChkPwdRI
* DATE     : 2013-09-03
* ------------------------------------------------------------------------
/IF DEFINED(XX_XXChkPwdRT_COPYED)
/EOF
/ELSE
/DEFINE     XX_XXChkPwdRT_COPYED
/ENDIF
* ------------------------------------------------------------------------
D/IF DEFINED(XXChkPwdR)
D XXChkPwdR       PR             7A
D  iChkPswPrf                   10A   VALUE
D  iChkUsrPrf                   10A   VALUE
D/ENDIF