CICS Application Programming Fundamentals 第8-9章
9. Verifying User Credentials
//JC$CRTQS JOB ,'CREATE QSAM ',CLASS=C,MSGCLASS=S,MSGLEVEL=(1,1), JOB00039
// REGION=4096K,TIME=1440,COND=((4,LT)),NOTIFY=&SYSUID
//*
//*!!! PLS DOUBLE CHECK AND REMARK THIS LINE TO SUBMIT
//*
//* DELETE OLD
//DELETE EXEC PGM=IEFBR14
//DELFILE DD DSN=PRDHKB.MM.MD.EREGUSR,
// DISP=(MOD,DELETE,DELETE),
// UNIT=SYSDA,
// VOL=SER=UAPP02
//* REPO DUMMY DATA
//DEFINE EXEC PGM=SORT
//SYSOUT DD SYSOUT=*
//SORTIN DD *
TESTUSR1PASS1 STDA20230625120000
TESTUSR2PASS2 MGRA20230625121500
TESTUSR3PASS3 ADMA20230625123000
TESTUSR4PASS4 STDD20230625123000
TESTUSR5PASS5 ADMA20450625123000
/*
//SORTOUT DD DSN=PRDHKB.MM.MD.EREGUSR,
// DISP=(NEW,CATLG,DELETE),
// UNIT=SYSDA,
// VOL=SER=UAPP02,
// SPACE=(CYL,(5,2),RLSE),
// DCB=(RECFM=FB,LRECL=100,BLKSIZE=0)
//SYSIN DD *
OPTION COPY
OUTREC FIELDS=(1,80,100:C' ')
/* //JC$CRTKS JOB ,'CREATE KSDS ',CLASS=C,MSGCLASS=S,MSGLEVEL=(1,1), JOB00040
// REGION=4096K,TIME=1440,COND=((4,LT)),NOTIFY=&SYSUID
//*
//*!!! PLS DOUBLE CHECK AND REMARK THIS LINE TO SUBMIT
//*
//* DEFINE KSDS
//TDINTRA EXEC PGM=IDCAMS
//SEEDDATA DD DISP=SHR,DSN=PRDHKB.MM.MD.EREGUSR
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
DELETE PRDHKO.MM.MD.EREGUSR CLUSTER ERASE PURGE
SET MAXCC = 0
DEFINE CLUSTER(NAME(PRDHKO.MM.MD.EREGUSR) -
INDEXED -
CYL(10 10) -
RECORDSIZE(100 100) -
KEYS(8 0) -
FREESPACE(0 20) -
SHAREOPTIONS(2 3) -
LOG(NONE) -
VOLUME(UAPP02) -
CISZ(4096)) -
DATA (NAME(PRDHKO.MM.MD.EREGUSR.DATA)) -
INDEX (NAME(PRDHKO.MM.MD.EREGUSR.INDEX))
IF LASTCC = 0 THEN -
REPRO INFILE(SEEDDATA) OUTDATASET(PRDHKO.MM.MD.EREGUSR)
IF LASTCC = 0 THEN -
LISTCAT ENTRIES(PRDHKO.MM.MD.EREGUSR) ALL
IF LASTCC = 0 THEN -
PRINT INDATASET(PRDHKO.MM.MD.EREGUSR)
/*
//* 05 CON-Sign-On-Map-Name pic x(08) value 'ESONM '.
05 CON-Sign-On-Mapset-Name pic x(08) value 'ESONMAP '.
05 CON-Registered-Users-Filename pic x(08) value 'EREGUSR'. Identification Division.
Program-Id. ESONP.
Data Division.
Working-Storage Section.
copy DFHAID.
copy DFHBMSCA.
copy ESONMAP.
01 Application-Constants.
copy ECONST.
01 Registered-User-Record.
copy EREGUSR.
01 W-Commarea.
05 W-UserId pic x(08).
05 W-Password pic x(08).
01 W-Resp pic s9(9) binary.
01 W-Current-Date.
05 W-YYYYMMDDHHMMSS pic x(14).
05 filler pic x(07).
01 W-Success-Message.
05 W-Success-UserId pic x(08).
05 filler pic x(30)
value ' successful sign no'.
01 W-Not-Found-Message.
05 W-Not-Found-UserId pic x(08).
05 filler pic x(30)
value ' is not in the file'.
01 W-Password-No-Match-Message.
05 filler pic x(08) value 'User Id '.
05 W-No-Match-UserId pic x(08).
05 filler pic x(30)
value ' passwords didn''t match'.
01 W-Not-Active-Message.
05 filler pic x(08) value 'User Id '.
05 W-Not-Active-UserId pic x(08).
05 filler pic x(30)
value ' is not active'.
01 W-Landing-Program-Error.
05 filler pic x(22)
value 'Error transferring to '.
05 W-Landing-Program-Name pic x(08).
05 filler pic x(10)
value '. EIBRESP='.
05 W-Landing-Error-EIBRESP pic 9(08).
05 filler pic x(11)
value '; EIBRESP2='.
05 W-Landing-Error-EIBRESP2 pic 9(08).
05 filler pic x value '.'.
01 W-Resp-Message.
05 filler pic x(08) value 'RIDFLD: '.
05 W-Show-RIDFLD pic x(08).
05 filler pic x(10) value ' W-Resp: '.
05 W-Show-W-Resp pic 9(09).
05 filler pic x(10) value ' EIBRESP: '.
05 W-Show-EIBRESP pic 9(09).
01 W-Status-Error.
05 filler pic x(40)
value 'Activity Monitor returned invalid value '.
05 filler pic x(23)
value 'for Signed-On-Status: <'.
05 W-Status-Error-Value pic x.
05 filler pic x(02) value '>.'.
01 W-General-Error.
05 W-General-Command pic x(30).
05 filler pic x(09) value ' EIBRESP='.
05 W-General-EIBRESP pic 9(09).
05 filler pic x(11) value ', EIBRESP2='.
05 W-General-EIBRESP2 pic 9(09).
linkage Section.
01 DFHCOMMAREA pic x(16).
Procedure Division.
if EIBCALEN equal zero
perform 0000-First-Time
else
perform 1000-Process-User-Input
end-if
.
0000-First-Time.
perform 0100-Initialize-Commarea
perform 0200-Initialize-Map
perform 9200-Send-and-Return
.
0100-Initialize-Commarea.
move spaces to W-Commarea
.
0200-Initialize-Map.
move low-values to ESONMO
.
1000-Process-User-Input.
move DFHCOMMAREA to W-Commarea
EXEC CICS RECEIVE
MAP(CON-Sign-On-Map-Name)
MAPSET(CON-Sign-On-Mapset-Name)
INTO(ESONMI)
END-EXEC
evaluate EIBAID
when DFHPF3
when DFHPF12
perform 2000-Cancel-Sign-On
when DFHENTER
perform 3000-Process-Sign-On-Request
when other
continue
end-evaluate
perform 9200-Send-and-Return
.
2000-Cancel-Sign-On.
EXEC CICS SEND CONTROL
FREEKB
ERASE
END-EXEC
EXEC CICS RETURN
END-EXEC
.
3000-Process-Sign-On-Request.
perform 3100-Set-UserId-and-Password
perform 3200-Check-Users-Status
perform 3300-Look-Up-UserId
.
3100-Set-UserId-and-Password.
if USERIDI equal low-values
or USERIDI equal spaces
continue
else
move USERIDI to W-UserId
end-if
if PASSWDI equal low-values
or PASSWDI equal spaces
continue
else
move PASSWDI to W-Password
end-if
.
3200-Check-Users-Status.
continue
.
3220-Notify-Activity-Monitor.
continue
.
3300-Look-Up-UserId.
EXEC CICS READ
FILE(CON-Registered-Users-Filename)
RIDFLD(W-UserId)
INTO(Registered-User-Record)
RESP(W-Resp)
END-EXEC
evaluate W-Resp
when DFHRESP(NORMAL)
perform 3400-Check-User-Credentials
when DFHRESP(NOTFND)
move W-UserId to W-Not-Found-UserId
move W-Not-Found-Message to MESSO
when other
move W-UserId to W-Show-RIDFLD
move W-Resp to W-Show-W-Resp
move EIBRESP to W-Show-EIBRESP
move W-Resp-Message to MESSO
end-evaluate
.
3400-Check-User-Credentials.
if W-Password equal Registered-Password
if ACTIVE
move function CURRENT-DATE to W-Current-Date
if W-Current-Date not less than
Last-Effective-Date-Time
perform 3220-Notify-Activity-Monitor
perform 9100-Transfer-to-Landing-Page
else
move W-UserId to W-Not-Active-UserId
move W-Not-Active-Message to MESSO
end-if
else
move W-UserId to W-Not-Active-UserId
move W-Not-Active-Message to MESSO
end-if
else
move W-UserId to W-No-Match-UserId
move W-Password-No-Match-Message to MESSO
end-if
.
9100-Transfer-to-Landing-Page.
move 'Successful sign on!' to W-General-Command
move W-General-Command to MESSO
perform 9200-Send-and-Return
.
9200-Send-and-Return.
move EIBTRNID to TRANIDO
move W-UserId to USERIDO
move W-Password to PASSWDO
EXEC CICS SEND
MAP(CON-Sign-On-Map-Name)
MAPSET(CON-Sign-On-Mapset-Name)
FROM(ESONMO)
ERASE
END-EXEC
EXEC CICS RETURN
TRANSID(EIBTRNID)
COMMAREA(W-Commarea)
LENGTH(length of W-Commarea)
END-EXEC
.