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

#chkpwdfm.dspf

     A                                      DSPSIZ(27 132 *DS4)
     A                                      CHGINPDFT
     A*********************************************************************
     A*  DUMMY RECORD FORMAT CREATED BECAUSE 'ASSUME' KEYWORD SPECIFIED   *
     A*********************************************************************
     A          R XDUMYFMT
     A                                      ASSUME
     A                                  1  2' '
     A*********************************************************************
     A          R SCR001                    WINDOW(6 36  9 50)
     A                                      OVERLAY
     A                                      CLRL(*NO)
     A                                      CA03(03 'EXIT')
     A                                      CA12(12 'EXIT')
     A                                      WDWBORDER((*COLOR BLU) +
     A                                      (*DSPATR RI)           +
     A                                      (*CHAR '        '))
     A                                  2  2'用戶密碼檢查'
     A                                      COLOR(WHT)
     A                                  3  3'User....:'
     A            FLD001        10A  B    +1
     A                                      DSPATR(UL)
     A  40                                  DSPATR(PR)
     A                                  4  3'Password:'
     A            FLD002        10A  B    +1DSPATR(ND)
     A                                      DSPATR(UL)
     A                                  6  3'F3=EXIT'
     A                                      COLOR(BLU)
     A            FLD003        38O  B  7  3COLOR(RED)

#chkpwd.rpgle

     H             DEBUG(*YES)
     HDATFMT(*MDY) DATEDIT(*MDY)
     F********************************************************************
     F* Copyright 2008 Kin Yat Industrial Company Ltd All Rights Reserved
     F********************************************************************
     F*
     F*  Program ID          -    #CHKPWD
     F*  Application ID      -    #CHKPWD
     F*  Application Name    -    Check Password
     F*  Date Generated      -    2015.06.12
     F*  CREATED   By         -   David Zhao
     F*
     F*****************************************************************
     F#CHKPWDFM CF   E             WORKSTN
     F                                     INFDS(DSPFDS)
     D********************************************************************
     D                SDS
     D PROC_NAME         *PROC
     D JOB                   244    253
     D USER                  254    263
     D*
     D*  INFDS for cursor location
     D*
     D DSPFDS          DS
     D  ROWCOL               370    371B 0
     D  ROW                  370    370
     D  COL                  371    371
     D  SFLRRN               378    379B 0
     D*
     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 iChkPswPrf      S             10A
     D wChkUsrPrf      S             10A
     D wChkPrfHdl      S             12A
     D wChkPwdLen      S             10I 0
     D wChkPwdCid      S             10I 0
     D*
     C********************************************************************
     C* Key List
     C********************************************************************
     C*
     C*
     C********************************************************************
     C* Parameter List
     C********************************************************************
     C*
     C     *ENTRY        PLIST
     C                   PARM                    @USR             10
     C                   PARM                    @FLG              1
     C                   PARM                    @MSG              7
     C*
     C********************************************************************
     C* Main Procedure
     C********************************************************************
     C                   EXSR      INIT
     C*
     C                   EXSR      SCNA
     C*
     C                   EXSR      TRMP
     C********************************************************************
     C* Initial
     C********************************************************************
     C     INIT          BEGSR
     C*
     C                   MOVEL(P)  @USR          FLD001
     C                   MOVE      *BLANKS       FLD002
     C                   MOVE      *BLANKS       FLD003
     C                   MOVE      '9'           @FLG
     C                   MOVE      *BLANKS       @MSG
     C*
     C     @USR          IFEQ      *BLANKS
     C                   SETOFF                                       40
     C                   ELSE
     C                   SETON                                        40
     C                   ENDIF
     C*
     C*
     C                   ENDSR
     C********************************************************************
     C* Screen A
     C********************************************************************
     C     SCNA          BEGSR
     C*
     C     '0'           DOWEQ     '0'
     C                   EXFMT     SCR001
     C*
     C                   SELECT
     C* Exit
     C     *INKC         WHENEQ    *ON
     C     *INKL         OREQ      *ON
     C                   GOTO      XSCNA
     C*
     C                   OTHER
     C* Enter
     C                   EXSR      VALA
     C*
     C  N90              GOTO      XSCNA
     C*
     C                   ENDSL
     C*
     C                   ENDDO
     C*
     C     XSCNA         ENDSR
     C********************************************************************
     C* Validation A
     C********************************************************************
     C     VALA          BEGSR
     C*
     C                   SETON                                        90
     C                   MOVE      *BLANKS       FLD003
     C*
     C     FLD001        IFEQ      *BLANKS
     C                   EVAL      FLD003 = '用戶不能為空!'
     C                   LEAVESR
     C                   ENDIF
     C     FLD002        IFEQ      *BLANKS
     C                   EVAL      FLD003 = '密碼不能為空!'
     C                   LEAVESR
     C                   ENDIF
     C*
     C                   EVAL      wChkUsrPrf = FLD001
     C                   EVAL      iChkPswPrf = FLD002
     C                   EVAL      wChkPwdLen = %LEN(%TRIM(FLD002))
     C                   EVAL      wChkPwdCid = 0
     C                   EVAL      sArtRtnCod = *BLANK
      *
     C                   CALL      'QSYGETPH'
     C                   PARM                    wChkUsrPrf
     C                   PARM                    iChkPswPrf
     C                   PARM                    wChkPrfHdl
     C                   PARM                    dApiRtnDDS
     C                   PARM                    wChkPwdLen
     C                   PARM                    wChkPwdCid
      *
     C                   EVAL      @MSG       = sArtRtnCod
     C                   EVAL      @USR       = FLD001
      *
     C                   IF        sArtRtnCod = *BLANK
      *Successful
     C                   MOVE      '0'           @FLG
     C                   SETOFF                                       90
     C*
     C                   ENDIF
     C*
     C   90              EVAL      FLD003 = '用戶密碼錯誤！'
     C*
     C     XVALA         ENDSR
     C********************************************************************
     C* Program End
     C********************************************************************
     C     TRMP          BEGSR
     C*
     C*
     C                   MOVE      '1'           *INLR
     C                   RETURN
     C*
     C                   ENDSR
     C********************************************************************