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