home *** CD-ROM | disk | FTP | other *** search
/ Datatid 1999 #6 / Datatid_1999-06.iso / internet / Tango352Promo / P.SQL / PTKPKG.1 / BTRSAMP.CBL < prev    next >
Encoding:
Text File  |  1997-03-13  |  4.0 KB  |  122 lines
  1. *
  2. *
  3. *  Copyright 1982-1997 Pervasive Software Inc. All Rights Reserved
  4. *
  5. *
  6. *  BTRSAMP.CBL
  7. *    This is a sample COBOL program that makes Btrieve calls from
  8. *    an application using Micro Focus COBOL v3.x.
  9. *
  10. *
  11.        IDENTIFICATION DIVISION.
  12.       *
  13.        PROGRAM-ID. TEST1.
  14.       *
  15.       *
  16.        ENVIRONMENT DIVISION.
  17.        CONFIGURATION SECTION.
  18.        SOURCE-COMPUTER. IBM-PC.
  19.        OBJECT-COMPUTER. IBM-PC.
  20.       *
  21.       *
  22.        DATA DIVISION.
  23.       *
  24.        WORKING-STORAGE SECTION.
  25.       *
  26.       * BTRIEVE OP CODES
  27.       *
  28.        01 B-OPEN                        PIC 9(4) COMP-5 VALUE 0.
  29.        01 B-INSERT                      PIC 9(4) COMP-5 VALUE 2.
  30.        01 B-GETFIRST                    PIC 9(4) COMP-5 VALUE 12.
  31.        01 B-UPDATE                      PIC 9(4) COMP-5 VALUE 3.
  32.        01 B-CLOSE                       PIC 9(4) COMP-5 VALUE 1.
  33.       *
  34.        01 B-STATUS                      PIC 9(4) COMP-5 VALUE 0.
  35.        01 KEY-NUMBER                    PIC 9(4) COMP-5 VALUE 0.
  36.        01 BUF-LEN                       PIC 9(4) COMP-5 VALUE 0.
  37.        01 FILE-NAME                     PIC X(13) VALUE SPACES.
  38.        01 POSITION-BLOCK                PIC X(128) VALUE SPACES.
  39.        01 DATA-BUFFER.
  40.           02 DECIMAL-FIELD              PIC 9(4) COMP-3 VALUE 0.
  41.           02 STRING-FIELD               PIC X(36) VALUE SPACES.
  42.        01 DSP-STATUS                    PIC 9(5) COMP-5.
  43.       *
  44.       *
  45.       *
  46.        PROCEDURE DIVISION.
  47.        BEGIN.
  48.       *
  49.       * Open TEST.BTR
  50.       *
  51.       *
  52.            MOVE 0   TO BUF-LEN.
  53.            MOVE 0   TO KEY-NUMBER.
  54.            MOVE 'TEST.BTR ' TO FILE-NAME.
  55.            CALL "_BTRV" USING B-OPEN, B-STATUS, POSITION-BLOCK,
  56.                              DATA-BUFFER, BUF-LEN, FILE-NAME, KEY-NUMBER.
  57.            IF B-STATUS NOT = 0
  58.              DISPLAY 'Error opening file. Status= ' B-STATUS
  59.            ELSE
  60.              DISPLAY 'File ' FILE-NAME ' successfully opened'
  61.            END-IF.
  62.       *
  63.       * Insert into TEST.BTR
  64.       *
  65.       *
  66.            MOVE 1    TO DECIMAL-FIELD.
  67.            MOVE 'Record 1' TO STRING-FIELD.
  68.            MOVE 40   TO BUF-LEN.
  69.            MOVE 0    TO KEY-NUMBER
  70.            CALL "_BTRV" USING B-INSERT, B-STATUS, POSITION-BLOCK,
  71.                              DATA-BUFFER, BUF-LEN, FILE-NAME, KEY-NUMBER.
  72.            IF B-STATUS NOT = 0
  73.              DISPLAY 'Error inserting into file. Status= ' B-STATUS
  74.            ELSE
  75.              DISPLAY 'Inserted:  ' DECIMAL-FIELD STRING-FIELD
  76.            END-IF.
  77.       *
  78.       * GetFirst
  79.       *
  80.       *
  81.            MOVE 40   TO BUF-LEN.
  82.            MOVE 0    TO KEY-NUMBER
  83.            CALL "_BTRV" USING B-GETFIRST, B-STATUS, POSITION-BLOCK,
  84.                              DATA-BUFFER, BUF-LEN, FILE-NAME, KEY-NUMBER.
  85.            IF B-STATUS NOT = 0
  86.              DISPLAY 'Error Getting first record. Status= ' B-STATUS
  87.            ELSE
  88.              DISPLAY 'Retrieved:  ' DECIMAL-FIELD STRING-FIELD
  89.            END-IF.
  90.       *
  91.       * Update into TEST.BTR
  92.       *
  93.       *
  94.            MOVE 2    TO DECIMAL-FIELD.
  95.            MOVE 'Record 2' TO STRING-FIELD.
  96.            MOVE 40   TO BUF-LEN.
  97.            MOVE 0    TO KEY-NUMBER
  98.            CALL "_BTRV" USING B-UPDATE, B-STATUS, POSITION-BLOCK,
  99.                              DATA-BUFFER, BUF-LEN, FILE-NAME, KEY-NUMBER.
  100.            IF B-STATUS NOT = 0
  101.              DISPLAY 'Error updating file. Status= ' B-STATUS
  102.            ELSE
  103.              DISPLAY 'Updated to:  ' DECIMAL-FIELD STRING-FIELD
  104.            END-IF.
  105.       *
  106.       * Close TEST.BTR
  107.       *
  108.       *
  109.            MOVE 0   TO BUF-LEN.
  110.            MOVE 0    TO KEY-NUMBER
  111.            CALL "_BTRV" USING B-CLOSE, B-STATUS, POSITION-BLOCK,
  112.                              DATA-BUFFER, BUF-LEN, FILE-NAME, KEY-NUMBER.
  113.            IF B-STATUS NOT = 0
  114.              DISPLAY 'Error closing file. Status= ' B-STATUS
  115.            ELSE
  116.              DISPLAY 'Successfully closed TEST.BTR'
  117.            END-IF.
  118.  
  119.  
  120.            STOP RUN.
  121.  
  122.