- The Sign-on Process
TRANS(HANC), PROG(HANCON), MAP(HANMAP)
註: 以下 MAP 和 PROG 內容並不全，由於原視頻跳過了
Cobol
000001 HANMAP DFHMSD MODE=INOUT, X
000002 CTRL=(FREEKB,FRSET), X
000003 CURSLOC=YES, X
000004 DSATTS=COLOR, X
000005 MAPATTS=(COLOR,HILIGHT), X
000006 STORAGE=AUTO, X
000007 LANG=COBOL, X
000008 TIOAPFX=YES, X
000009 TYPE=&SYSPARM
000010 HANM DFHMDI SIZE=(24,80),LINE=1,COLUMN=1
000011 DFHMDF POS=(1,27),LENGTH=24,ATTRB=(ASKIP,NORM), X
000012 INITIAL='Demo of HANDLE CONDITION'
000013 DFHMDF POS=(3,1),LENGTH=73,ATTRB=(ASKIP,NORM), X
000014 INITIAL='Program HANCON issues an EXEC CICS READ FILE coX
000015 mmand for file EREGUSR'
000016 DFHMDF POS=(4,1),LENGTH=45,ATTRB=(ASKIP,NORM), X
000017 INITIAL='with the following HANDLE commands in effect:'
000018 DFHMDF POS=(6,1),LENGTH=26,ATTRB=(ASKIP,NORM), X
000019 INITIAL='EXEC CICS HANDLE CONDITION'
000020 DFHMDF POS=(7,5),LENGTH=31,ATTRB=(ASKIP,NORM), X
000021 INITIAL='FILENOTFOUND(8100-FileNotFound)'
000022 DFHMDF POS=(16,1),LENGTH=70,ATTRB=(ASKIP,NORM), X
000023 INITIAL='Change the parameters below to elicit one of thX
000024 e exception conditions.'
000025 DFHMDF POS=(18,1),LENGTH=20,ATTRB=(ASKIP,NORM), X
000026 INITIAL='EXEC CICS READ FILE('
000027 FILENM DFHMDF POS=(18,22),LENGTH=8,ATTRB=(UNPROT,BRT,IC), X
000028 HILIGHT=UNDERLINE
000029 DFHMDF POS=(18,31),LENGTH=1,ATTRB=(ASKIP,NORM), X
000030 INITIAL=')'
000031 DFHMDF POS=(19,5),LENGTH=7,ATTRB=(ASKIP,NORM), X
000032 INITIAL='RIDFLD('
000033 RIDVAL DFHMDF POS=(19,13),LENGTH=8,ATTRB=(UNPROT,BRT), X
000034 HILIGHT=UNDERLINE
000035 DFHMDF POS=(19,22),LENGTH=1,ATTRB=(ASKIP,NORM), X
000036 INITIAL=')'
000037 DFHMDF POS=(20,5),LENGTH=7,ATTRB=(ASKIP,NORM), X
000038 INITIAL='LENGTH('
000039 LENVAL DFHMDF POS=(20,13),LENGTH=4,ATTRB=(UNPROT,BRT), X
000040 HILIGHT=UNDERLINE
000041 DFHMDF POS=(20,18),LENGTH=1,ATTRB=(ASKIP,NORM), X
000042 INITIAL=')'
000043 DFHMDF POS=(21,5),LENGTH=10,ATTRB=(ASKIP,NORM), X
000044 INITIAL='KEYLENGTH('
000045 KEYLEN DFHMDF POS=(21,16),LENGTH=4,ATTRB=(UNPROT,BRT), X
000046 HILIGHT=UNDERLINE
000047 DFHMDF POS=(21,21),LENGTH=1,ATTRB=(ASKIP,NORM), X
000048 INITIAL=')'
000049 DFHMDF POS=(23,1),LENGTH=7,ATTRB=(ASKIP,NORM), X
000050 INITIAL='Result:'
000051 RESULT DFHMDF POS=(23,9),LENGTH=50,ATTRB=(ASKIP,BRT)
000052 DFHMSD TYPE=FINAL
000053 END
****** ******************************** Bottom of Data ********************************
Cobol
****** ********************************* Top of Data **********************************
000001 Identification Division.
000002 Program-Id. HANCON.
000003 Data Division.
000004 Working-Storage Section.
000005 copy DFHAID.
000006 copy HANMAP.
000007 01 Parm-Variables.
000008 05 Parm-Filename pic x(08).
000009 05 Parm-Length pic s9(04) binary.
000010 05 Parm-Keylength pic s9(04) binary.
000011 05 Parm-Ridval pic x(08).
000012 01 Default-Values.
000013 05 Default-Filename pic x(08) value 'EREGUSR'.
000014 05 Default-Length pic s9(04) binary value +100.
000015 05 Default-Keylength pic s9(04) binary value +8.
000016 05 Default-Ridval pic x(08) value 'TESTUSR1'.
000017 01 Record-Area pic x(100).
000018 01 Result-to-Display pic x(50).
000019 01 Container-Data.
000020 05 Previous-Filename pic x(08).
000021 05 Previous-Length pic s9(04).
000022 05 Previous-Keylength pic s9(04).
000023 05 Previous-Ridval pic x(08).
000024 01 BMS-Values.
000025 05 Map-Name pic x(08) value 'HANM'.
000026 05 Mapset-Name pic x(08) value 'HANMAP'.
000027 01 CICS-Response pic s9(09) binary.
000028 01 Container-Name pic x(10) value 'CNHANCON'.
000029 01 Channel-Name pic x(10) value 'CHHANCON'.
000030 Procedure Division.
000031 EXEC CICS GET CONTAINER(Container-Name)
000032 CHANNEL(Channel-Name)
000033 INTO(Container-Data)
000034 RESP(CICS-Response)
000035 END-EXEC
000036 if CICS-Response equal DFHRESP(CHANNELERR)
000037 perform 0000-First-Time
000038 else
000039 perform 1000-Process-Input
000040 end-if
000041 .
000042 0000-First-Time.
000043 perform 0100-Clear-Map-Data
000044 perform 0200-Initialize-Local-Data
000045 perform 9000-Display-Output
000046 .
000047 0100-Clear-Map-Data.
000048 move low-values to HANMO
000049 .
000050 0200-Initialize-Local-Data.
000051 move Default-Values to Parm-Variables.
000052 initialize Container-Data
000053 .
000054 1000-Process-Input.
000055 perform 1100-Receive-Terminal-Input
000056 perform 1200-Handle-Condition-Commands
000057 perform 1300-Execute-Read-Command
000058 perform 9000-Display-Output
000059 .
000060 1100-Receive-Terminal-Input.
000061 EXEC CICS RECEIVE
000062 MAP(Map-Name)
000063 MAPSET(Mapset-Name)
000064 INTO(HANMI)
000065 END-EXEC
000066 evaluate EIBAID
000067 when DFHPF3
000068 when DFHPF12
000069 perform 9900-End
000070 when other
000071 continue
000072 end-evaluate
000073 if FILENMI > spaces
000074 move FILENMI to Parm-Filename
000075 else
000076 if Previous-Filename > spaces
000077 move Previous-Filename to Parm-Filename
000078 else
000079 move Default-Filename to Parm-Filename
000080 end-if
000081 end-if
000082 if LENVALI > spaces
000083 move LENVALI to Parm-Length
000084 else
000085 if Previous-Length > zeros
000086 move Previous-Length to Parm-Length
000087 else
000088 move Default-Length to Parm-Length
000089 end-if
000090 end-if
000091 if KEYLENI > zeros
000092 move KEYLENI to Parm-Keylength
000093 else
000094 if Previous-Keylength > zeros
000095 move Previous-Keylength to Parm-Keylength
000096 else
000097 move Default-Keylength to Parm-Keylength
000098 end-if
000099 end-if
000100 if RIDVALI > spaces
000101 move RIDVALI to Parm-Ridval
000102 else
000103 if Previous-Ridval > spaces
000104 move Previous-Ridval to Parm-Ridval
000105 else
000106 move Default-Ridval to Parm-Ridval
000107 end-if
000108 end-if
000109 .
000110 1200-Handle-Condition-Commands.
000111 EXEC CICS HANDLE CONDITION
000112 FILENOTFOUND(8100-FileNotFound)
000113 NOTFND(8200-RecordNotFound)
000114 INVREQ(8300-InvalidRequest)
000115 ERROR(8900-UnexpectedError)
000116 END-EXEC
000117 EXEC CICS IGNORE CONDITION
000118 LENGERR
000119 END-EXEC
000120 .
000121 1300-Execute-Read-Command.
000122 move spaces to RESULTO
000123 EXEC CICS READ
000124 FILE(Parm-Filename)
000125 RIDFLD(Parm-Ridval)
000126 INTO(Record-Area)
000127 LENGTH(Parm-Length)
000128 KEYLENGTH(Parm-Keylength)
000129 END-EXEC
000130 move 'Successful read' to Result-to-Display
000131 .
000132 8100-FileNotFound.
000133 move '8100-FileNotFound'
000134 to Result-to-Display
000135 perform 9000-Display-Output
000136 .
000137 8200-RecordNotFound.
000138 move '8200-RecordNotFound'
000139 to Result-to-Display
000140 perform 9000-Display-Output
000141 .
000142 8300-InvalidRequest.
000143 move '8300-InvalidRequest'
000144 to Result-to-Display
000145 perform 9000-Display-Output
000146 .
000147 8900-UnexpectedError.
000148 move '8900-UnexpectedError'
000149 to Result-to-Display
000150 perform 9000-Display-Output
000151 .
000152 9000-Display-Output.
000153 move Parm-Filename to FILENMO Previous-Filename
000154 EXEC CICS SEND
000155 MAP(Map-Name)
000156 MAPSET(Mapset-Name)
000157 FROM(HANMO)
000158 ERASE
000159 END-EXEC
000160 perform 9900-End
000161 .
000162 9900-End.
000163 EXEC CICS PUT CONTAINER(Container-Name)
000164 CHANNEL(Channel-Name)
000165 FROM(Container-Data)
000166 END-EXEC
000167 EXEC CICS RETURN
000168 TRANSID(EIBTRNID)
000169 CHANNEL(Channel-Name)
000170 END-EXEC
000171 .
****** ******************************** Bottom of Data ********************************