home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1996 February / PCWK0296.iso / po7_win / db / rdbms71 / cbdem3.cob < prev    next >
Text File  |  1994-08-07  |  10KB  |  290 lines
  1.       *    
  2.       *    $Header: cbdem3.cob 7000901.1 92/03/21 18:05:48 twang Generic<base> $ 
  3.       *    
  4.       * Copyright (c) 1991 by Oracle Corporation 
  5.       *   NAME
  6.       *     cbdem3.cob - Cobol demo program # 3
  7.       *   MODIFIED   (MM/DD/YY)
  8.       *    sjain      03/16/92 -  Creation 
  9.       *
  10.       *  The program CBDEM3 creates a table called
  11.       *  "VOICE_MAIL" that contains three fields:
  12.       *  a message ID, and message length, and a LONG RAW
  13.       *  column that contains a digitized voice
  14.       *  message.  The program fills one row of the table with a
  15.       *  (simulated) message, then plays the message by
  16.       *  extracting 64 kB chunks of it using the OFLNG routine,
  17.       *  and sending them to a (simulated) digital-to-analog
  18.       *  (DAC) converter routine.
  19.  
  20.        IDENTIFICATION DIVISION.
  21.        PROGRAM-ID.  CBDEM3.
  22.        ENVIRONMENT DIVISION.
  23.        DATA DIVISION.
  24.        WORKING-STORAGE SECTION.
  25.  
  26.        01  LDA.
  27.            02      LDA-V2RC    PIC S9(4) COMP.
  28.            02      FILLER      PIC X(10).
  29.            02      LDA-RC      PIC S9(4) COMP.
  30.            02      FILLER      PIC X(50).
  31.        01  CDA.
  32.            02      C-V2RC      PIC S9(4) COMP.
  33.            02      C-TYPE      PIC S9(4) COMP.
  34.            02      C-ROWS      PIC S9(9) COMP.
  35.            02      C-OFFS      PIC S9(4) COMP.
  36.            02      C-FNC       PIC S9(4) COMP.
  37.            02      C-RC        PIC S9(4) COMP.
  38.            02      FILLER      PIC X(50).
  39.        01  HDA                 PIC X(256).
  40.  
  41.        01  ERRMSG              PIC X(256).
  42.        01  ERRMSG-L            PIC S9(9) VALUE 256 COMP.
  43.        01  ERR-RC              PIC S9(9) COMP.
  44.        01  ERR-FNC-D           PIC ZZ9.
  45.  
  46.        01  USER-ID             PIC X(5)  VALUE "SCOTT".
  47.        01  USER-ID-L           PIC S9(9) VALUE 5 COMP.
  48.        01  PSW                 PIC X(5)  VALUE "tiger".
  49.        01  PSW-L               PIC S9(9) VALUE 5 COMP.
  50.        01  AUDIT               PIC S9(9) VALUE 0 COMP.
  51.  
  52.        01  SQL-STMT            PIC X(132).
  53.        01  SQLL                PIC S9(9) COMP.
  54.        01  ZERO-A              PIC S9(9) VALUE 0 COMP.
  55.        01  FMT                 PIC X(6).
  56.  
  57.       *  Establish a 200000 byte buffer.  (On most systems,
  58.       *  including the VAX, a PIC 99 reserves one byte.)
  59.        01  MSGX.
  60.            02 MSG              OCCURS 200000 TIMES PIC 99.
  61.        01  MSGX-L              PIC S9(9) VALUE 200000 COMP.
  62.        01  MSG-L               PIC S9(9) COMP.
  63.        01  MSG-L-D             PIC ZZZZZZ.
  64.        01  MSG-ID              PIC S9(9) COMP.
  65.        01  MSG-ID-L            PIC S9(9) VALUE 4 COMP.
  66.        01  MSG-ID-D            PIC ZZZZ.
  67.        01  LEN                 PIC 9(9) COMP.
  68.        01  LEN-D               PIC ZZZZ9.
  69.        01  INDX                PIC S9(9) COMP.
  70.        01  INTEGER-T           PIC S9(9) VALUE 3 COMP.
  71.        01  DEF-MODE            PIC S9(9) VALUE 1 COMP.
  72.        01  LONG-RAW            PIC S9(9) VALUE 24 COMP.
  73.        01  ONE                 PIC S9(9) VALUE 1 COMP.
  74.        01  TWO                 PIC S9(9) VALUE 2 COMP.
  75.        01  THREE               PIC S9(9) VALUE 3 COMP.
  76.  
  77.        01  ANSX.
  78.            02      ANSWER      OCCURS 6 TIMES PIC X.
  79.        01  VERSION-7           PIC S9(9) VALUE 2 COMP.
  80.        01  INDP                PIC S9(4) COMP.
  81.        01  RCODE               PIC S9(4) COMP.
  82.        01  RLEN                PIC S9(4) COMP.
  83.        01  RETL                PIC S9(9) COMP.
  84.        01  OFF1                PIC S9(9) COMP.
  85.  
  86.  
  87.        PROCEDURE DIVISION.
  88.        BEGIN.
  89.  
  90.       *  Connect to ORACLE.
  91.            CALL "ORLON" USING LDA, HDA, USER-ID, USER-ID-L,
  92.                  PSW, PSW-L, AUDIT.
  93.            IF LDA-RC NOT = 0
  94.               PERFORM ORA-ERROR
  95.               GO TO EXIT-STOP.
  96.  
  97.            DISPLAY "Logged on to ORACLE as user ", USER-ID.
  98.  
  99.       *  Open a cursor.
  100.            CALL "OOPEN" USING CDA, LDA, USER-ID, ZERO-A,
  101.                  ZERO-A, USER-ID, ZERO-A.
  102.            IF C-RC IN CDA NOT = 0
  103.               PERFORM ORA-ERROR
  104.               GO TO EXIT-LOGOFF.
  105.  
  106.       *  Drop the VOICE_MAIL table.
  107.            DISPLAY "About to drop the
  108.       -    " VOICE_MAIL table." WITH NO ADVANCING.
  109.            DISPLAY " Is this OK (Y or N)? : " WITH NO ADVANCING.
  110.            ACCEPT ANSX.
  111.            IF (ANSWER(1) NOT = 'y' AND ANSWER(1) NOT = 'Y')
  112.               DISPLAY "Exiting program now."
  113.               GO TO EXIT-CLOSE.
  114.            MOVE "DROP TABLE VOICE_MAIL" TO SQL-STMT.
  115.            MOVE 132 TO SQLL.
  116.  
  117.       *  Call OPARSE with no deferred parse to execute the DDL
  118.       *  statement immediately.
  119.            CALL "OPARSE" USING CDA, SQL-STMT, SQLL,
  120.                 ZERO-A, VERSION-7.
  121.            IF C-RC IN CDA NOT = 0
  122.               IF (C-RC IN CDA = 942)
  123.                  DISPLAY "Table did not exist."
  124.               ELSE
  125.                  PERFORM ORA-ERROR
  126.                  GO TO EXIT-LOGOFF
  127.               END-IF
  128.            ELSE
  129.               DISPLAY "Table dropped."
  130.            END-IF
  131.  
  132.       *  Create the VOICE_MAIL table anew.
  133.            MOVE "CREATE TABLE VOICE_MAIL (MSG_ID NUMBER(6),
  134.       -    "MSG_LEN NUMBER(12), MSG LONG RAW)" TO SQL-STMT.
  135.            MOVE 132 TO SQLL.
  136.  
  137.       *  Non-deferred parse to execute the DDL SQL statement.
  138.            DISPLAY "Table VOICE_MAIL " NO ADVANCING.
  139.  
  140.            CALL "OPARSE" USING CDA, SQL-STMT, SQLL,
  141.                 ZERO-A, VERSION-7.
  142.            IF C-RC IN CDA NOT = 0
  143.               PERFORM ORA-ERROR
  144.               GO TO EXIT-LOGOFF.
  145.            DISPLAY "created.".
  146.  
  147.       *  Insert some data into the table.
  148.            MOVE "INSERT INTO VOICE_MAIL VALUES (:1, :2, :3)"
  149.                 TO SQL-STMT.
  150.            MOVE 132 TO SQLL.
  151.            CALL "OPARSE" USING CDA, SQL-STMT, SQLL,
  152.                  ZERO-A, VERSION-7.
  153.            IF C-RC IN CDA NOT = 0
  154.               PERFORM ORA-ERROR
  155.               GO TO EXIT-LOGOFF.
  156.  
  157.       *  Bind the inputs.
  158.            MOVE 0 TO INDP.
  159.            CALL "OBNDRN" USING CDA, ONE, MSG-ID, MSG-ID-L,
  160.                 INTEGER-T, ZERO-A, INDP, FMT, ZERO-A, ZERO-A.
  161.            IF C-RC IN CDA NOT = 0
  162.               PERFORM ORA-ERROR
  163.               GO TO EXIT-LOGOFF.
  164.  
  165.            CALL "OBNDRN" USING CDA, TWO, MSG-L, MSG-ID-L,
  166.                 INTEGER-T, ZERO-A, INDP, FMT, ZERO-A, ZERO-A.
  167.            IF C-RC IN CDA NOT = 0
  168.               PERFORM ORA-ERROR
  169.               GO TO EXIT-LOGOFF.
  170.  
  171.            CALL "OBNDRN" USING CDA, THREE, MSGX, MSGX-L,
  172.                 LONG-RAW, ZERO-A, INDP, FMT, ZERO-A, ZERO-A.
  173.            IF C-RC IN CDA NOT = 0
  174.               PERFORM ORA-ERROR
  175.               GO TO EXIT-LOGOFF.
  176.  
  177.       *  Set input variables, then execute the INSERT statement.
  178.            MOVE 100 TO MSG-ID.
  179.            MOVE 200000 TO MSG-L.
  180.            PERFORM VARYING INDX FROM 1 BY 1 UNTIL INDX > MSG-L
  181.               MOVE 42 TO MSG(INDX)
  182.            END-PERFORM.
  183.            CALL "OEXN" USING CDA, ONE.
  184.            IF C-RC IN CDA NOT = 0
  185.               PERFORM ORA-ERROR
  186.               GO TO EXIT-LOGOFF.
  187.  
  188.            MOVE "SELECT MSG_ID, MSG_LEN, MSG FROM VOICE_MAIL
  189.       -    " WHERE MSG_ID = 100" TO SQL-STMT.
  190.  
  191.       *  Call OPARSE in deferred mode to select a message.
  192.            CALL "OPARSE" USING CDA, SQL-STMT, SQLL,
  193.                 DEF-MODE, VERSION-7.
  194.            IF C-RC IN CDA NOT = 0
  195.               PERFORM ORA-ERROR
  196.               GO TO EXIT-LOGOFF.
  197.       *  Define the output variables.
  198.            CALL "ODEFIN" USING CDA, ONE, MSG-ID,
  199.                 MSG-ID-L, INTEGER-T.
  200.            IF C-RC IN CDA NOT = 0
  201.               PERFORM ORA-ERROR
  202.               GO TO EXIT-LOGOFF.
  203.  
  204.            CALL "ODEFIN" USING CDA, TWO, MSG-L,
  205.                 MSG-ID-L, INTEGER-T.
  206.            IF C-RC IN CDA NOT = 0
  207.               PERFORM ORA-ERROR
  208.               GO TO EXIT-LOGOFF.
  209.  
  210.            MOVE 100 TO MSG-ID-L.
  211.            CALL "ODEFIN" USING CDA, THREE, MSGX,
  212.                 MSG-ID-L, LONG-RAW, INDP, ANSX, ZERO-A, ZERO-A,
  213.                 RLEN, RCODE.
  214.            IF C-RC IN CDA NOT = 0
  215.               PERFORM ORA-ERROR
  216.               GO TO EXIT-LOGOFF.
  217.  
  218.       *  Do the query, getting the message ID and just the first
  219.       *  100 bytes of the message.  This query basically just sets
  220.       *  the cursor to the right row.  The message contents are 
  221.       *  fetched by the OFLNG routine.
  222.  
  223.            CALL "OEXFET" USING CDA, ONE, ZERO-A, ZERO-A.
  224.            IF C-RC IN CDA NOT = 0
  225.               PERFORM ORA-ERROR
  226.               GO TO EXIT-LOGOFF.
  227.  
  228.            MOVE MSG-ID TO MSG-ID-D.
  229.            DISPLAY "".
  230.            DISPLAY "Message " MSG-ID-D " is available.".
  231.            MOVE MSG-L TO MSG-L-D.
  232.            DISPLAY "The length is " MSG-L-D " bytes.".
  233.  
  234.            PERFORM VARYING OFF1 FROM 0 BY 65536
  235.                  UNTIL MSG-L <= 0
  236.               IF (MSG-L < 65536)
  237.                  MOVE MSG-L TO LEN
  238.               ELSE
  239.                  MOVE 65536 TO LEN
  240.               END-IF
  241.               PERFORM PLAY-MSG THRU PLAY-MSG-EXIT
  242.               SUBTRACT LEN FROM MSG-L
  243.       *        IF (MSG-L < 0 OR MSG-L = 0)
  244.       *           GO TO END-LOOP
  245.       *        END-IF
  246.            END-PERFORM.
  247.  
  248.        END-LOOP.
  249.            DISPLAY "".
  250.            DISPLAY "End of message.".
  251.  
  252.  
  253.        EXIT-CLOSE.
  254.            CALL "OCLOSE" USING CDA.
  255.        EXIT-LOGOFF.
  256.            CALL "OLOGOF" USING LDA.
  257.        EXIT-STOP.
  258.            STOP RUN.
  259.  
  260.  
  261.        PLAY-MSG.
  262.            MOVE LEN TO LEN-D.
  263.            DISPLAY "Playing " LEN-D " bytes.".
  264.        PLAY-MSG-EXIT.
  265.  
  266.  
  267.  
  268.       * Report an error.  Obtain the error message
  269.       * text using the OERHMS routine.
  270.        ORA-ERROR.
  271.            IF LDA-RC IN LDA NOT = 0
  272.               DISPLAY "OLOGON error"
  273.               MOVE 0 TO C-FNC IN CDA
  274.               MOVE LDA-RC IN LDA TO C-RC IN CDA.
  275.            DISPLAY "ORACLE error" NO ADVANCING.
  276.            IF C-FNC NOT = 0
  277.               DISPLAY " processing OCI function " NO ADVANCING
  278.               MOVE C-FNC IN CDA TO ERR-FNC-D
  279.               DISPLAY ERR-FNC-D
  280.            ELSE
  281.               DISPLAY ".".
  282.  
  283.            MOVE " " TO ERRMSG.
  284.            CALL "OERHMS" USING LDA, C-RC IN CDA,
  285.                 ERRMSG, ERRMSG-L.
  286.            DISPLAY ERRMSG.
  287.  
  288.  
  289.  
  290.