Number of examples: 2978 Average size: 5893.29 bytes Ten random samples: ===== MicroFocus/visual-cobol-for--java-developers-book/chapter-10/kubernetes/BusinessInterop/src/com/mfcobolbook/businessinterop/AccountDto.cbl ===== ***************************************************************** * * * Copyright (C) 2020-2022 Micro Focus. All Rights Reserved. * * This software may be used, modified, and distributed * * (provided this notice is included without modification) * * solely for demonstration purposes with other * * Micro Focus software, and is otherwise subject to the EULA at * * https://www.microfocus.com/en-us/legal/software-licensing. * * * * THIS SOFTWARE IS PROVIDED "AS IS" AND ALL IMPLIED * * WARRANTIES, INCLUDING THE IMPLIED WARRANTIES OF * * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, * * SHALL NOT APPLY. * * TO THE EXTENT PERMITTED BY LAW, IN NO EVENT WILL * * MICRO FOCUS HAVE ANY LIABILITY WHATSOEVER IN CONNECTION * * WITH THIS SOFTWARE. * * * ***************************************************************** class-id com.mfcobolbook.businessinterop.AccountDto public. working-storage section. 01 accountId binary-long property. 01 customerId binary-long property. 01 balance decimal property. 01 #type binary-char property. 01 creditLimit decimal property. method-id new (accountId as binary-long, customerId as binary-long, balance as decimal, #type as binary-char, creditLimit as decimal). set self::accountId to accountId set self::customerId to customerid set self::balance to balance set self::type to #type set self::creditLimit to creditLimit goback. end method. method-id getAsAccountRecord. linkage section. copy "ACCOUNT-RECORD.cpy" replacing ==(PREFIX)== by LNK. procedure division using by reference LNK-ACCOUNT. move accountId to LNK-ACCOUNT-ID move customerId to LNK-CUSTOMER-ID move balance to LNK-BALANCE move #type to LNK-TYPE move creditLimit to LNK-CREDIT-LIMIT end method. method-id toString() returning aString as string override. set aString to type String::format ("id %d, customerId %d, balance %s, limit %s", accountId, customerId, balance, creditLimit) end method. end class. ===== sergev/vak-opensource/languages/cobol/cobol24/ch05/chapt05a.cob ===== 000010 @OPTIONS MAIN 000020 Identification Division. 000030 Program-Id. Chapt05a. 000031* Data Entry Screen 000040 Environment Division. 000050 Configuration Section. 000051 Source-Computer. IBM-PC. 000055 Object-Computer. IBM-PC. 000056 Data Division. 000057 Working-Storage Section. 000067 01 Field-Group-1. 000077 03 Fg1-First Pic 9(2) Value 99. 000087 03 Fg1-Second Pic 9(2) Value 2. 000097 03 Fg1-Third Pic 9(2) Value 3. 000107 01 Field-Group-2. 000117 03 Fg1-First Pic 9(2) Value 10. 000127 03 Fg1-Second Pic 9(2) Value 20. 000137 03 Fg1-Third Pic 9(2) Value 30. 000147 01 Data-Item-2 Pic 9999 Value 2. 000148 01 Data-Item-3 Pic 9999 Value 2. 000149 01 Data-Item-4 Pic 9999. 000150 01 Data-Item-5 Pic 9999. 000151 01 Edited-Field Pic XX/xx/xx. 000152 01 Data-Field-1. 000153 03 Data-Field-Contents Pic X(6) Value "ABCDEF". 000154 01 Some-Number Pic S9(5)v99 Value -1234.56. 000155 01 Some-Field Pic X(10). 000156 01 Alpha-Number Pic X(5) Value "12345". 000157 01 Number-Number Pic 9(4). 000158 Procedure Division. 000159 Required-Paragraph. 000167 Add Corresponding Field-Group-1 To Field-Group-2 000168 On Size Error 000169 Display "Size error" 000170 End-Add 000177 Display Field-Group-2 000178 Add 10 20 30 Giving Data-Item-2 Data-Item-3 000179 Multiply 10 By 30 Giving Data-Item-2 Data-Item-3 000180 Display Data-Item-2 000181 Divide 10 By 3 Giving Data-Item-2 Data-Item-3 000182 Display "divide " Data-Item-3 000183 Divide 10 By 3 Giving Data-Item-2 Remainder Data-Item-4 000184 Display "divide 2 " Data-Item-4 " " Data-Item-5 000187 Compute Data-Item-4 = 3 * (1 / 3) 000188 Display Data-Item-4 000189 Move Data-Field-Contents To Edited-Field. 000190 Display "E1 " Edited-Field. 000191 Move Data-Field-1 To Edited-Field. 000192 Display "E2 " Edited-Field. 000193 Move Some-Number To Some-Field. 000194 Display "Sf " Some-Field. 000195 Move Alpha-Number To Number-Number. 000196 Display Number-Number. 000197 Stop Run 000198 . ===== neetsdkasu/Paiza-POH-MyAnswers/POH8/Osage/Main.cob ===== *> Try POH *> author: Leonardone @ NEETSDKASU *> ↓ 1行あたりの字数の目安 *>==============================================================$ IDENTIFICATION DIVISION. PROGRAM-ID. MAIN. ENVIRONMENT DIVISION. CONFIGURATION SECTION. REPOSITORY. FUNCTION ALL INTRINSIC. DATA DIVISION. WORKING-STORAGE SECTION. 01 ANSWER-VALUES. 05 INT-N BINARY-LONG. 05 INT-M PIC 999. 05 INT-T BINARY-LONG. 05 INT-I PIC 999. 05 INT-C PIC 999 VALUE IS 0. 05 INT-Z PIC Z9. PROCEDURE DIVISION. MAIN-ROUTINE SECTION. 000-MAIN. ACCEPT INT-N. ACCEPT INT-M. MULTIPLY 60 BY INT-N. PERFORM WITH TEST AFTER VARYING INT-I FROM 1 BY 1 UNTIL INT-I >= INT-M ACCEPT INT-T IF INT-N >= INT-T THEN MOVE INT-I TO INT-C END-IF SUBTRACT INT-T FROM INT-N END-PERFORM. IF INT-C = INT-M THEN DISPLAY "OK" ELSE MOVE INT-C TO INT-Z DISPLAY TRIM(INT-Z) END-IF. END PROGRAM MAIN. ===== shamrice/COBOL-Examples/merge_sort/merge_sort_test.cbl ===== ****************************************************************** * author: Erik Eriksen * date: 2021-09-19 * purpose: Testing sort and merge syntax on test data. * tectonics: cobc ****************************************************************** identification division. program-id. merge-sort-example. environment division. input-output section. file-control. select fd-test-file-1 assign to "test-file-1.txt" organization is line sequential file status is ws-fs-status-1. select fd-test-file-2 assign to "test-file-2.txt" organization is line sequential file status is ws-fs-status-2. select fd-sorting-file assign to "work-temp.txt". select fd-merged-file assign to "merge-output.txt" organization is line sequential file status is ws-fs-status-merge. select fd-sorted-contract-id assign to "sorted-contract-id.txt" organization is line sequential file status is ws-fs-status-sorted. data division. file section. sd fd-sorting-file. 01 f-customer-record-sort. 05 f-customer-id pic 9(5). 05 f-customer-last-name pic x(50). 05 f-customer-first-name pic x(50). 05 f-customer-contract-id pic 9(5). 05 f-customer-comment pic x(25). fd fd-test-file-1 recording mode F. 01 f-customer-record-east. 05 f-customer-id pic 9(5). 05 f-customer-last-name pic x(50). 05 f-customer-first-name pic x(50). 05 f-customer-contract-id pic 9(5). 05 f-customer-comment pic x(25). fd fd-test-file-2 recording mode F. 01 f-customer-record-west. 05 f-customer-id pic 9(5). 05 f-customer-last-name pic x(50). 05 f-customer-first-name pic x(50). 05 f-customer-contract-id pic 9(5). 05 f-customer-comment pic x(25). fd fd-merged-file recording mode F. 01 f-customer-record-merged. 05 f-customer-id pic 9(5). 05 f-customer-last-name pic x(50). 05 f-customer-first-name pic x(50). 05 f-customer-contract-id pic 9(5). 05 f-customer-comment pic x(25). fd fd-sorted-contract-id recording mode F. 01 f-customer-record-sorted-contract-id. 05 f-customer-id pic 9(5). 05 f-customer-last-name pic x(50). 05 f-customer-first-name pic x(50). 05 f-customer-contract-id pic 9(5). 05 f-customer-comment pic x(25). working-storage section. 01 ws-fs-status-1 pic xx. 01 ws-fs-status-2 pic xx. 01 ws-fs-status-merge pic xx. 01 ws-fs-status-sorted pic xx. 01 ws-eof-sw pic x value 'N'. 88 ws-eof value 'Y'. 88 ws-not-eof value 'N'. procedure division. main-procedure. perform create-test-data perform merge-and-display-files perform sort-and-display-file display "Done." stop run. merge-and-display-files. display "Merging and sorting files..." merge fd-sorting-file on ascending key f-customer-id of f-customer-record-merged using fd-test-file-1 fd-test-file-2 giving fd-merged-file open input fd-merged-file if ws-fs-status-merge not = "00" then display "Error opening merged output file: " ws-fs-status-merge end-display stop run end-if set ws-not-eof to true perform until ws-eof read fd-merged-file at end set ws-eof to true not at end display f-customer-record-merged end-read end-perform close fd-merged-file exit paragraph. sort-and-display-file. display "Sorting merged file on descending contract id...." sort fd-sorting-file on descending key f-customer-contract-id of f-customer-record-sorted-contract-id using fd-merged-file giving fd-sorted-contract-id open input fd-sorted-contract-id if ws-fs-status-sorted not = "00" then display "Error opening sorted output file: " ws-fs-status-sorted end-display stop run end-if set ws-not-eof to true perform until ws-eof read fd-sorted-contract-id at end set ws-eof to true not at end display f-customer-record-sorted-contract-id end-read end-perform close fd-sorted-contract-id exit paragraph. create-test-data. display "Creating test data files..." open output fd-test-file-1 if ws-fs-status-1 not = "00" then display "Failed to open file for output: " ws-fs-status-1 end-display stop run end-if move 1 to f-customer-id of f-customer-record-east move "last-1" to f-customer-last-name of f-customer-record-east move "first-1" to f-customer-first-name of f-customer-record-east move 5423 to f-customer-contract-id of f-customer-record-east move "comment-1" to f-customer-comment of f-customer-record-east write f-customer-record-east move 5 to f-customer-id of f-customer-record-east move "last-5" to f-customer-last-name of f-customer-record-east move "first-5" to f-customer-first-name of f-customer-record-east move 12323 to f-customer-contract-id of f-customer-record-east move "comment-5" to f-customer-comment of f-customer-record-east write f-customer-record-east move 10 to f-customer-id of f-customer-record-east move "last-10" to f-customer-last-name of f-customer-record-east move "first-10" to f-customer-first-name of f-customer-record-east move 653 to f-customer-contract-id of f-customer-record-east move "comment-10" to f-customer-comment of f-customer-record-east write f-customer-record-east move 50 to f-customer-id of f-customer-record-east move "last-50" to f-customer-last-name of f-customer-record-east move "first-50" to f-customer-first-name of f-customer-record-east move 5050 to f-customer-contract-id of f-customer-record-east move "comment-50" to f-customer-comment of f-customer-record-east write f-customer-record-east move 25 to f-customer-id of f-customer-record-east move "last-25" to f-customer-last-name of f-customer-record-east move "first-25" to f-customer-first-name of f-customer-record-east move 7725 to f-customer-contract-id of f-customer-record-east move "comment-25" to f-customer-comment of f-customer-record-east write f-customer-record-east move 75 to f-customer-id of f-customer-record-east move "last-75" to f-customer-last-name of f-customer-record-east move "first-75" to f-customer-first-name of f-customer-record-east move 1175 to f-customer-contract-id of f-customer-record-east move "comment-75" to f-customer-comment of f-customer-record-east write f-customer-record-east close fd-test-file-1 open output fd-test-file-2 if ws-fs-status-2 not = "00" then display "Failed to open file for output: " ws-fs-status-2 end-display stop run end-if move 999 to f-customer-id of f-customer-record-west move "last-999" to f-customer-last-name of f-customer-record-west move "first-999" to f-customer-first-name of f-customer-record-west move 1610 to f-customer-contract-id of f-customer-record-west move "comment-99" to f-customer-comment of f-customer-record-west write f-customer-record-west move 3 to f-customer-id of f-customer-record-west move "last-03" to f-customer-last-name of f-customer-record-west move "first-03" to f-customer-first-name of f-customer-record-west move 3331 to f-customer-contract-id of f-customer-record-west move "comment-03" to f-customer-comment of f-customer-record-west write f-customer-record-west move 30 to f-customer-id of f-customer-record-west move "last-30" to f-customer-last-name of f-customer-record-west move "first-30" to f-customer-first-name of f-customer-record-west move 8765 to f-customer-contract-id of f-customer-record-west move "comment-30" to f-customer-comment of f-customer-record-west write f-customer-record-west move 85 to f-customer-id of f-customer-record-west move "last-85" to f-customer-last-name of f-customer-record-west move "first-85" to f-customer-first-name of f-customer-record-west move 4567 to f-customer-contract-id of f-customer-record-west move "comment-85" to f-customer-comment of f-customer-record-west write f-customer-record-west move 24 to f-customer-id of f-customer-record-west move "last-24" to f-customer-last-name of f-customer-record-west move "first-24" to f-customer-first-name of f-customer-record-west move 247 to f-customer-contract-id of f-customer-record-west move "comment-24" to f-customer-comment of f-customer-record-west write f-customer-record-west close fd-test-file-2 exit paragraph. end program merge-sort-example. ===== Ayush7-BIT/sample-programs/archive/c/cobol/hello-world.cbl ===== IDENTIFICATION DIVISION. PROGRAM-ID. HELLO-WORLD. PROCEDURE DIVISION. DISPLAY "Hello, World!" STOP RUN. ===== stawi/cobol85parser/src/test/resources/io/proleap/cobol/preprocessor/fixed/LineContinuation.cbl ===== 000100 IDENTIFICATION DIVISION. 12345678 000100 PROGRAM-ID. LINECONT. 12345678 000100 DATA DIVISION 12345678 000100 77 SQL-INS PIC X(150) VALUE 12345678 000100 "INSERT INTO EMP (EMPNO,ENAME,JOB,SAL,DEPTNO) 12345678 000100- " VALUES (:EMPNO,:ENAME,:JOB,:SAL,:DEPTNO)". 12345678 ===== tuttle/cobol-demo/seq_write.cbl ===== *> Asks the user for From and To account number (up to 5 digits long) and the amount *> having value no larger than 9999.99 and appends such record to the file. IDENTIFICATION DIVISION. PROGRAM-ID. SeqWrite. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT OPTIONAL OutFile ASSIGN TO "transactions.dat" ORGANIZATION IS LINE SEQUENTIAL. DATA DIVISION. FILE SECTION. FD OutFile. 01 TransactionDetails. 05 FromAccount PIC 9(5). 05 ToAccount PIC 9(5). 05 Amount PIC 9999.99. WORKING-STORAGE SECTION. 01 ShouldContinue PIC X VALUE "C". 88 Done VALUES "Q" "q". PROCEDURE DIVISION. OPEN EXTEND OutFile. DISPLAY "Enter transaction, use Q command to quit.". PERFORM SaveTransaction UNTIL Done. CLOSE OutFile. STOP RUN. SaveTransaction. DISPLAY "From > " WITH NO ADVANCING. ACCEPT FromAccount. DISPLAY "To > " WITH NO ADVANCING. accept ToAccount. DISPLAY "Amount > " WITH NO ADVANCING. ACCEPT Amount. WRITE TransactionDetails. DISPLAY "Enter to add new record, 'Q' to quit > ". ACCEPT ShouldContinue. ===== GaloisGirl/Coding/AdventOfCode2021/d01a.cob ===== IDENTIFICATION DIVISION. PROGRAM-ID. AOC-2021-01-1. AUTHOR. ANNA KOSIERADZKA. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT INPUTFILE ASSIGN TO "d01.input" ORGANIZATION IS LINE SEQUENTIAL. DATA DIVISION. FILE SECTION. FD INPUTFILE. 01 INPUTRECORD PIC X(4). WORKING-STORAGE SECTION. 01 FILE-STATUS PIC 9 VALUE 0. 01 WS-MEASURE PIC 9(4). 01 WS-PREV-MEASURE PIC 9(4) VALUE 9999. 01 WS-NUM PIC 9(4) VALUE 0. PROCEDURE DIVISION. 001-MAIN. OPEN INPUT INPUTFILE. PERFORM 002-READ UNTIL FILE-STATUS = 1. CLOSE INPUTFILE. DISPLAY WS-NUM. STOP RUN. 002-READ. READ INPUTFILE AT END MOVE 1 TO FILE-STATUS NOT AT END PERFORM 003-PROCESS-RECORD END-READ. 003-PROCESS-RECORD. COMPUTE WS-MEASURE = FUNCTION NUMVAL(INPUTRECORD) IF WS-MEASURE > WS-PREV-MEASURE THEN ADD 1 TO WS-NUM END-IF COMPUTE WS-PREV-MEASURE = WS-MEASURE. ===== stawi/cobol85parser/src/test/resources/io/proleap/cobol/preprocessor/copy/copyreplace/variable/CopyReplace.cbl ===== 000100 Identification Division. 000200 Program-ID. 000300 HELLOWORLD. 000400 Procedure Division. 000500 COPY CopyReplace1 REPLACING This BY Z (1, 2, 3). 000500 COPY CopyReplace2 REPLACING ==That== BY ==DISPLAY==. 000600 STOP RUN. ===== alansferreira/vscode_cobol/src/test/Program1.cbl ===== program-id. Program1. working-storage section. 01 MyFirstStorageItem pic x(10). procedure division. goback. end program Program1.