Navigation

    DDBB

    • Register
    • Login
    • Categories
    • Recent
    • Tags
    • Popular
    • Users
    • Groups

    新手入门之简单的cics程序

    PROGRAMMING LANGUAGES
    1
    1
    43
    Loading More Posts
    • Oldest to Newest
    • Newest to Oldest
    • Most Votes
    Reply
    • Reply as topic
    Log in to reply
    This topic has been deleted. Only users with topic management privileges can see it.
    • A
      admin last edited by

      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
      
      1 Reply Last reply Reply Quote 0
      • First post
        Last post