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

url: http://blog.chinaunix.net/uid-29091520-id-3883026.html

API参考：
http://publib.boulder.ibm.com/iseries/v5r1/ic2924/index.htm?info/apis/QSYGETPH.htm

源码 http://blog.chinaunix.net/blog/downLoad/fileid/8997.html

XXCHKPWDR@.DSPF

     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)

XXCHKPWDRI.RPGLE

     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

XXCHKPWDRP.RPGLE

     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

XXCHKPWDRT.RPGLE

      * ------------------------------------------------------------------------
      * 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