新手入门之简单的cics程序


  • administrators

    cobol代码

               PROCESS LIST,MAP,TEST
           IDENTIFICATION DIVISION.
          *
           PROGRAM-ID.  DCALC01.
          *
           ENVIRONMENT DIVISION.
          *
           DATA DIVISION.
          *
           WORKING-STORAGE SECTION.
          *
           01  SWITCHES.
          *
               05  VALID-DATA-SW                 PIC X  VALUE 'Y'.
                   88  VALID-DATA                       VALUE 'Y'.
                   88  INVALID-DATA                     VALUE 'N'.
          *
           01  FLAGS.
          *
               05  SEND-FLAG                     PIC X.
                   88  SEND-ERASE                       VALUE '1'.
                   88  SEND-ERASE-ALARM                 VALUE '2'.
                   88  SEND-DATAONLY                    VALUE '3'.
                   88  SEND-DATAONLY-ALARM              VALUE '4'.
          *
           01  WORK-AREA.
          *
               05  AA                            PIC 9(2).
               05  BB                            PIC 9(2).
               05  CC                            PIC X(1).
               05  DD                            PIC 9(4).
          *
           01  COMMUNICATION-AREA.
               05  PROCESS-SW                    PIC X(1).
          *
           COPY DTETMS1.
          *
           COPY DFHAID.
          *
           COPY ATTR.
          *
           COPY DFHBMSCA.
          *
           LINKAGE SECTION.
          *
           01  DFHCOMMAREA                       PIC X(01).
          *
           PROCEDURE DIVISION.
          *
           0000-PROCESS.
          *
               IF EIBCALEN > ZERO
                   MOVE DFHCOMMAREA TO COMMUNICATION-AREA
               END-IF.
          *
               IF PROCESS-SW = '1'
                  MOVE LOW-VALUE TO DTEST01O
                  MOVE -1        TO AAL
                  SET SEND-ERASE TO TRUE
                  PERFORM 1300-SEND-MAP
               END-IF.
          *
               EVALUATE TRUE
          *
                   WHEN EIBCALEN = ZERO
                       MOVE LOW-VALUE TO DTEST01O
                       SET SEND-ERASE TO TRUE
                       MOVE -1        TO AAL
                       PERFORM 1300-SEND-MAP
          *
                   WHEN EIBAID = DFHPF3
                       EXEC CICS
                           RETURN TRANSID('DCAL')
                       END-EXEC
          *
                   WHEN EIBAID = DFHPF12
                       MOVE LOW-VALUE TO DTEST01O
                       MOVE -1        TO AAL
                       SET SEND-ERASE TO TRUE
                       PERFORM 1300-SEND-MAP
          *
                   WHEN EIBAID = DFHCLEAR
                       EXEC CICS
                           RETURN
                       END-EXEC
          *
                   WHEN EIBAID = DFHPA1 OR DFHPA2 OR DFHPA3
                       CONTINUE
          *
                   WHEN EIBAID = DFHENTER
                       PERFORM 1000-PROCESS-MAP
          *
                   WHEN OTHER
                       MOVE LOW-VALUE                        TO DTEST01O
                       MOVE 'MSG==> THAT KEY IS UNASSIGNED.' TO MSGO
                       MOVE -1                               TO AAL
                       SET  SEND-DATAONLY-ALARM              TO TRUE
                       PERFORM 1300-SEND-MAP
          *
               END-EVALUATE.
          *
               EXEC CICS
                   RETURN TRANSID('DCAL')
                          COMMAREA(COMMUNICATION-AREA)
               END-EXEC.
          *
           1000-PROCESS-MAP.
          *
               PERFORM 1100-RECEIVE-MAP.
               PERFORM 1200-EDIT-DATA.
               IF VALID-DATA-SW NOT = 'N'
                   MOVE AAI            TO AA
                   MOVE BBI            TO BB
                   MOVE CCI            TO CC
                   EVALUATE CC
                     WHEN '+'
                        COMPUTE  DD = AA + BB
                     WHEN '-'
                        COMPUTE  DD = AA - BB
                     WHEN '*'
                        COMPUTE  DD = AA * BB
                     WHEN '/'
                        COMPUTE  DD = AA / BB
                   END-EVALUATE
                   SET SEND-ERASE      TO TRUE
                   EXEC CICS ENTER TRACEID('100') FROM(DD) END-EXEC
                   MOVE DD             TO DDO
                   MOVE -1             TO AAL
                   MOVE DFHBMPRF       TO AAA
                   MOVE DFHBMPRF       TO BBA
                   MOVE DFHBMPRF       TO CCA
                   MOVE '1'            TO PROCESS-SW
                   PERFORM 1300-SEND-MAP
               END-IF.
          *
               IF VALID-DATA-SW = 'N'
                   MOVE '2'            TO  PROCESS-SW
                   SET SEND-DATAONLY-ALARM TO TRUE
                   PERFORM 1300-SEND-MAP
               END-IF.
          *
           1100-RECEIVE-MAP.
          *
               EXEC CICS
                   RECEIVE MAP('DTEST01')
                           MAPSET('DTETMS1')
                           INTO(DTEST01I)
               END-EXEC.
          *
           1200-EDIT-DATA.
          *
               IF AAI NOT NUMERIC
                   MOVE -1  TO AAL
                   MOVE 'MSG==> THE FIRST NUMBER MUST BE NUMERIC.'  TO MSGO
                   MOVE 'N' TO VALID-DATA-SW
               END-IF.
          *
               IF BBI NOT NUMERIC
                   MOVE -1  TO BBL
                   MOVE 'MSG==> THE SECOND NUMBER MUST BE NUMERIC.' TO MSGO
                   MOVE 'N' TO VALID-DATA-SW
               END-IF.
          *
               IF CCI = '+' OR '-' OR '*' OR '/'
                   CONTINUE
               ELSE
                   MOVE -1 TO CCL
                   MOVE 'MSG==> YOU MUST ENTER A MARK.'             TO MSGO
                   MOVE 'N' TO VALID-DATA-SW
               END-IF.
          *
           1300-SEND-MAP.
          *
               EVALUATE TRUE
                   WHEN SEND-ERASE
                       EXEC CICS
                           SEND MAP('DTEST01')
                                MAPSET('DTETMS1')
                                FROM(DTEST01O)
                                ERASE
                                CURSOR
                       END-EXEC
                   WHEN SEND-ERASE-ALARM
                       EXEC CICS
                           SEND MAP('DTEST01')
                                MAPSET('DTETMS1')
                                FROM(DTEST01O)
                                ERASE
                                ALARM
                                CURSOR
                       END-EXEC
                   WHEN SEND-DATAONLY-ALARM
                       EXEC CICS
                           SEND MAP('DTEST01')
                                MAPSET('DTETMS1')
                                FROM(DTEST01O)
                                DATAONLY
                                ALARM
                                CURSOR
                   END-EXEC
               END-EVALUATE.
          *
           9999-TERMINATE-PROGRAM.
          *
               EXEC CICS
                   ABEND
               END-EXEC.
    

    map代码

             PRINT ON,NOGEN                                                 00000010
    DTETMS1  DFHMSD TYPE=MAP,LANG=COBOL,MODE=INOUT,STORAGE=AUTO,SUFFIX=8    00000020
    DTEST01  DFHMDI SIZE=(24,80),MAPATTS=(COLOR,OUTLINE),COLUMN=1,LINE=1,  *00000030
                   DATA=FIELD,TIOAPFX=YES,OBFMT=NO                          00000040
             DFHMDF POS=(3,27),LENGTH=7,INITIAL=' SAMPLE',ATTRB=(ASKIP,BRT) 00000050
             DFHMDF POS=(3,36),LENGTH=11,INITIAL=' CALCULATOR',            *00000060
                   ATTRB=(ASKIP,BRT)                                        00000070
             DFHMDF POS=(7,16),LENGTH=22,INITIAL=' FIRST NUMBER-------->', *00000080
                   ATTRB=(ASKIP,BRT)                                        00000090
    * AA                              AA                                    00000100
    AA       DFHMDF POS=(7,40),LENGTH=2,ATTRB=(UNPROT,NORM,IC),            *00000110
                   OUTLINE=(UNDER)                                          00000120
             DFHMDF POS=(7,43),LENGTH=1,ATTRB=(ASKIP,NORM)                  00000130
             DFHMDF POS=(10,16),LENGTH=22,INITIAL=' SENCOND NUMBER------>',*00000140
                   ATTRB=(ASKIP,BRT)                                        00000150
    * BB                              BB                                    00000160
    BB       DFHMDF POS=(10,40),LENGTH=2,ATTRB=(UNPROT,NUM,NORM),          *00000170
                   OUTLINE=(UNDER)                                          00000180
             DFHMDF POS=(10,43),LENGTH=1,ATTRB=(ASKIP,NORM)                 00000190
             DFHMDF POS=(13,16),LENGTH=22,INITIAL=' OPERTION(+ - * /)--->',*00000200
                   ATTRB=(ASKIP,BRT)                                        00000210
    * CC                              CC                                    00000220
    CC       DFHMDF POS=(13,40),LENGTH=1,ATTRB=(UNPROT,NORM),              *00000230
                   OUTLINE=(UNDER)                                          00000240
             DFHMDF POS=(13,42),LENGTH=1,ATTRB=(ASKIP,NORM)                 00000250
             DFHMDF POS=(16,16),LENGTH=22,INITIAL=' RESULT-------------->',*00000260
                   ATTRB=(ASKIP,BRT)                                        00000270
    * DD                              DD                                    00000280
    DD       DFHMDF POS=(16,40),LENGTH=4,ATTRB=(ASKIP,NORM)                 00000290
             DFHMDF POS=(16,45),LENGTH=1,ATTRB=(PROT,NORM)                  00000300
             DFHMDF POS=(19,49),LENGTH=6,INITIAL=' ENTER',ATTRB=(PROT,BRT)  00000310
             DFHMDF POS=(20,49),LENGTH=11,INITIAL=' F12 CANCEL',           *00000320
                   ATTRB=(PROT,BRT)                                         00000330
             DFHMDF POS=(21,49),LENGTH=8,INITIAL=' F3 EXIT',ATTRB=(PROT,BRT*00000340
                   )                                                        00000350
    * MSG                             MSG                                   00000360
    MSG      DFHMDF POS=(23,80),LENGTH=79,ATTRB=(PROT,NORM),COLOR=NEUTRAL   00000370
             DFHMDF POS=(24,80),LENGTH=0,ATTRB=(ASKIP,NORM)                 00000380
             DFHMSD TYPE=FINAL                                              00000390
             END                                                            00000400
    

Log in to reply
 

Looks like your connection to MainFrame was lost, please wait while we try to reconnect.