COBOL（Common Business-Oriented Language）是 1959 年問世的編譯程式語言，
最早是以 Grace Hopper 開發的 FLOW-MATIC 語言為範本，
是最早實施標準化的計算機語言之一，專為商業資料處理設計，語法接近英文並且結構冗長，代碼類似英語句子這使得即使非工程師也比較容易閱讀其邏輯，
廣泛應用於大型主機（Mainframe）金融交易、企業薪資計算、庫存管理等需要高處理量與穩定的領域，
目前最新的語言標準版本為 ISO/IEC 1989:2023。
商業軟體方面，比較有名的編譯器實作為 IBM Enterprise COBOL, Micro Focus Visual COBOL,
Fujitsu NetCOBOL 以及 Veryant isCOBOL 等軟體。而開放原始碼的 COBOL 編譯器主要有二套，
一個是將 COBOL 原始碼轉譯為 C 語言以後編譯的 GnuCOBOL，
一個是自 GCC 15.1 開始加入的 COBOL 編譯器 GCC COBOL。
在 openSUSE 安裝 GnuCOBOL：
sudo zypper in gnucobol
在 openSUSE 安裝 GCC COBOL：
sudo zypper in gcc-cobol
COBOL 在語法上不區分大小寫（Case-insensitive），因此保留字、變數名稱、段落名稱等，使用大寫、小寫或混合大小寫書寫，
對編譯器而言都是相同的。在 COBOL-85 標準之前，COBOL 程式通常要求全部使用大寫字母編寫。現代 COBOL 雖然允許使用小寫，
但為了維持舊代碼的兼容性和傳統習慣，許多開發者仍習慣使用全大寫。
程式碼分為四大部：IDENTIFICATION DIVISION（識別部）、ENVIRONMENT DIVISION（設備部）、
DATA DIVISION（資料部）和 PROCEDURE DIVISION（程序部）。
IDENTIFICATION DIVISION（識別部）必須是每個 COBOL 程式中的第一個區部。
識別部主要功能為命名程式，並且可以包含寫入程式的日期、編譯的日期，以及其他有關程式的這類文件記錄資訊。
ENVIRONMENT DIVISION（設備部）是選用資訊，
可能的內容為 Configuration Section Paragraphs 與 Input-Output Section Paragraphs。
DATA DIVISION（資料部）用來宣告變數資訊，
可能的內容為 File Section, Working-Storage Section, Local-Storage Section 與 Linkage Section。
PROCEDURE DIVISION（程序部）就是 COBOL 的程式碼部份。
All COBOL programs are organized in a structure that consists of divisions,
sections, paragraphs, sentences, statements, clauses, and phrases.
This structure is hierarchical--that is, as a general rule,
- a COBOL program is made up of divisions;
- a division is made up of sections;
- a section is made up of paragraphs;
- a paragraph is made up of either sentences or clauses (depending upon the division);
a sentence can contain one or more statements;
- a statement or clause can contain one or more phrases.
COBOL can be written in two formats: fixed (the default) or free. In fixed-format,
code must be aligned to fit in certain areas (a holdover from using punched cards).
Until COBOL 2002, these were:
| Name
|
Column(s)
|
Usage
|
| Sequence number area
|
1–6
|
Originally used for card/line numbers (facilitating mechanical punched card sorting to assure intended program code sequence after manual editing/handling), this area is ignored by the compiler
|
| Indicator area
|
7
|
The following characters are allowed here:
* – Comment line/ – Comment line that will be printed on a new page of a source listing- – Continuation line, where words or literals from the previous line are continuedD – Line enabled in debugging mode, which is otherwise ignored
|
| Area A
|
8–11
|
This contains: DIVISION, SECTION and procedure headers; 01 and 77 level numbers and file/report descriptors
|
| Area B
|
12–72
|
Any other code not allowed in Area A
|
| Program name area
|
73–
|
Historically up to column 80 for punched cards, it is used to identify the program or sequence the card belongs to
|
In COBOL 2002, Areas A and B were merged to form the program-text area,
which now ends at an implementor-defined column.
COBOL 2002 also introduced free-format code. Free-format code can be placed in any column of the file,
as in newer programming languages. Comments are specified using *>,
which can be placed anywhere and can also be used in fixed-format source code. Continuation lines are not present,
and the >>PAGE directive replaces the / indicator.
下面是一個 Hello World 的例子 (fixed format)：
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO-WORLD.
PROCEDURE DIVISION.
DISPLAY 'Hello, World!'.
STOP RUN.
下面是使用 GOBACK 的寫法：
IDENTIFICATION DIVISION.
PROGRAM-ID. hello.
PROCEDURE DIVISION.
DISPLAY "Hello, world!"
GOBACK.
END PROGRAM hello.
使用 GnuCOBOL 編譯：
cobc -x hello.cob
使用 GCC COBOL 編譯：
gcobol -main hello.cob -o hello
下面是一個 Hello World 的例子 (free format)：
*> COBOL Hello World program
identification division.
program-id. hello.
procedure division.
display "Hello World! ".
goback.
使用 GnuCOBOL 編譯：
cobc -x -free hello.cob
使用 GCC COBOL 編譯：
gcobol -ffree-form -main hello.cob -o hello
Data Division
Data Division is used to define the variables used in a program. To describe data in COBOL,
one must understand the following terms −
- Level Number
- Data Name
- Picture Clause
- Value Clause
Standard COBOL provides the following data types:
| Data type
|
Sample declaration
|
Notes
|
| Alphabetic
|
PIC A(30)
|
May contain only letters or spaces.
|
| Alphanumeric
|
PIC X(30)
|
May contain any characters.
|
| Boolean
|
PIC 1 USAGE BIT
|
Data stored in the form of 0s and 1s, as a binary number.
|
| Index
|
USAGE INDEX
|
Used to reference table elements.
|
| National
|
PIC N(30)
|
Similar to alphanumeric, but using an extended character set, e.g. UTF-8.
|
| Numeric
|
PIC 9(5)V9(2)
|
Contains exactly 7 digits (7=5+2). 'V' locates the implicit decimal in a fixed point number.
|
| Object
|
USAGE OBJECT REFERENCE
|
May reference either an object or NULL.
|
| Pointer
|
USAGE POINTER
|
|
Data items in COBOL are declared hierarchically through the use of level-numbers
which indicate if a data item is part of another.
An item with a higher level-number is subordinate to an item with a lower one.
Top-level data items, with a level-number of 1, are called records.
Items that have subordinate aggregate data are called group items;
those that do not are called elementary items.
Level-numbers used to describe standard data items are between 1 and 49.
01 some-record. *> Aggregate group record item
05 num PIC 9(10). *> Elementary item
05 the-date. *> Aggregate (sub)group record item
10 the-year PIC 9(4). *> Elementary item
10 the-month PIC 99. *> Elementary item
10 the-day PIC 99. *> Elementary item
A level-number of 66 is used to declare a re-grouping of previously defined items,
irrespective of how those items are structured.
This data level, also referred to by the associated RENAMES clause.
01 customer-record.
05 cust-key PIC X(10).
05 cust-name.
10 cust-first-name PIC X(30).
10 cust-last-name PIC X(30).
05 cust-dob PIC 9(8).
05 cust-balance PIC 9(7)V99.
66 cust-personal-details RENAMES cust-name THRU cust-dob.
66 cust-all-details RENAMES cust-name THRU cust-balance.
A 77 level-number indicates the item is stand-alone, and in such situations is equivalent to the level-number 01.
An 88 level-number declares a condition name (a so-called 88-level) which is true
when its parent data item contains one of the values specified in its VALUE clause.
01 wage-type PIC X.
88 wage-is-hourly VALUE "H".
88 wage-is-yearly VALUE "S", "Y".
A PICTURE (or PIC) clause is a string of characters,
each of which represents a portion of the data item and what it may contain.
Some picture characters specify the type of the item and how many characters or digits it occupies in memory.
For example, a 9 indicates a decimal digit, and an S indicates that the item is signed.
Other picture characters (called insertion and editing characters) specify how an item should be formatted.
The USAGE clause declares the format in which data is stored. Depending on the data type,
it can either complement or be used instead of a PICTURE clause.
While it can be used to declare pointers and object references,
it is mostly geared towards specifying numeric types.
- BINARY, where a minimum size is either specified by the PICTURE clause or
by a USAGE clause such as BINARY-LONG.
- USAGE COMPUTATIONAL, where data may be stored in whatever format the implementation provides;
often equivalent to USAGE BINARY. A computational item is a value used in arithmetic operations.
It must be numeric. If a group item is described with a computational usage,
the elementary items within the group have that usage.
- USAGE DISPLAY, the default format, where data is stored as a string
- COMPUTATIONAL-1 or COMP-1 specified for internal floating-point items (single precision).
COMP-1 items are 4 bytes long.
- COMPUTATIONAL-2 or COMP-2 (long floating-point) specified
for internal floating-point items (double precision).
COMP-2 items are 8 bytes long.
- COMPUTATIONAL-3 or COMP-3 (internal decimal) is the equivalent of PACKED-DECIMAL.
PACKED-DECIMAL specified for internal decimal items.
- USAGE NATIONAL, where data is stored as a string using an extended character set
- USAGE PACKED-DECIMAL,
where data is stored in the smallest possible decimal format (typically packed binary-coded decimal)
Value clause is an optional clause which is used to initialize the data items.
The values can be numeric literal, alphanumeric literal, or figurative constant.
It can be used with both group and elementary items.
下面是一個宣告變數的例子：
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-NAME PIC A(6) VALUE 'ABCDEF'.
PROCEDURE DIVISION.
DISPLAY "WS-NAME : "WS-NAME.
STOP RUN.
In COBOL, the WORKING-STORAGE SECTION and LOCAL-STORAGE SECTION are
both part of the Data Division used to define internal variables,
but they differ fundamentally in how they manage memory and handle program calls.
Use WORKING-STORAGE SECTION for standard variables, counters,
or flags that need to retain their values if a subprogram is called multiple times without being cancelled.
Use LOCAL-STORAGE SECTION when writing recursive programs (where a program calls itself)
to ensure each "level" of recursion has its own set of variables.
It is also preferred in multi-threaded applications to avoid data corruption between threads.
COBOL Copybook 是一種包含 COBOL 程式碼的外部檔案，主要定義資料結構（如 01 階層式記錄），
可被多個程式透過 COPY 語句引入。它能實現結構定義的統一管理，確保資料一致性，通常使用 .cpy 副檔名儲存。
STUDENT.cpy
01 STUDENT-RECORD.
05 STUDENT-ID PIC 9(05).
05 STUDENT-NAME.
10 FIRST-NAME PIC X(20).
10 LAST-NAME PIC X(20).
05 DATE-OF-BIRTH PIC 9(08).
05 ENROLLMENT-STATUS PIC X(01).
88 ACTIVE-STUDENT VALUE 'A'.
88 INACTIVE-STUDENT VALUE 'I'.
STU-INFO.cob
IDENTIFICATION DIVISION.
PROGRAM-ID. STU-INFO.
DATA DIVISION.
WORKING-STORAGE SECTION.
* The COPY statement pulls in the code from STUDENT.cpy
COPY STUDENT.
PROCEDURE DIVISION.
MOVE 12345 TO STUDENT-ID.
MOVE "JOHN" TO FIRST-NAME.
SET ACTIVE-STUDENT TO TRUE.
DISPLAY "STUDENT ID: " STUDENT-ID.
DISPLAY "STATUS: " ENROLLMENT-STATUS.
STOP RUN.
Basic Verbs
COBOL 動詞 (verbs) 在 procedure division 中用於資料處理。
語句 (statement) 總是以 COBOL 動詞開頭。
Initialize 用來初始化變數。MOVE 可以用來複製資料以及設定變數的值，
而 SET 用來設定 table indexes, conditional variables (88-level)
以及指標 (pointers)。
而 ADD, SUBTRACT, MULTIPLY, DIVIDE 用來作為數值加滅乘除之用，
Compute 則是可以用來編寫算術表達式，可以使用 Compute 取代 ADD, SUBTRACT, MULTIPLY, DIVIDE。
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-VAR1 PIC 9(3).
01 WS-VAR2 PIC 9(3).
PROCEDURE DIVISION.
MAIN-PARA.
INITIALIZE WS-VAR1 REPLACING NUMERIC DATA BY 010.
MOVE 010 TO WS-VAR2.
DIVIDE 10 INTO WS-VAR1.
MULTIPLY WS-VAR1 BY 2 GIVING WS-VAR1.
ADD 4 TO WS-VAR1.
SUBTRACT 3 FROM WS-VAR1.
COMPUTE WS-VAR2 = (((WS-VAR2 / 10) * 2) + 4) - 3
DISPLAY "WS-VAR1 is : " WS-VAR1.
DISPLAY "WS-VAR2 is : " WS-VAR2.
STOP RUN.
ACCEPT 可以用來自標準輸入 (STDIN) 取得輸入資料。
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-STUDENT-NAME PIC X(25).
PROCEDURE DIVISION.
ACCEPT WS-STUDENT-NAME.
DISPLAY "Name : " WS-STUDENT-NAME.
STOP RUN.
DISPLAY 與 ACCEPT 在 COBOL 的作用很多，下面是取得環境變數 PATH 的程式。
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 VAR-VALUE PIC X(160).
PROCEDURE DIVISION.
DISPLAY "PATH" UPON ENVIRONMENT-NAME.
ACCEPT VAR-VALUE FROM ENVIRONMENT-VALUE.
DISPLAY "Value is: " VAR-VALUE.
GOBACK.
Modern COBOL 加入了動態配置記憶體的能力，使用 ALLOCATE 配置記憶體，FREE 釋放記憶體，
USAGE POINTER 用來宣告一個指標 (pointer) 變數。
我們需要在 LINKAGE SECTION 宣告與定義 based data item，這是用來定義指標存取的變數。
而後在 WORKING-STORAGE SECTION 或者是 LOCAL-STORAGE SECTION 使用 USAGE POINTER 宣告一個指標變數。
在 ALLOCATE 時 INITIALIZED 關鍵字並非是必要的，其作用是確保分配的記憶體被清除為零或設定為預設值。
LINKAGE SECTION.
01 MY-DATA-ITEM BASED.
05 ITEM-NAME PIC X(20).
05 ITEM-ID PIC 9(05).
LOCAL-STORAGE SECTION.
01 LS-POINTER USAGE POINTER.
下面就是全部的例子：
IDENTIFICATION DIVISION.
PROGRAM-ID. example.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 LS-POINTER USAGE POINTER.
LINKAGE SECTION.
01 MY-DATA-ITEM BASED.
05 ITEM-NAME PIC X(20).
05 ITEM-ID PIC 9(05).
PROCEDURE DIVISION.
ALLOCATE MY-DATA-ITEM INITIALIZED RETURNING LS-POINTER.
IF LS-POINTER = NULL
DISPLAY "Allocation failed"
STOP RUN
END-IF
*> Link the pointer to the based structure
SET ADDRESS OF MY-DATA-ITEM TO LS-POINTER.
MOVE "Sample Name" TO ITEM-NAME
MOVE 12345 TO ITEM-ID.
DISPLAY ITEM-NAME
DISPLAY ITEM-ID
FREE LS-POINTER
SET LS-POINTER TO NULL
STOP RUN.
Conditional Statements
COBOL 使用 IF 進行條件判斷。要注意的是，COBOL 只有 IF ... ELSE 結構，並沒有直接支援 ELSE IF，
但是可以在 ELSE 下使用 IF 條件句進行更多的條件判斷。
CONTINUE 這個關鍵字在 COBOL 是 no-op 的意思，通常是為了程式結構完整而使用這個關鍵字。
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-NUM1 PIC 9(2).
01 WS-NUM2 PIC 9(2).
PROCEDURE DIVISION.
MOVE 25 TO WS-NUM1.
MOVE 15 TO WS-NUM2.
IF WS-NUM1 = WS-NUM2 THEN
CONTINUE
ELSE
IF WS-NUM1 < WS-NUM2 THEN
DISPLAY WS-NUM1 " < " WS-NUM2 "."
ELSE
DISPLAY WS-NUM1 " > " WS-NUM2 "."
END-IF
END-IF.
STOP RUN.
如果需要多於一個以上的比較，可以使用 EVALUATE。
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-A PIC 9 VALUE 0.
PROCEDURE DIVISION.
MOVE 3 TO WS-A.
EVALUATE TRUE
WHEN WS-A > 2
DISPLAY 'WS-A GREATER THAN 2'
WHEN WS-A < 0
DISPLAY 'WS-A LESS THAN 0'
WHEN OTHER
DISPLAY 'INVALID VALUE OF WS-A'
END-EVALUATE.
STOP RUN.
Loop Statements
GO TO 陳述式是 COBOL 無條件轉移控制權的機制。
GO TO 會直接跳轉到程式中指定的段落（Paragraph）或節（Section）繼續執行。
在軟體開發引入結構化程式設計以後，COBOL 使用 PERFORM 進行迴圈控制流程，
一般而言建議盡量使用 PERFORM 進行結構化的程式設計。
PERFORM 用來呼叫其它的 paragraph。
IDENTIFICATION DIVISION.
PROGRAM-ID. COUNT.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-I PIC 9 VALUE 1.
PROCEDURE DIVISION.
MAIN-PARA.
DISPLAY 'Starting Program'
PERFORM 1000-PROCESS-DATA
DISPLAY 'Finished Program'
STOP RUN.
1000-PROCESS-DATA.
DISPLAY 'Inside the paragraph'.
Perform Thru 用來執行一系列的 paragraph。
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
PROCEDURE DIVISION.
A-PARA.
PERFORM DISPLAY 'IN A-PARA'
END-PERFORM.
PERFORM C-PARA THRU E-PARA.
B-PARA.
DISPLAY 'IN B-PARA'.
STOP RUN.
C-PARA.
DISPLAY 'IN C-PARA'.
D-PARA.
DISPLAY 'IN D-PARA'.
E-PARA.
DISPLAY 'IN E-PARA'.
用來執行重覆多少次的迴圈。
IDENTIFICATION DIVISION.
PROGRAM-ID. COUNT.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-I PIC 9 VALUE 1.
PROCEDURE DIVISION.
PERFORM 3 TIMES
DISPLAY "It is " WS-I
ADD 1 TO WS-I
END-PERFORM.
STOP RUN.
PERFORM UNTIL 用來執行類似其它語言 WHILE 語句的迴圈。
IDENTIFICATION DIVISION.
PROGRAM-ID. COUNT.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-COUNTER PIC 9 VALUE 1.
PROCEDURE DIVISION.
PERFORM UNTIL WS-COUNTER > 5
DISPLAY "Counter is: " WS-COUNTER
ADD 1 TO WS-COUNTER
END-PERFORM.
STOP RUN.
下面是另外一個例子：
IDENTIFICATION DIVISION.
PROGRAM-ID. LOOP.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-NUMBER PIC 9(4) VALUE 4096.
PROCEDURE DIVISION.
PERFORM UNTIL NOT 0 < WS-NUMBER
DISPLAY WS-NUMBER
DIVIDE 2 INTO WS-NUMBER
END-PERFORM.
STOP RUN.
PERFORM WITH TEST AFTER UNTIL 用來執行類似其它語言 DO WHILE 語句的迴圈，
對於至少要執行一次的情況十分有用。
IDENTIFICATION DIVISION.
PROGRAM-ID. loop-do-while.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 i PIC 99 VALUE 0.
PROCEDURE DIVISION.
PERFORM WITH TEST AFTER UNTIL FUNCTION MOD(i, 6) = 0
ADD 1 TO i
DISPLAY i
END-PERFORM
GOBACK.
PERFORM VARYING 用來執行類似其它語言 FOR 語句的迴圈。下面實作了九九乘法表：
IDENTIFICATION DIVISION.
PROGRAM-ID. MULT-TABLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 I PIC 99 VALUE 1.
01 J PIC 99 VALUE 1.
01 RESULT PIC 99.
PROCEDURE DIVISION.
MAIN-PROCEDURE.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > 9
PERFORM VARYING J FROM 1 BY 1 UNTIL J > 9
COMPUTE RESULT = I * J
DISPLAY I " x " J " = " RESULT
END-PERFORM
END-PERFORM.
STOP RUN.
（注意：經過實測，如果 I 或者是 J 宣告為 PIC 9，因為需要其值為 10 才能夠達成停止條件，
這樣迴圈並無法停止，也就是形成了無窮迴圈）
在 COBOL 2014 標準提出了 EXIT PERFORM CYCLE 中斷迴圈此次循環以及 EXIT PERFORM 中斷迴圈的語句，
但是不是所有的 COBOL 編譯器都有支援。
Write a program that displays the digits from 1 to n then back down to 1;
for instance, if n = 5, the program should display 123454321.
You are permitted to use only a single for loop. The range is 0 < n < 10.
IDENTIFICATION DIVISION.
PROGRAM-ID. NUMBER-COUNT.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-NUMBER PIC 9.
PROCEDURE DIVISION.
ACCEPT WS-NUMBER FROM COMMAND-LINE.
IF WS-NUMBER < 1 OR WS-NUMBER > 9 THEN
DISPLAY 'INVALID VALUE'
STOP RUN
END-IF.
EVALUATE TRUE
WHEN WS-NUMBER = 1
DISPLAY '1'
WHEN WS-NUMBER = 2
DISPLAY '121'
WHEN WS-NUMBER = 3
DISPLAY '12321'
WHEN WS-NUMBER = 4
DISPLAY '1234321'
WHEN WS-NUMBER = 5
DISPLAY '123454321'
WHEN WS-NUMBER = 6
DISPLAY '12345654321'
WHEN WS-NUMBER = 7
DISPLAY '1234567654321'
WHEN WS-NUMBER = 8
DISPLAY '123456787654321'
WHEN WS-NUMBER = 9
DISPLAY '12345678987654321'
WHEN OTHER
DISPLAY 'INVALID VALUE'
END-EVALUATE.
STOP RUN.
要注意的是，命令列通常以空白作為區隔參數的符號，
而這裡使用的 COMMAND-LINE 會拿到一個將全部的命令列參數視為整體的字串（參數之間以空白區隔），
這也是大多數的 COBOL 編譯器都支援的方式。至於命令列參數的總數以及存取個別參數的方式，
因為 COBOL 標準沒有定義，所以不同的 COBOL 編譯器有其自己的實作。
改寫為使用迴圈的寫法：
IDENTIFICATION DIVISION.
PROGRAM-ID. NUMBER-COUNT.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-NUMBER PIC 9.
01 WS-POSITIVE PIC 9 VALUE 1.
01 WS-COUNT PIC 9 VALUE 0.
PROCEDURE DIVISION.
ACCEPT WS-NUMBER FROM COMMAND-LINE.
IF WS-NUMBER < 1 OR WS-NUMBER > 9 THEN
DISPLAY 'INVALID VALUE'
STOP RUN
END-IF.
PERFORM UNTIL 1 < 0
IF WS-POSITIVE IS EQUAL TO 1 THEN
ADD 1 TO WS-COUNT
DISPLAY WS-COUNT WITH NO ADVANCING
IF WS-COUNT IS EQUAL TO WS-NUMBER THEN
MOVE 0 TO WS-POSITIVE
END-IF
ELSE
SUBTRACT 1 FROM WS-COUNT
IF WS-COUNT IS GREATER THAN 0 THEN
DISPLAY WS-COUNT WITH NO ADVANCING
ELSE
EXIT PERFORM
END-IF
END-IF
END-PERFORM.
DISPLAY " "
STOP RUN.
下面是一個讓使用者輸入一個數字以後，猜測與隨機製造的數字是否相同的遊戲：
IDENTIFICATION DIVISION.
PROGRAM-ID. RANDOM-EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-RESULT PIC 9(4).
01 WS-ANSWER PIC 9(4).
PROCEDURE DIVISION.
COMPUTE WS-RESULT = (FUNCTION RANDOM * 999) + 1
PERFORM UNTIL 1 < 0
DISPLAY "Please give a number (1-1000): "
WITH NO ADVANCING
ACCEPT WS-ANSWER
IF WS-ANSWER IS EQUAL TO WS-RESULT THEN
EXIT PERFORM
ELSE
IF WS-ANSWER IS GREATER THAN WS-RESULT THEN
DISPLAY "Please guess more lower"
ELSE
DISPLAY "Please guess more higher"
END-IF
END-IF
END-PERFORM.
STOP RUN.
其中 PERFORM UNTIL 1 < 0 是一個無窮迴圈，也可以寫為 PERFORM UNTIL 1 <> 1，
GnuCOBOL 提供了非標準寫法 PERFORM FOREVER。
String Handling
Inspect verb is used to count or replace the characters in a string.
String operations can be performed on alphanumeric, numeric, or alphabetic values.
Inspect operations are performed from left to right.
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-CNT1 PIC 9(2) VALUE 0.
01 WS-CNT2 PIC 9(2) VALUE 0.
01 WS-STRING PIC X(18) VALUE 'ABCDACDADEAAAFFABC'.
PROCEDURE DIVISION.
INSPECT WS-STRING TALLYING WS-CNT1 FOR ALL 'A'.
DISPLAY "WS-CNT1 : "WS-CNT1
INSPECT WS-STRING TALLYING WS-CNT2 FOR CHARACTERS.
DISPLAY "WS-CNT2 : "WS-CNT2
STOP RUN.
下面是用來取代某個字元的範例。
Write a program to replace the character ’e’ with ‘E’ in the string ‘Weekly Challenge’.
Also print the number of times the character ’e’ is found in the string.
IDENTIFICATION DIVISION.
PROGRAM-ID. REPLACE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-COUNT PIC 9(2) VALUE 0.
01 WS-STRING PIC X(16) VALUE 'Weekly Challenge'.
PROCEDURE DIVISION.
INSPECT WS-STRING TALLYING WS-COUNT FOR ALL 'e'.
DISPLAY "Find e " WS-COUNT " times.".
INSPECT WS-STRING REPLACING ALL "e" BY "E".
DISPLAY "NEW STRING: "WS-STRING.
STOP RUN.
下面是 1-9 位數不重複印出來的練習問題。
這裡使用了 PIC Z 的定義，它的主要作用是抑制前導零（Zero Suppression）。
當對應的數值為零時，Z 字元會將該數字位置顯示為空白，讓輸出結果更易讀。
IDENTIFICATION DIVISION.
PROGRAM-ID. LIST-NUMBER.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-CNT1 PIC 9.
01 WS-FLAG PIC 9.
01 WS-NUMBER PIC Z(8)9.
LOCAL-STORAGE SECTION.
01 LS-NUM PIC 9 USAGE BINARY.
01 LS-MAX PIC 9(9) USAGE BINARY.
01 LS-INDEX PIC 9(10) USAGE BINARY.
PROCEDURE DIVISION.
MAIN-PARA.
DISPLAY "Please give a number: " WITH NO ADVANCING
ACCEPT LS-NUM
IF LS-NUM < 1 OR LS-NUM > 9 THEN
DISPLAY "INVALID DATA."
STOP RUN
END-IF.
COMPUTE LS-MAX = 10 ** LS-NUM - 1
PERFORM VARYING LS-INDEX FROM 1 BY 1 UNTIL LS-INDEX > LS-MAX
MOVE 0 TO WS-FLAG
MOVE LS-INDEX TO WS-NUMBER
PERFORM CHECK-PARA
IF WS-FLAG IS EQUAL TO 0 THEN
DISPLAY FUNCTION TRIM(WS-NUMBER)
END-IF
END-PERFORM.
STOP RUN.
CHECK-PARA.
MOVE 0 TO WS-CNT1
INSPECT WS-NUMBER TALLYING WS-CNT1 FOR ALL '1'.
IF WS-CNT1 IS GREATER THAN 1 THEN
MOVE 1 TO WS-FLAG
EXIT PARAGRAPH
END-IF.
MOVE 0 TO WS-CNT1
INSPECT WS-NUMBER TALLYING WS-CNT1 FOR ALL '2'.
IF WS-CNT1 IS GREATER THAN 1 THEN
MOVE 1 TO WS-FLAG
EXIT PARAGRAPH
END-IF.
MOVE 0 TO WS-CNT1
INSPECT WS-NUMBER TALLYING WS-CNT1 FOR ALL '3'.
IF WS-CNT1 IS GREATER THAN 1 THEN
MOVE 1 TO WS-FLAG
EXIT PARAGRAPH
END-IF.
MOVE 0 TO WS-CNT1
INSPECT WS-NUMBER TALLYING WS-CNT1 FOR ALL '4'.
IF WS-CNT1 IS GREATER THAN 1 THEN
MOVE 1 TO WS-FLAG
EXIT PARAGRAPH
END-IF.
MOVE 0 TO WS-CNT1
INSPECT WS-NUMBER TALLYING WS-CNT1 FOR ALL '5'.
IF WS-CNT1 IS GREATER THAN 1 THEN
MOVE 1 TO WS-FLAG
EXIT PARAGRAPH
END-IF.
MOVE 0 TO WS-CNT1
INSPECT WS-NUMBER TALLYING WS-CNT1 FOR ALL '6'.
IF WS-CNT1 IS GREATER THAN 1 THEN
MOVE 1 TO WS-FLAG
EXIT PARAGRAPH
END-IF.
MOVE 0 TO WS-CNT1
INSPECT WS-NUMBER TALLYING WS-CNT1 FOR ALL '7'.
IF WS-CNT1 IS GREATER THAN 1 THEN
MOVE 1 TO WS-FLAG
EXIT PARAGRAPH
END-IF.
MOVE 0 TO WS-CNT1
INSPECT WS-NUMBER TALLYING WS-CNT1 FOR ALL '8'.
IF WS-CNT1 IS GREATER THAN 1 THEN
MOVE 1 TO WS-FLAG
EXIT PARAGRAPH
END-IF.
MOVE 0 TO WS-CNT1
INSPECT WS-NUMBER TALLYING WS-CNT1 FOR ALL '9'.
IF WS-CNT1 IS GREATER THAN 1 THEN
MOVE 1 TO WS-FLAG
EXIT PARAGRAPH
END-IF.
MOVE 0 TO WS-CNT1
INSPECT WS-NUMBER TALLYING WS-CNT1 FOR ALL '0'.
IF WS-CNT1 IS GREATER THAN 1 THEN
MOVE 1 TO WS-FLAG
EXIT PARAGRAPH
END-IF.
String verb is used to concatenate the strings.
Using STRING statement, two or more strings of characters can be combined to form a longer string.
Delimited By clause is compulsory.
DELIMITED BY SIZE moves the entire source field regardless of its content.
DELIMITED BY SPACE clause indicates that the transfer of characters from a source field stops
as soon as the first space is encountered.
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-STRING PIC A(30).
01 WS-STR1 PIC A(15) VALUE 'Tutorialspoint'.
01 WS-STR2 PIC A(7) VALUE 'Welcome'.
01 WS-STR3 PIC A(7) VALUE 'To AND'.
01 WS-COUNT PIC 99 VALUE 1.
PROCEDURE DIVISION.
STRING WS-STR2 DELIMITED BY SIZE
WS-STR3 DELIMITED BY SPACE
WS-STR1 DELIMITED BY SIZE
INTO WS-STRING
WITH POINTER WS-COUNT
ON OVERFLOW DISPLAY 'OVERFLOW!'
END-STRING.
DISPLAY 'WS-STRING : 'WS-STRING.
DISPLAY 'WS-COUNT : 'WS-COUNT.
STOP RUN.
Unstring verb is used to split one string into multiple sub-strings. Delimited By clause is compulsory.
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-STRING PIC A(30) VALUE 'WELCOME TO TUTORIALSPOINT'.
01 WS-STR1 PIC A(7).
01 WS-STR2 PIC A(2).
01 WS-STR3 PIC A(15).
PROCEDURE DIVISION.
UNSTRING WS-STRING DELIMITED BY SPACE
INTO WS-STR1, WS-STR2, WS-STR3
END-UNSTRING.
DISPLAY 'WS-STR1 : 'WS-STR1.
DISPLAY 'WS-STR2 : 'WS-STR2.
DISPLAY 'WS-STR3 : 'WS-STR3.
STOP RUN.
Table Processing
Arrays in COBOL are known as tables. Table is declared in Data Division.
Occurs clause is used to define a table.
Occurs clause indicates the repetition of data name definition.
It can be used only with level numbers starting from 02 to 49.
Do not use occurs clause with Redefines.
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-TABLE.
05 WS-A PIC A(10) VALUE 'TUTORIALS' OCCURS 5 TIMES.
PROCEDURE DIVISION.
DISPLAY "ONE-D TABLE : "WS-TABLE.
STOP RUN.
下面是另外一個例子。
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-TABLE.
05 WS-A OCCURS 2 TIMES.
10 WS-B PIC A(10) VALUE ' TUTORIALS'.
10 WS-C OCCURS 2 TIMES.
15 WS-D PIC X(6) VALUE ' POINT'.
PROCEDURE DIVISION.
DISPLAY "TWO-D TABLE : "WS-TABLE.
STOP RUN.
Table individual elements can be accessed by using subscript.
Subscript values can range from 1 to the number of times the table occurs.
A subscript can be any positive number. It does not require any declaration in data division.
It is automatically created with occurs clause.
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-TABLE.
05 WS-A OCCURS 3 TIMES.
10 WS-B PIC A(2).
10 WS-C OCCURS 2 TIMES.
15 WS-D PIC X(3).
PROCEDURE DIVISION.
MOVE '12ABCDEF34GHIJKL56MNOPQR' TO WS-TABLE.
DISPLAY 'WS-TABLE : ' WS-TABLE.
DISPLAY 'WS-A(1) : ' WS-A(1).
DISPLAY 'WS-C(1 1) : ' WS-C(1 1).
DISPLAY 'WS-C(1 2) : ' WS-C(1 2).
DISPLAY 'WS-A(2) : ' WS-A(2).
DISPLAY 'WS-C(2 1) : ' WS-C(2 1).
DISPLAY 'WS-C(2 2) : ' WS-C(2 2).
DISPLAY 'WS-A(3) : ' WS-A(3).
DISPLAY 'WS-C(3 1) : ' WS-C(3 1).
DISPLAY 'WS-C(3 2) : ' WS-C(3 2).
STOP RUN.
Table elements can also be accessed using index.
An index is a displacement of element from the start of the table.
An index is declared with Occurs clause using INDEXED BY clause.
The value of index can be changed using SET statement and PERFORM Varying option.
IDENTIFICATION DIVISION.
PROGRAM-ID. HELLO.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-TABLE.
05 WS-A OCCURS 3 TIMES INDEXED BY I.
10 WS-B PIC A(2).
10 WS-C OCCURS 2 TIMES INDEXED BY J.
15 WS-D PIC X(3).
PROCEDURE DIVISION.
MOVE '12ABCDEF34GHIJKL56MNOPQR' TO WS-TABLE.
PERFORM A-PARA VARYING I FROM 1 BY 1 UNTIL I > 3
STOP RUN.
A-PARA.
PERFORM C-PARA VARYING J FROM 1 BY 1 UNTIL J > 2.
C-PARA.
DISPLAY WS-C(I,J).
COBOL 可以使用 SEARCH 搜尋未經排序的陣列 (serial search)，
以及使用 SEARCH ALL 搜尋已排序過的陣列 (binary search)。
下面是 SEARCH 的例子：
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-PRODUCT-TABLE.
05 WS-PRODUCT OCCURS 7 TIMES INDEXED BY PRD-IDX.
10 WS-PRODUCT-ID PIC 9(4).
10 WS-PRODUCT-NAME PIC X(20).
PROCEDURE DIVISION.
SET PRD-IDX TO 1.
MOVE 0001 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Good Orange" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 2.
MOVE 0002 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Seven games" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 3.
MOVE 2345 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Power toolkit" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 4.
MOVE 1234 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "HaoMiao Computer" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 5.
MOVE 0123 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Super MaoMao" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 6.
MOVE 1357 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Hey Walkman" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 7.
MOVE 3456 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Maxy cookie" TO WS-PRODUCT-NAME(PRD-IDX)
* You must manually initialize the index using the SET statement
* before starting the search
SET PRD-IDX TO 1.
SEARCH WS-PRODUCT
AT END
DISPLAY "Product not found."
WHEN WS-PRODUCT-ID (PRD-IDX) = 1234
DISPLAY "Found: " WS-PRODUCT-NAME (PRD-IDX)
END-SEARCH.
STOP RUN.
下面是 SEARCH ALL 的例子：
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-PRODUCT-TABLE.
05 WS-PRODUCT OCCURS 7 TIMES
ASCENDING KEY IS WS-PRODUCT-ID
INDEXED BY PRD-IDX.
10 WS-PRODUCT-ID PIC 9(4).
10 WS-PRODUCT-NAME PIC X(20).
01 WS-IDX PIC 9(4).
PROCEDURE DIVISION.
SET PRD-IDX TO 1.
MOVE 0001 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Good Orange" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 2.
MOVE 0002 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Seven games" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 3.
MOVE 2345 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Power toolkit" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 4.
MOVE 1234 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "HaoMiao Computer" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 5.
MOVE 0123 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Super MaoMao" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 6.
MOVE 1357 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Hey Walkman" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 7.
MOVE 3456 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Maxy cookie" TO WS-PRODUCT-NAME(PRD-IDX)
* The table must be defined with an ASCENDING or DESCENDING KEY
* clause and the data must be physically sorted by that key.
SEARCH ALL WS-PRODUCT
AT END
DISPLAY "Product not found."
WHEN WS-PRODUCT-ID (PRD-IDX) = 1234
DISPLAY "Found: " WS-PRODUCT-NAME (PRD-IDX)
END-SEARCH.
STOP RUN.
COBOL 可以使用 SORT 來對陣列或者是檔案進行排序。
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-PRODUCT-TABLE.
05 WS-PRODUCT OCCURS 7 TIMES INDEXED BY PRD-IDX.
10 WS-PRODUCT-ID PIC 9(4).
10 WS-PRODUCT-NAME PIC X(20).
01 WS-IDX PIC 9(4).
PROCEDURE DIVISION.
SET PRD-IDX TO 1.
MOVE 0001 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Good Orange" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 2.
MOVE 0002 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Seven games" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 3.
MOVE 2345 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Power toolkit" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 4.
MOVE 1234 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "HaoMiao Computer" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 5.
MOVE 0123 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Super MaoMao" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 6.
MOVE 1357 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Hey Walkman" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 7.
MOVE 3456 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Maxy cookie" TO WS-PRODUCT-NAME(PRD-IDX)
SORT WS-PRODUCT ON ASCENDING KEY WS-PRODUCT-ID.
PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 7
DISPLAY
WS-PRODUCT-ID(WS-IDX)
" - "
WS-PRODUCT-NAME(WS-IDX)
END-DISPLAY
END-PERFORM.
STOP RUN.
COBOL 使用 DEPENDING ON 支援可變長陣列 (Variable-length array)，
透過某個變數的值決定陣列大小。可變長陣列的實作使用的記憶體通常為堆疊 (stack)，所以需要注意配置陣列的大小，
如果配置過大的陣列會有問題。
下面是一個宣告的例子：
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DEPT-PEOPLE.
05 PEOPLE-CNT PIC S9(4) BINARY.
05 DEPT-PERSON OCCURS 0 TO 20 TIMES DEPENDING ON PEOPLE-CNT.
10 PERSON-NAME PIC X(20).
10 PERSON-WAGE PIC S9(7)V99 PACKED-DECIMAL.
File Handling
The concept of files in COBOL is different from that in C/C++.
COBOL file handling is a core feature designed to process large volumes of structured data efficiently.
It operates on logical records rather than raw text files,
typically interacting with Physical Sequential (PS) or VSAM files in mainframe environments.
COBOL supports three primary file types defined in the ENVIRONMENT DIVISION:
- Sequential: Records are stored and accessed in the order they were written.
- Indexed: Records are accessed using a unique primary key, allowing both sequential and random access.
- Relative: Records are stored in fixed slots and accessed via a Relative Record Number (RRN).
File handling requires entries across three main divisions:
- ENVIRONMENT DIVISION: Use the FILE-CONTROL Paragraph and SELECT clause to
map a program's internal logical file name to an external physical file (often via JCL).
- DATA DIVISION: The FILE SECTION contains the File Description (FD) entry,
which defines record length and layout.
- PROCEDURE DIVISION: Contains the logic to manipulate data using file handling verbs.
下面是主要的 COBOL 檔案讀寫的動詞 (verbs) 。
| Verb |
Description |
| OPEN |
Prepares the file for use. Common modes include INPUT (read only), OUTPUT (create/overwrite),
I-O (read and write), and EXTEND (append). |
| READ |
Fetches the next record from the file into the program's memory. |
| WRITE |
Saves a new record to the file. |
| REWRITE |
Updates an existing record (used in Indexed or Relative files). |
| DELETE |
Removes a record from Indexed or Relative files. |
| CLOSE |
Releases the file after processing is complete. |
我們將文字檔視為將一行作為一個 record 儲存並且以換行字元區隔的檔案，
因此可以這樣讀取 Linux 下的 /etc/os-release 並且取得 Linux Distribution Name：
IDENTIFICATION DIVISION.
PROGRAM-ID. READ-NAME.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MY-FILE ASSIGN TO '/etc/os-release'
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS WS-FILE-STATUS.
DATA DIVISION.
FILE SECTION.
FD MY-FILE.
01 MY-RECORD PIC X(80).
WORKING-STORAGE SECTION.
01 WS-FILE-STATUS PIC XX.
01 WS-EOF PIC X VALUE 'N'.
88 EOF-REACHED VALUE 'Y'.
77 WS-KEY PIC X(20).
77 WS-VAL PIC X(60).
PROCEDURE DIVISION.
MAIN-LOGIC.
OPEN INPUT MY-FILE
IF WS-FILE-STATUS NOT = "00"
DISPLAY "Error opening file: " WS-FILE-STATUS
STOP RUN
END-IF.
PERFORM UNTIL EOF-REACHED
READ MY-FILE
AT END
MOVE 'Y' TO WS-EOF
NOT AT END
PERFORM PARSE-STRING
IF WS-KEY = "NAME" THEN
DISPLAY WS-VAL
EXIT PERFORM
END-IF
END-READ
END-PERFORM
CLOSE MY-FILE
STOP RUN.
PARSE-STRING.
UNSTRING MY-RECORD
DELIMITED BY "="
INTO WS-KEY, WS-VAL
END-UNSTRING.
再來的例子是寫入陣列的資料到檔案。
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OUT-FILE ASSIGN TO 'product.dat'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD OUT-FILE.
01 OUT-RECORD.
10 OUT-PRODUCT-ID PIC 9(4).
10 OUT-PRODUCT-NAME PIC X(20).
WORKING-STORAGE SECTION.
01 WS-PRODUCT-TABLE.
05 WS-PRODUCT OCCURS 9 TIMES INDEXED BY PRD-IDX.
10 WS-PRODUCT-ID PIC 9(4).
10 WS-PRODUCT-NAME PIC X(20).
01 WS-INDEX PIC 9(4).
PROCEDURE DIVISION.
SET PRD-IDX TO 1.
MOVE 0001 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Good Orange" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 2.
MOVE 0002 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Seven games" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 3.
MOVE 2345 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Power toolkit" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 4.
MOVE 1234 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "HaoMiao Computer" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 5.
MOVE 0123 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Super MaoMao" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 6.
MOVE 1357 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Hey Walkman" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 7.
MOVE 3456 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Maxy cookie" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 8.
MOVE 9001 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Gold gift card" TO WS-PRODUCT-NAME(PRD-IDX)
SET PRD-IDX TO 9.
MOVE 9002 TO WS-PRODUCT-ID(PRD-IDX)
MOVE "Silver gift card" TO WS-PRODUCT-NAME(PRD-IDX)
OPEN OUTPUT OUT-FILE.
PERFORM VARYING WS-INDEX FROM 1 BY 1 UNTIL WS-INDEX > 9
MOVE WS-PRODUCT(WS-INDEX) TO OUT-RECORD
WRITE OUT-RECORD
END-PERFORM.
CLOSE OUT-FILE.
STOP RUN.
我們可以使用 SORT 對檔案資料進行排序。
Work file is used to hold records while the sort process is in progress.
Input file records are transferred to the work file for the sorting process.
This file should be defined in the File-Section under SD entry.
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IN-FILE ASSIGN TO 'product.dat'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT OUT-FILE ASSIGN TO 'product-sort.dat'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT WORK ASSIGN TO WRK.
DATA DIVISION.
FILE SECTION.
FD IN-FILE.
01 IN-RECORD.
10 IN-PRODUCT-ID PIC 9(4).
10 IN-PRODUCT-NAME PIC X(20).
FD OUT-FILE.
01 OUT-RECORD.
10 OUT-PRODUCT-ID PIC 9(4).
10 OUT-PRODUCT-NAME PIC X(20).
SD WORK.
01 WORK-RECORD.
05 WORK-ID PIC 9(4).
05 WORK-NAME PIC X(20).
PROCEDURE DIVISION.
SORT WORK ON ASCENDING KEY OUT-PRODUCT-ID
USING IN-FILE GIVING OUT-FILE.
DISPLAY 'Sort Successful'.
STOP RUN.
讀取排序後的資料：
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IN-FILE ASSIGN TO 'product-sort.dat'
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IS file-stat.
DATA DIVISION.
FILE SECTION.
FD IN-FILE.
01 IN-RECORD.
10 IN-PRODUCT-ID PIC 9(4).
10 IN-PRODUCT-NAME PIC X(20).
WORKING-STORAGE SECTION.
01 WS-PRODUCT-TABLE.
05 WS-PRODUCT-ID PIC 9(4).
05 WS-PRODUCT-NAME PIC X(20).
01 WS-EOF PIC A(1).
77 file-stat PIC XX.
PROCEDURE DIVISION.
OPEN INPUT IN-FILE
IF (file-stat = "35") THEN
DISPLAY "Error: File does not exist."
STOP RUN
END-IF.
PERFORM UNTIL WS-EOF='Y'
READ IN-FILE INTO WS-PRODUCT-TABLE
AT END MOVE 'Y' TO WS-EOF
NOT AT END
DISPLAY
WS-PRODUCT-ID " - " WS-PRODUCT-NAME
END-DISPLAY
END-READ
END-PERFORM.
CLOSE IN-FILE.
STOP RUN.
Subroutines
In COBOL, built-in functions are officially known as intrinsic functions.
They allow you to perform common mathematical, statistical,
and character-handling operations without writing complex procedural logic.
下面就是取得目前日期與時間的程式。
IDENTIFICATION DIVISION.
PROGRAM-ID. CURRENT-DATE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 Current-Date-Str.
03 Current-Year PIC X(4).
03 Current-Month PIC X(2).
03 Current-Day PIC X(2).
03 Current-Hour PIC 9(2).
03 Current-Minutes PIC 9(2).
03 Current-Seconds PIC 9(2).
PROCEDURE DIVISION.
MOVE FUNCTION CURRENT-DATE (1:14) TO Current-Date-Str
DISPLAY
Current-Year "-" Current-Month "-" Current-Day " "
Current-Hour ":" Current-Minutes ":" Current-Seconds
END-DISPLAY
GOBACK.
You are given a year.
Write a program to determine the Chinese Zodiac for the given year.
Please check out wikipage for more information about it.
The animal cycle: Rat, Ox, Tiger, Rabbit, Dragon, Snake, Horse, Goat, Monkey, Rooster, Dog, Pig.
The element cycle: Wood, Fire, Earth, Metal, Water.
IDENTIFICATION DIVISION.
PROGRAM-ID. Chinese-Zodiac.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 Element-Area.
03 Element-Data.
05 FILLER PIC X(5) VALUE "Wood".
05 FILLER PIC X(5) VALUE "Wood".
05 FILLER PIC X(5) VALUE "Fire".
05 FILLER PIC X(5) VALUE "Fire".
05 FILLER PIC X(5) VALUE "Earth".
05 FILLER PIC X(5) VALUE "Earth".
05 FILLER PIC X(5) VALUE "Metal".
05 FILLER PIC X(5) VALUE "Metal".
05 FILLER PIC X(5) VALUE "Water".
05 FILLER PIC X(5) VALUE "Water".
03 Element-Values REDEFINES Element-Data.
05 Element-Table PIC X(5) OCCURS 10 TIMES.
01 Animal-Area.
03 Animal-Data.
05 FILLER PIC X(7) VALUE "Rat".
05 FILLER PIC X(7) VALUE "Ox".
05 FILLER PIC X(7) VALUE "Tiger".
05 FILLER PIC X(7) VALUE "Rabbit".
05 FILLER PIC X(7) VALUE "Dragon".
05 FILLER PIC X(7) VALUE "Snake".
05 FILLER PIC X(7) VALUE "Horse".
05 FILLER PIC X(7) VALUE "Goat".
05 FILLER PIC X(7) VALUE "Monkey".
05 FILLER PIC X(7) VALUE "Rooster".
05 FILLER PIC X(7) VALUE "Dog".
05 FILLER PIC X(7) VALUE "Pig".
03 Animal-Values REDEFINES Animal-Data.
05 Animal-Table PIC X(7) OCCURS 12 TIMES.
01 WS-YEAR PIC 9(4) VALUE 1924.
01 WS-Element PIC 9(2).
01 WS-Animal PIC 9(2).
PROCEDURE DIVISION.
DISPLAY "Input: " WITH NO ADVANCING
ACCEPT WS-YEAR
IF WS-YEAR < 1924 THEN
DISPLAY "YEAR requires >= 1924."
GOBACK
END-IF
COMPUTE WS-Element = FUNCTION MOD(WS-YEAR - 1924, 10) + 1
COMPUTE WS-Animal = FUNCTION MOD(WS-YEAR - 1924, 12) + 1
DISPLAY
FUNCTION TRIM(Element-Table (WS-Element))
" "
FUNCTION TRIM(Animal-Table (WS-Animal))
END-DISPLAY
GOBACK.
FILLER 是 COBOL 的一個關鍵字，用於在資料結構（如 01 記錄或群組項目）中定義「未命名」的儲存空間，
允許開發人員預留空間、對齊資料或填充不需在程式中直接參照的區域，FILLER 項目無法直接在程序部（Procedure Division）中被引用。
REDEFINES 子句允許一個變數與另一個變數共用同一個儲存區域，因此我們可以使用 FILLER 項目定義資料，
而後再使用 REDEFINES 宣告一個資料相同大小的陣列並且指向 FILLER 項目定義的部份。
Cobol subroutine is a program that can be compiled independently but cannot be executed independently.
There are two types of subroutines: internal subroutines like Perform statements and
external subroutines like CALL verb.
If the values of variables in the called program are modified,
then their new values will reflect in the calling program.
If BY clause is not specified, then variables are always passed by reference.
The LINKAGE SECTION in COBOL is a part of the DATA DIVISION used to describe data that
is available to a program but is not stored within that program's own memory.
You cannot use the VALUE clause for items in LINKAGE SECTION, except for level-88 condition names.
main program
IDENTIFICATION DIVISION.
PROGRAM-ID. MAIN.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-STUDENT-ID PIC 9(4) VALUE 1000.
01 WS-STUDENT-NAME PIC A(15) VALUE 'Tim'.
PROCEDURE DIVISION.
CALL 'UTIL' USING WS-STUDENT-ID, WS-STUDENT-NAME.
DISPLAY 'Student Id : ' WS-STUDENT-ID
DISPLAY 'Student Name : ' WS-STUDENT-NAME
STOP RUN.
Called Program
IDENTIFICATION DIVISION.
PROGRAM-ID. UTIL.
DATA DIVISION.
LINKAGE SECTION.
01 LS-STUDENT-ID PIC 9(4).
01 LS-STUDENT-NAME PIC A(15).
PROCEDURE DIVISION USING LS-STUDENT-ID, LS-STUDENT-NAME.
DISPLAY 'In Called Program'.
MOVE 1111 TO LS-STUDENT-ID.
EXIT PROGRAM.
BY CONTENT on a CALL will copy the content of the identifier to a compiler-managed area of storage.
If the values of variables in the called program are modified,
then their new values will not reflect in the calling program.
IDENTIFICATION DIVISION.
PROGRAM-ID. MAIN.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-STUDENT-ID PIC 9(4) VALUE 1000.
01 WS-STUDENT-NAME PIC A(15) VALUE 'Tim'.
PROCEDURE DIVISION.
CALL 'UTIL' USING BY CONTENT WS-STUDENT-ID,
BY CONTENT WS-STUDENT-NAME.
DISPLAY 'Student Id : ' WS-STUDENT-ID
DISPLAY 'Student Name : ' WS-STUDENT-NAME
STOP RUN.
除了 BY REFERENCE 和 BY CONTENT，和其它語言一起工作的時候（例如 C 語言），可能會需要使用 BY VALUE，
也就是直接將變數的值送到呼叫的子程序。
CALL 除了用來呼叫外部的子程序，也可以呼叫 SYSTEM 執行外部的程式。
IDENTIFICATION DIVISION.
PROGRAM-ID. CALL-PROGRAM.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 COMMAND-STRING PIC X(20) VALUE "ls -al".
01 RETURN-CODE-WS PIC 9(4).
PROCEDURE DIVISION.
CALL "SYSTEM" USING COMMAND-STRING RETURNING RETURN-CODE-WS.
GOBACK.
COBOL 支援 user-defined functions (UDFs)，使用 FUNCTION-ID paragraph 定義 function 名稱。
如果要使用 user-defined function，
必須在呼叫程式的 CONFIGURATION SECTION 的 REPOSITORY paragraph 中宣告要使用的 function。
leap.cob
IDENTIFICATION DIVISION.
FUNCTION-ID. isLeapYear.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 remainders.
03 400-rem PIC 9(4).
03 100-rem PIC 9(4).
03 4-rem PIC 9(4).
LINKAGE SECTION.
01 LS-YEAR PIC 9(4).
01 LS-RESULT PIC 9.
PROCEDURE DIVISION USING LS-YEAR RETURNING LS-RESULT.
MOVE FUNCTION MOD(LS-YEAR, 400) TO 400-rem
MOVE FUNCTION MOD(LS-YEAR, 100) TO 100-rem
MOVE FUNCTION MOD(LS-YEAR, 4) TO 4-rem
IF 400-rem = 0 OR ((100-rem NOT = 0) AND 4-rem = 0)
MOVE 1 TO LS-RESULT
ELSE
MOVE 0 TO LS-RESULT
END-IF
GOBACK.
END FUNCTION isLeapYear.
* main proceure
IDENTIFICATION DIVISION.
PROGRAM-ID. LEAP-YEAR.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
REPOSITORY.
FUNCTION IsLeapYear.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-YEAR PIC 9(4).
01 WS-RESULT PIC 9.
PROCEDURE DIVISION.
DISPLAY "Input: " WITH NO ADVANCING
ACCEPT WS-YEAR.
MOVE FUNCTION IsLeapYear(WS-YEAR) TO WS-RESULT
IF WS-RESULT IS EQUAL TO 1 THEN
DISPLAY WS-YEAR " is a leap year."
ELSE
DISPLAY WS-YEAR " is not a leap year."
END-IF
GOBACK.
END PROGRAM LEAP-YEAR.
下面是人類猜數字的小遊戲：
GETA.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID. 'GETA'.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 LS-INDEX PIC 9.
LINKAGE SECTION.
01 LS-ANSWER PIC 9(4).
01 LS-GUESS PIC 9(4).
01 LS-COUNT PIC 9.
PROCEDURE DIVISION USING LS-ANSWER, LS-GUESS, LS-COUNT.
PERFORM VARYING LS-INDEX FROM 1 BY 1 UNTIL LS-INDEX > 4
IF LS-ANSWER(LS-INDEX:1) = LS-GUESS(LS-INDEX:1) THEN
ADD 1 TO LS-COUNT
END-IF
END-PERFORM.
GOBACK.
END PROGRAM 'GETA'.
GETB.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID. 'GETB'.
DATA DIVISION.
LOCAL-STORAGE SECTION.
01 LS-INDEX1 PIC 9.
01 LS-INDEX2 PIC 9.
LINKAGE SECTION.
01 LS-ANSWER PIC 9(4).
01 LS-GUESS PIC 9(4).
01 LS-COUNT PIC 9.
PROCEDURE DIVISION USING LS-ANSWER, LS-GUESS, LS-COUNT.
PERFORM VARYING LS-INDEX1 FROM 1 BY 1 UNTIL LS-INDEX1 > 4
PERFORM VARYING LS-INDEX2 FROM 1 BY 1 UNTIL LS-INDEX2 > 4
IF LS-INDEX1 IS NOT EQUAL TO LS-INDEX2 THEN
IF LS-ANSWER(LS-INDEX1:1) = LS-GUESS(LS-INDEX2:1)
THEN
ADD 1 TO LS-COUNT
END-IF
END-IF
END-PERFORM
END-PERFORM.
GOBACK.
END PROGRAM 'GETB'.
guess.cob
IDENTIFICATION DIVISION.
PROGRAM-ID. GUESS-GAME.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-ANSWER PIC 9(4).
01 WS-GUESS PIC 9(4).
01 WS-AVALUE PIC 9.
01 WS-BVALUE PIC 9.
PROCEDURE DIVISION.
PERFORM UNTIL 1 < 0
COMPUTE WS-ANSWER = (FUNCTION RANDOM * 9999) + 1
IF WS-ANSWER(1:1) <> WS-ANSWER(2:1) AND
WS-ANSWER(1:1) <> WS-ANSWER(3:1) AND
WS-ANSWER(1:1) <> WS-ANSWER(4:1) AND
WS-ANSWER(2:1) <> WS-ANSWER(3:1) AND
WS-ANSWER(2:1) <> WS-ANSWER(4:1) AND
WS-ANSWER(3:1) <> WS-ANSWER(4:1) THEN
EXIT PERFORM
END-IF
END-PERFORM.
PERFORM UNTIL 1 < 0
DISPLAY "Please input your guess: " WITH NO ADVANCING
ACCEPT WS-GUESS
MOVE 0 TO WS-AVALUE
MOVE 0 TO WS-BVALUE
CALL 'GETA' USING BY CONTENT WS-ANSWER, WS-GUESS,
BY REFERENCE WS-AVALUE
CALL 'GETB' USING BY CONTENT WS-ANSWER, WS-GUESS,
BY REFERENCE WS-BVALUE
DISPLAY "Result: A = " WS-AVALUE " B = " WS-BVALUE
DISPLAY " "
IF WS-AVALUE = 4 AND WS-BVALUE = 0 THEN
DISPLAY "Game is completed."
EXIT PERFORM
END-IF
END-PERFORM.
STOP RUN.
下面是電腦猜數字的小遊戲：
IDENTIFICATION DIVISION.
PROGRAM-ID. RANDOM-EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-SOLUTIONS.
05 WS-LEN1 PIC 9(4) VALUE 5040 BINARY.
05 WS-NUMBER PIC 9(4) VALUE 0000 OCCURS 0 TO 5040 TIMES
DEPENDING ON WS-LEN1.
01 WS-NEW-NUMBERS.
05 WS-NEW-LEN1 PIC 9(4) VALUE 5040 BINARY.
05 WS-NEW-NUMBER PIC 9(4) VALUE 0000 OCCURS 0 TO 5040 TIMES
DEPENDING ON WS-NEW-LEN1.
01 WS-ANSWER PIC 9(4).
01 WS-GUESS PIC 9(4).
LOCAL-STORAGE SECTION.
01 LS-INDEX1 PIC 99.
01 LS-INDEX2 PIC 99.
01 LS-INDEX3 PIC 99.
01 LS-INDEX4 PIC 99.
01 LS-COUNT1 PIC 9(4) BINARY.
01 LS-COUNT2 PIC 9(4) BINARY.
01 LS-LOOP1 PIC 9(4) BINARY.
77 LS-AVALUE PIC 9.
77 LS-BVALUE PIC 9.
77 LS-AGUESS PIC 9.
77 LS-BGUESS PIC 9.
PROCEDURE DIVISION.
INITIALIZE LS-COUNT1 REPLACING NUMERIC DATA BY 0000.
PERFORM VARYING LS-INDEX1 FROM 0 BY 1 UNTIL LS-INDEX1 > 9
PERFORM VARYING LS-INDEX2 FROM 0 BY 1 UNTIL LS-INDEX2 > 9
PERFORM VARYING LS-INDEX3 FROM 0 BY 1
UNTIL LS-INDEX3 > 9
PERFORM VARYING LS-INDEX4 FROM 0 BY 1
UNTIL LS-INDEX4 > 9
IF LS-INDEX1 <> LS-INDEX2 AND
LS-INDEX1 <> LS-INDEX3 AND
LS-INDEX1 <> LS-INDEX4 AND
LS-INDEX2 <> LS-INDEX3 AND
LS-INDEX2 <> LS-INDEX4 AND
LS-INDEX3 <> LS-INDEX4 THEN
ADD 1 TO LS-COUNT1
STRING LS-INDEX1(2:1) LS-INDEX2(2:1)
LS-INDEX3(2:1) LS-INDEX4(2:1)
INTO WS-NUMBER(LS-COUNT1)
END-STRING
END-IF
END-PERFORM
END-PERFORM
END-PERFORM
END-PERFORM.
MOVE LS-COUNT1 TO WS-LEN1
MOVE LS-COUNT1 TO WS-NEW-LEN1
PERFORM UNTIL 1 < 0
IF LS-COUNT1 IS EQUAL TO 0 THEN
DISPLAY "Something is wrong."
EXIT PERFORM
END-IF
MOVE WS-NUMBER(1) TO WS-ANSWER
DISPLAY "My answer is " WS-ANSWER
DISPLAY "The a value is: " WITH NO ADVANCING
ACCEPT LS-AVALUE
DISPLAY "The b value is: " WITH NO ADVANCING
ACCEPT LS-BVALUE
IF LS-AVALUE = 4 AND LS-BVALUE = 0 THEN
DISPLAY "Game is completed."
EXIT PERFORM
END-IF
MOVE 0000 TO LS-COUNT2
PERFORM VARYING LS-LOOP1 FROM 1 BY 1 UNTIL LS-LOOP1
IS GREATER THAN LS-COUNT1
MOVE 0000 TO WS-NEW-NUMBER(LS-LOOP1)
END-PERFORM
PERFORM VARYING LS-LOOP1 FROM 1 BY 1 UNTIL LS-LOOP1
IS GREATER THAN LS-COUNT1
MOVE WS-NUMBER(LS-LOOP1) TO WS-GUESS
MOVE 0 TO LS-AGUESS
MOVE 0 TO LS-BGUESS
CALL 'GETA' USING BY CONTENT WS-ANSWER, WS-GUESS,
BY REFERENCE LS-AGUESS
CALL 'GETB' USING BY CONTENT WS-ANSWER, WS-GUESS,
BY REFERENCE LS-BGUESS
IF LS-AVALUE = LS-AGUESS AND LS-BVALUE = LS-BGUESS THEN
ADD 1 TO LS-COUNT2
MOVE WS-GUESS TO WS-NEW-NUMBER(LS-COUNT2)
END-IF
END-PERFORM
MOVE LS-COUNT2 TO LS-COUNT1
MOVE LS-COUNT1 TO WS-LEN1
MOVE LS-COUNT1 TO WS-NEW-LEN1
PERFORM VARYING LS-LOOP1 FROM 1 BY 1 UNTIL LS-LOOP1
IS GREATER THAN LS-COUNT2
MOVE WS-NEW-NUMBER(LS-LOOP1) TO WS-NUMBER(LS-LOOP1)
END-PERFORM
DISPLAY " "
END-PERFORM.
STOP RUN.
參考資料