85
OpenCOBOL 1.1 Programmers Guide
Sample Programs
06FEB2009 Version
Page 8-7
01 Switch-Value.
05 SV-1 PIC X(1).
05 FILLER PIC X(255).
01 Switch-Value-Alt REDEFINES Switch-Value
PIC X(256).
88 Valid-Config-Filename
VALUE 'BS2000', 'COBOL85', 'COBOL2002', 'DEFAULT',
'IBM', 'MF', 'MVS'.
01 Switches.
05 S-ARGS PIC X(75) VALUE SPACES.
05 S-CfgS.
10 S-Cfg-BS2000 PIC X(1) VALUE ' '.
10 S-Cfg-COBOL85 PIC X(1) VALUE ' '.
10 S-Cfg-COBOL2002 PIC X(1) VALUE ' '.
10 S-Cfg-DEFAULT PIC X(1) VALUE Selection-Char.
10 S-Cfg-IBM PIC X(1) VALUE ' '.
10 S-Cfg-MF PIC X(1) VALUE ' '.
10 S-Cfg-MVS PIC X(1) VALUE ' '.
05 S-EXTRA PIC X(75) VALUE SPACES.
05 S-Yes-No-Switches.
10 S-DEBUG PIC X(1) VALUE 'N'.
10 S-DLL PIC X(1) VALUE 'N'.
GC0410 10 S-XREF PIC X(1) VALUE 'N'.
GC0410 10 S-SOURCE PIC X(1) VALUE 'N'.
10 S-EXECUTE PIC X(1) VALUE 'N'.
10 S-NOTRUNC PIC X(1) VALUE 'Y'.
10 S-SUBROUTINE PIC X(1) VALUE 'A'.
10 S-TRACE PIC X(1) VALUE 'N'.
10 S-TRACEALL PIC X(1) VALUE 'N'.
01 Tally USAGE BINARY-LONG.
SCREEN SECTION.
*>
*> Here is the layout of the OCic screen.
*>
*> Note that this program can utilize the traditional PC line-drawing characters,
*> if they are available.
*>
*> If this program is run on Windows, it must run with codepage 437 activated to
*> display the line-drawing characters. With a native Windows build or a
*> Windows/MinGW build, one could use the command "chcp 437" to set that codepage
*> for display within a Windows console window (that should be the default, though).
*> With a Windows/Cygwin build, set the environment variable CYGWIN to a value of
*> "codepage:oem" (this cannot be done from within the program though - you will
*> have to use the "Computer/Advanced System Settings/Environment Variables" (Vista or
*> Windows 7) function to define the variable. XP Users: use "My Computer/Properties/
*> Advanced/Environment Variables".
*>
*> To use OCic without the line-drawing characters, comment-out the first set of
*> 78 "LD" items and uncomment the second.
*>
*> The following sample screen layout shows how the screen looks with line-drawing
*> characters disabled.
*>
*>===================================================================================
*> OCic (2010/04/02 11:36) - OpenCOBOL V1.1 Interactive Compilation Windows 01
*> +-----------------------------------------------------------------------------+ 02
*> | Program: OCic F-Key: Select Opt | 03
*> | Folder: E:\OpenCOBOL\Samples Enter: Compile | 04
*> | Filename: OCic.cbl Esc: Quit | 05
*> +-----------------------------------------------------------------------------+ 06
*> On/Off Switches: Configuration: 07
*> +---------------------------------------------------------+-------------------+ 08
*> | F1 Compile debug lines F8 Produce source listing | S-F1 BS2000 | 09
*> | F2 Always make DLLs F9 Produce xref listing | S-F2 COBOL85 | 10
*> | F3 Pgm is a SUBROUTINE | S-F3 COBOL2002 | 11
*> | F4 Execute if compile OK | S-F4 > Default | 12
*> | F5 > No COMP/BINARY trunc | S-F5 IBM | 13
*> | F6 Trace procedures | S-F6 MicroFocus | 14
*> | F7 Trace proc + stmnts | S-F7 MVS | 15
*> +---------------------------------------------------------+-------------------+ 16
*> Additional "cobc" Switches (if any): 17
*> +-----------------------------------------------------------------------------+ 18
*> | -O2________________________________________________________________________ | 19
*> +-----------------------------------------------------------------------------+ 20
*> Program Execution Arguments (if any): 21
*> +-----------------------------------------------------------------------------+ 22
*> | ___________________________________________________________________________ | 23
*> +-----------------------------------------------------------------------------+ 24
*> OCic Copyright (C) 2009-2010, Gary L. Cutler, GPL 25
*>===================================================================================
*>12345678901234567890123456789012345678901234567890123456789012345678901234567890
Add signature to pdf reader - C# PDF File Permission Library: add, remove, update PDF file permission in C#.net, ASP.NET, MVC, WPFTell C# users how to set PDF file permissions, like printing, copying, modifying, extracting, annotating, form filling, etc
add jpeg signature to pdf; adding signature to pdf form
74
OpenCOBOL 1.1 Programmers Guide
Sample Programs
06FEB2009 Version
Page 8-8
*> 1 2 3 4 5 6 7 8
*>
*> USE THESE CHARS FOR LINE-DRAWING IF YOU HAVE ACCESS TO PC-DOS CODEPAGE 437:
*>
78 LD-UL-Corner VALUE X"DA".
78 LD-LL-Corner VALUE X"C0".
78 LD-UR-Corner VALUE X"BF".
78 LD-LR-Corner VALUE X"D9".
78 LD-Upper-T VALUE X"C2".
78 LD-Lower-T VALUE X"C1".
78 LD-Horiz-Line VALUE X"C4".
78 LD-Vert-Line VALUE X"B3".
*>
*> USE THESE CHARS FOR LINE-DRAWING IF YOU DO NOT HAVE ACCESS TO PC-DOS CODEPAGE 437:
*>
*> 78 LD-UL-Corner VALUE '+'.
*> 78 LD-LL-Corner VALUE '+'.
*> 78 LD-UR-Corner VALUE '+'.
*> 78 LD-LR-Corner VALUE '+'.
*> 78 LD-Upper-T VALUE '+'.
*> 78 LD-Lower-T VALUE '+'.
*> 78 LD-Horiz-Line VALUE '-'.
*> 78 LD-Vert-Line VALUE '|'.
*>
01 Blank-Screen LINE 1 COLUMN 1 BLANK SCREEN.
01 Switches-Screen BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-WHITE AUTO.
*>
*> GENERAL SCREEN FRAMEWORK
*>
03 BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-BLUE HIGHLIGHT.
05 LINE 02 COL 02 VALUE LD-UL-Corner.
05 PIC X(77) FROM Horizontal-Line.
05 COL 80 VALUE LD-UR-Corner.
05 LINE 03 COL 02 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
05 LINE 04 COL 02 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
05 LINE 05 COL 02 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
05 LINE 06 COL 02 VALUE LD-LL-Corner.
05 PIC X(77) FROM Horizontal-Line.
05 COL 80 VALUE LD-LR-Corner.
05 LINE 08 COL 02 VALUE LD-UL-Corner.
05 PIC X(57) FROM Horizontal-Line.
05 COL 60 VALUE LD-Upper-T.
05 PIC X(19) FROM Horizontal-Line.
05 COL 80 VALUE LD-UR-Corner.
05 LINE 09 COL 02 VALUE LD-Vert-Line.
05 COL 60 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
05 LINE 10 COL 02 VALUE LD-Vert-Line.
05 COL 60 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
05 LINE 11 COL 02 VALUE LD-Vert-Line.
05 COL 60 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
05 LINE 12 COL 02 VALUE LD-Vert-Line.
05 COL 60 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
05 LINE 13 COL 02 VALUE LD-Vert-Line.
05 COL 60 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
05 LINE 14 COL 02 VALUE LD-Vert-Line.
05 COL 60 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
05 LINE 15 COL 02 VALUE LD-Vert-Line.
05 COL 60 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
81
OpenCOBOL 1.1 Programmers Guide
Sample Programs
06FEB2009 Version
Page 8-9
05 LINE 16 COL 02 VALUE LD-LL-Corner.
05 PIC X(57) FROM Horizontal-Line.
05 COL 60 VALUE LD-Lower-T.
05 PIC X(19) FROM Horizontal-Line.
05 COL 80 VALUE LD-LR-Corner.
05 LINE 18 COL 02 VALUE LD-UL-Corner.
05 PIC X(77) FROM Horizontal-Line.
05 COL 80 VALUE LD-UR-Corner.
05 LINE 19 COL 02 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
05 LINE 20 COL 02 VALUE LD-LL-Corner.
05 PIC X(77) FROM Horizontal-Line.
05 COL 80 VALUE LD-LR-Corner.
05 LINE 22 COL 02 VALUE LD-UL-Corner.
05 PIC X(77) FROM Horizontal-Line.
05 COL 80 VALUE LD-UR-Corner.
05 LINE 23 COL 02 VALUE LD-Vert-Line.
05 COL 80 VALUE LD-Vert-Line.
05 LINE 24 COL 02 VALUE LD-LL-Corner.
05 PIC X(77) FROM Horizontal-Line.
05 COL 80 VALUE LD-LR-Corner.
*>
*> TOP AND BOTTOM LINES
*>
03 BACKGROUND-COLOR COB-COLOR-BLUE BLINK
FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
GC0410 05 LINE 01 COL 01 VALUE ' OCic ('.
GC0410 05 PIC X(16) FROM OC-Compiled.
GC0410 05 VALUE ') OpenCOBOL 1.1 06FEB2009 ' &
GC0410 'Interactive Compilation '.
GC0410 05 LINE 25 COL 01 PIC X(81) FROM Output-Message.
*>
*> LABELS
*>
03 BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-CYAN HIGHLIGHT.
05 LINE 07 COL 04 VALUE 'On/Off Switches:'.
05 COL 62 VALUE 'Configuration:'.
05 LINE 17 COL 04 VALUE 'Additional "cobc" Switches (if any
- '):'.
05 LINE 21 COL 04 VALUE 'Program Execution Arguments (if an
- 'y):'.
*>
*> TOP SECTION BACKGROUND
*>
03 BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-CYAN LOWLIGHT.
05 LINE 03 COL 04 VALUE 'Program: '.
05 LINE 04 COL 04 VALUE 'Folder: '.
05 LINE 05 COL 04 VALUE 'Filename: '.
05 LINE 03 COL 62 VALUE 'F-Key: Select Opt'.
05 LINE 04 COL 62 VALUE 'Enter: Compile '.
05 LINE 05 COL 62 VALUE 'Esc: Quit '.
*>
*> TOP SECTION PROGRAM INFO
*>
03 BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
05 LINE 03 COL 14 PIC X(47) FROM Prog-Name.
05 LINE 04 COL 14 PIC X(47) FROM Prog-Folder.
05 LINE 05 COL 14 PIC X(47) FROM Prog-File-Name.
*>
*> MIDDLE LEFT SECTION F-KEYS
*>
03 BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
05 LINE 09 COL 04 VALUE 'F1'.
05 LINE 10 COL 04 VALUE 'F2'.
05 LINE 11 COL 04 VALUE 'F3'.
05 LINE 12 COL 04 VALUE 'F4'.
05 LINE 13 COL 04 VALUE 'F5'.
05 LINE 14 COL 04 VALUE 'F6'.
05 LINE 15 COL 04 VALUE 'F7'.
05 LINE 09 COL 32 VALUE 'F8'.
05 LINE 10 COL 32 VALUE 'F9'.
*>
*> MIDDLE LEFT SECTION SWITCHES
.NET PDF SDK | Read & Processing PDF files ". Reading, viewing and editing PDF document can be an easy task if you use PDF Reader Add-on, which can be easily integrated into RasterEdge .NET Imaging SDK.
add signature to pdf; pdf to word converter sign in
88
OpenCOBOL 1.1 Programmers Guide
Sample Programs
06FEB2009 Version
Page 8-10
*>
03 BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-RED HIGHLIGHT.
05 LINE 09 COL 07 PIC X(1) FROM S-DEBUG.
05 LINE 10 COL 07 PIC X(1) FROM S-DLL.
05 LINE 11 COL 07 PIC X(1) FROM S-SUBROUTINE.
05 LINE 12 COL 07 PIC X(1) FROM S-EXECUTE.
05 LINE 13 COL 07 PIC X(1) FROM S-NOTRUNC.
05 LINE 14 COL 07 PIC X(1) FROM S-TRACE.
05 LINE 15 COL 07 PIC X(1) FROM S-TRACEALL.
05 LINE 09 COL 35 PIC X(1) FROM S-SOURCE.
05 LINE 10 COL 35 PIC X(1) FROM S-XREF.
*>
*> MIDDLE LEFT SECTION BACKGROUND
*>
03 BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-CYAN LOWLIGHT.
05 LINE 09 COL 09 VALUE 'Compile debug lines '.
05 LINE 10 COL 09 VALUE 'Always make DLLs '.
05 LINE 11 COL 09 VALUE 'Pgm is a SUBROUTINE '.
05 LINE 12 COL 09 VALUE 'Execute if compile OK '.
05 LINE 13 COL 09 VALUE 'No COMP/BINARY trunc '.
05 LINE 14 COL 09 VALUE 'Trace procedures '.
05 LINE 15 COL 09 VALUE 'Trace proc + stmnts '.
05 LINE 09 COL 37 VALUE 'Produce source listing'.
05 LINE 10 COL 37 VALUE 'Produce xref listing '.
*>
*> MIDDLE RIGHT SECTION F-KEYS
*>
03 BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
05 LINE 09 COL 62 VALUE 'S-F1'.
05 LINE 10 COL 62 VALUE 'S-F2'.
05 LINE 11 COL 62 VALUE 'S-F3'.
05 LINE 12 COL 62 VALUE 'S-F4'.
05 LINE 13 COL 62 VALUE 'S-F5'.
05 LINE 14 COL 62 VALUE 'S-F6'.
05 LINE 15 COL 62 VALUE 'S-F7'.
*>
*> MIDDLE RIGHT SECTION SWITCHES
*>
03 BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-RED HIGHLIGHT.
05 LINE 09 COL 67 PIC X(1) FROM S-Cfg-BS2000.
05 LINE 10 COL 67 PIC X(1) FROM S-Cfg-COBOL85.
05 LINE 11 COL 67 PIC X(1) FROM S-Cfg-COBOL2002.
05 LINE 12 COL 67 PIC X(1) FROM S-Cfg-DEFAULT.
05 LINE 13 COL 67 PIC X(1) FROM S-Cfg-IBM.
05 LINE 14 COL 67 PIC X(1) FROM S-Cfg-MF.
05 LINE 15 COL 67 PIC X(1) FROM S-Cfg-MVS.
*>
*> MIDDLE RIGHT SECTION BACKGROUND
*>
03 BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-CYAN LOWLIGHT.
05 LINE 09 COL 69 VALUE 'BS2000 '.
05 LINE 10 COL 69 VALUE 'COBOL85 '.
05 LINE 11 COL 69 VALUE 'COBOL2002 '.
05 LINE 12 COL 69 VALUE 'Default '.
05 LINE 13 COL 69 VALUE 'IBM '.
05 LINE 14 COL 69 VALUE 'MicroFocus'.
05 LINE 15 COL 69 VALUE 'MVS '.
*>
*> FREE-FORM OPTIONS FIELDS
*>
03 BACKGROUND-COLOR COB-COLOR-BLACK
FOREGROUND-COLOR COB-COLOR-WHITE HIGHLIGHT.
05 LINE 19 COL 04 PIC X(75) USING S-EXTRA.
05 LINE 23 COL 04 PIC X(75) USING S-ARGS.
/
PROCEDURE DIVISION.
*****************************************************************
** Legend to procedure names: **
** **
** 00x-xxx All MAIN driver procedures **
** 0xx-xxx All GLOBAL UTILITY procedures **
** 1xx-xxx All INITIALIZATION procedures **
** 2xx-xxx All CORE PROCESSING procedures **
** 9xx-xxx All TERMINATION procedures **
*****************************************************************
DECLARATIVES.
000-File-Error SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON Source-Code.
000-Handle-Error.
86
OpenCOBOL 1.1 Programmers Guide
Sample Programs
06FEB2009 Version
Page 8-11
COPY FileStat-Msgs
REPLACING STATUS BY FSM-Status
MSG BY FSM-Msg.
MOVE SPACES TO Output-Message
IF FSM-Status = 35
DISPLAY
'File not found: "'
TRIM(File-Name,TRAILING)
'"'
END-DISPLAY
ELSE
DISPLAY
'Error accessing file: "'
TRIM(File-Name,TRAILING)
'"'
END-DISPLAY
END-IF
GOBACK
.
END DECLARATIVES.
/
000-Main SECTION.
PERFORM 100-Initialization
GC0609 SET 88-Not-Complete TO TRUE
GC0609 PERFORM UNTIL 88-Complete
GC0609 PERFORM 200-Let-User-Set-Switches
GC0609 PERFORM 210-Run-Compiler
GC0410 IF (88-Compile-OK OR 88-Compile-OK-Warn)
GC0410 AND (S-XREF NOT = SPACE OR S-SOURCE NOT = SPACE)
GC0410 PERFORM 220-Make-Listing
GC0410 END-IF
GC0709 IF (S-EXECUTE NOT = SPACES)
GC0709 AND (88-Output-File-Avail)
GC0609 PERFORM 230-Run-Program
GC0609 END-IF
GC0609 END-PERFORM
.
009-Done.
PERFORM 900-Terminate
.
* -- Control will NOT return
/
010-Parse-Args SECTION.
*****************************************************************
** Process a sequence of KEYWORD=VALUE items. These are items **
** specified on the command-line to provide the initial **
** options shown selected on the screen. When integrating **
** OCic into an edirot or framework, include these switches on **
** the ocic.exe command the editor/framework executes. Any **
** underlined choice is the default value for that switch. **
** **
** @CONFIG=BS2000|COBOL85|COBOL2002|DEFAULT|IBM|MF|MVS **
** ======= **
** This switch specifies the default cobc compiler configura- **
** tion file to be used **
** **
** @DEBUG=YES|NO **
** == **
** This switch specifies whether (YES) or not (NO) debugging **
** lines (those with a "D" in column 7) will be compiled. **
** **
** @DLL=YES|NO **
** == **
** Use this switch to force ALL compiled programs to be built **
** as DLLs ("@DLL=YES"). When main programs are built as DLLs **
** they must be executed using the cobcrun utility. When **
** "@DLL=NO" is in effect, main programs are generated as **
** actual "exe" files and only subprograms will be generated **
** as DLLs. **
** **
** @EXECUTE=YES|NO **
** == **
** This switch specifies whether ("@EXECUTE=YES") or not **
** ("@EXECUTE=NO") the program will be executed after it is **
** successfully compiled. **
** **
** @EXTRA=extra cobc argument(s) **
** **
** This switch allows you to specify additional cobc arguments **
** that aren't managed by the other OC switches. If used, **
** this must be the last switch specified on the command line, **
** as everything that follows the "=" will be placed on the **
83
OpenCOBOL 1.1 Programmers Guide
Sample Programs
06FEB2009 Version
Page 8-12
** cobc command generated by OC. **
** **
** @NOTRUNC=YES|NO **
** === **
** This switch specifies whether (YES) or not (NO) the sup- **
** pression of binary field truncation will occur. If a PIC **
** 99 COMP field (one byte of storage), for example, is given **
** the value 123, it may have its value truncated to 23 when **
** DISPLAYed. Regardless of the NOTRUNC setting, internally **
** the full precision of the field (allowing a maximum value **
** of 255) will be preserved. Even though truncation - if it **
** does occur - would appear to have a minimal disruption on **
** program operation, it has a significant effect on program **
** run-time speed. **
** **
** @TRACE=YES|NO|ALL **
** == **
** This switch controls whether or not code will be added to **
** the object program to produce execution-time logic traces. **
** A specification of "@TRACE=NO" means no such code will be **
** produced. By specifying "@TRACE=YES", code will be genera- **
** ted to display procedure names as they are entered. A **
** "@TRACE=ALL" specification will generate not only procedure **
** traces (as "@TRACE=YES" would) but also statement-level **
** traces too! All trace output is written to STDERR, so **
** adding a "2>file" to the execution of the program will pipe **
** the trace output to a file. You may find it valuable to **
** add your own DISPLAY statements to the debugging output via **
** "DISPLAY xx UPON SYSERR" The SYSERR device corresponds to **
** the Windows or UNIX STDERR device and will therefore honor **
** any "2>file" placed at the end of your program's execution. **
** Add a "D" in column 7 and you can control the generation or **
** ignoring of these DISPLAY statements via the "@DEBUG" **
** switch. **
** **
GC0410** @SOURCE=YES|NO **
GC0410** == **
GC0410** Use this switch to produce a source listing of the program, **
GC0410** PROVIDED it compiles without errors. **
** **
GC0410** @XREF=YES|NO **
GC0410** == **
GC0410** Use this switch to produce a cross-reference listing of the **
GC0410** program, PROVIDED it compiles without errors. **
*****************************************************************
011-Init.
MOVE 1 TO I
.
012-Extract-Kwd-And-Value.
PERFORM UNTIL I NOT < LENGTH(Command-Line-Args)
MOVE I TO J
UNSTRING Command-Line-Args
DELIMITED BY ALL SPACES
INTO Switch-Keyword-And-Value
WITH POINTER I
END-UNSTRING
IF Switch-Keyword-And-Value NOT = SPACES
UNSTRING Switch-Keyword-And-Value
DELIMITED BY '='
INTO Switch-Keyword, Switch-Value
END-UNSTRING
PERFORM 030-Process-Keyword
END-IF
END-PERFORM
.
019-Done.
EXIT.
*****************************************************************
** Since this program uses the SCREEN SECTION, it cannot do **
** conventional console DISPLAY operations. This routine **
** (which, I admit, is like using an H-bomb to hunt rabbits) **
** will submit an "ECHO" command to the system to simulate a **
** DISPLAY. **
*****************************************************************
021-Build-And-Issue-Command.
DISPLAY
Output-Message
END-DISPLAY
.
.NET Barcode Reader SDK| Scan & Read Barcodes barcode from document or images with .NET Imaging Barcode Reader, an easy most common document & image formats, including Bitmap, Metafile and PDF are supported
add signature pdf online; adding a signature to a pdf
86
OpenCOBOL 1.1 Programmers Guide
Sample Programs
06FEB2009 Version
Page 8-13
029-Done.
EXIT.
/
030-Process-Keyword SECTION.
*****************************************************************
** Process a single KEYWORD=VALUE item. **
*****************************************************************
031-Init.
MOVE UPPER-CASE(Switch-Keyword) TO Switch-Keyword
SET 88-Switch-Is-Good TO TRUE
.
032-Process.
EVALUATE TRUE
WHEN Switch-Is-EXTRA
GC0410 MOVE J TO I
UNSTRING Command-Line-Args DELIMITED BY '='
INTO Dummy, S-EXTRA
GC0410 WITH POINTER I
GC0410 END-UNSTRING
MOVE LENGTH(Command-Line-Args) TO I
WHEN Switch-Is-CONFIG
MOVE 'CONFIG' TO Switch-Keyword
MOVE UPPER-CASE(Switch-Value)
TO Switch-Value
EVALUATE Switch-Value
WHEN 'BS2000'
MOVE SPACES TO S-CfgS
MOVE Selection-Char TO S-Cfg-BS2000
WHEN 'COBOL85'
MOVE SPACES TO S-CfgS
MOVE Selection-Char TO S-Cfg-COBOL85
WHEN 'COBOL2002'
MOVE SPACES TO S-CfgS
MOVE Selection-Char TO S-Cfg-COBOL2002
WHEN 'DEFAULT'
MOVE SPACES TO S-CfgS
MOVE Selection-Char TO S-Cfg-DEFAULT
WHEN 'IBM'
MOVE SPACES TO S-CfgS
MOVE Selection-Char TO S-Cfg-IBM
WHEN 'MF'
MOVE SPACES TO S-CfgS
MOVE Selection-Char TO S-Cfg-MF
WHEN 'MVS'
MOVE SPACES TO S-CfgS
MOVE Selection-Char TO S-Cfg-MVS
WHEN OTHER
MOVE 'An invalid /CONFIG switch value ' &
'was specified on the command line ' &
'- ignored'
TO Output-Message
END-EVALUATE
WHEN Switch-Is-DEBUG
MOVE 'DEBUG' TO Switch-Keyword
MOVE UPPER-CASE(Switch-Value)
TO Switch-Value
PERFORM 040-Process-Yes-No-Value
IF 88-Switch-Is-Good
MOVE SV-1 TO S-DEBUG
END-IF
GC0410 WHEN Switch-Is-DLL
GC0410 MOVE 'DLL' TO Switch-Keyword
GC0410 MOVE UPPER-CASE(Switch-Value)
GC0410 TO Switch-Value
GC0410 PERFORM 040-Process-Yes-No-Value
GC0410 IF 88-Switch-Is-Good
GC0410 MOVE SV-1 TO S-DLL
GC0410 END-IF
WHEN Switch-Is-EXECUTE
MOVE 'EXECUTE' TO Switch-Keyword
MOVE UPPER-CASE(Switch-Value)
TO Switch-Value
PERFORM 040-Process-Yes-No-Value
IF 88-Switch-Is-Good
MOVE SV-1 TO S-EXECUTE
END-IF
WHEN Switch-Is-NOTRUNC
MOVE 'NOTRUNC' TO Switch-Keyword
MOVE UPPER-CASE(Switch-Value)
TO Switch-Value
PERFORM 040-Process-Yes-No-Value
IF 88-Switch-Is-Good
83
OpenCOBOL 1.1 Programmers Guide
Sample Programs
06FEB2009 Version
Page 8-14
MOVE SV-1 TO S-NOTRUNC
END-IF
GC0410 WHEN Switch-Is-SOURCE
GC0410 MOVE 'SOURCE' TO Switch-Keyword
GC0410 MOVE UPPER-CASE(Switch-Value)
GC0410 TO Switch-Value
GC0410 PERFORM 050-Process-Yes-No-All
GC0410 IF 88-Switch-Is-Good
GC0410 MOVE SV-1 TO S-SOURCE
GC0410 END-IF
WHEN Switch-Is-TRACE
MOVE 'TRACE' TO Switch-Keyword
MOVE UPPER-CASE(Switch-Value)
TO Switch-Value
PERFORM 050-Process-Yes-No-All
IF 88-Switch-Is-Good
MOVE SV-1 TO S-TRACE
END-IF
GC0410 WHEN Switch-Is-XREF
GC0410 MOVE 'XREF' TO Switch-Keyword
GC0410 MOVE UPPER-CASE(Switch-Value)
GC0410 TO Switch-Value
GC0410 PERFORM 050-Process-Yes-No-All
GC0410 IF 88-Switch-Is-Good
GC0410 MOVE SV-1 TO S-XREF
GC0410 END-IF
WHEN OTHER
MOVE SPACES TO Output-Message
STRING '"'
TRIM(Switch-Keyword)
'" is not a valid switch ' &
'- ignored'
DELIMITED SIZE
INTO Output-Message
END-STRING
SET 88-Switch-Is-Bad TO TRUE
END-EVALUATE
.
039-Done.
EXIT.
/
040-Process-Yes-No-Value SECTION.
*****************************************************************
** Process a switch value of YES or NO **
*****************************************************************
042-Process.
EVALUATE SV-1
WHEN 'Y'
MOVE 'YES' TO Switch-Value
WHEN 'N'
MOVE 'NO' To Switch-Value
WHEN OTHER
MOVE SPACES TO Output-Message
STRING '*ERROR: "' TRIM(Switch-Value)
'" is not a valid value for the "'
TRIM(Switch-Keyword) '" switch'
DELIMITED SPACES
INTO Output-Message
END-STRING
SET 88-Switch-Is-Bad TO TRUE
END-EVALUATE
.
049-Done.
EXIT.
/
050-Process-Yes-No-All SECTION.
*****************************************************************
** Process a switch value of YES, NO or ALL **
*****************************************************************
052-Process.
IF SV-1 = 'A'
MOVE 'ALL' TO Switch-Value
ELSE
PERFORM 040-Process-Yes-No-Value
END-IF
.
059-Done.
EXIT.
/
82
OpenCOBOL 1.1 Programmers Guide
Sample Programs
06FEB2009 Version
Page 8-15
060-Process-Yes-No-Auto SECTION.
*****************************************************************
** Process a switch value of YES, NO or AUTO **
*****************************************************************
061-Init.
IF SV-1 = 'A'
PERFORM 070-Find-LINKAGE-SECTION
IF 88-Compile-As-Subpgm
MOVE 'Y' TO Switch-Value
ELSE
MOVE 'N' TO Switch-Value
END-IF
ELSE
PERFORM 040-Process-Yes-No-Value
END-IF
.
/
070-Find-LINKAGE-SECTION SECTION.
*****************************************************************
** Determine if the program being compiled is a MAIN program **
*****************************************************************
071-Init.
OPEN INPUT Source-Code
SET 88-Compile-As-Mainpgm TO TRUE
SET 88-More-To-1st-Prog TO TRUE
PERFORM UNTIL 88-1st-Prog-Complete
READ Source-Code AT END
CLOSE Source-Code
EXIT SECTION
END-READ
CALL 'CHECKSOURCE' USING Source-Code-Record
F-Source-Record-Type
END-CALL
IF 88-Source-Rec-Ident
SET 88-1st-Prog-Complete TO TRUE
END-IF
END-PERFORM
.
072-Process-Source.
SET 88-Source-Rec-IgnoCOB-COLOR-RED TO TRUE
PERFORM UNTIL 88-Source-Rec-Linkage
OR 88-Source-Rec-Ident
READ Source-Code AT END
CLOSE Source-Code
EXIT SECTION
END-READ
CALL 'CHECKSOURCE' USING Source-Code-Record
F-Source-Record-Type
END-CALL
END-PERFORM
CLOSE Source-Code
IF 88-Source-Rec-Linkage
SET 88-Compile-As-Subpgm TO TRUE
END-IF
.
079-Done.
EXIT.
/
100-Initialization SECTION.
*****************************************************************
** Perform all program-wide initialization operations **
*****************************************************************
GC0909 101-Determine-OS-Type.
GC0909 CALL 'GETOSTYPE'
GC0909 END-CALL
GC0909 MOVE RETURN-CODE TO OS-Type
GC0909 EVALUATE TRUE
GC0909 WHEN OS-Unknown
GC0909 MOVE '\' TO Dir-Char
GC0909 MOVE 'Unknown' TO OS-Type-Literal
GC0310 MOVE COB-SCR-F11 TO CK-S-F1
GC0310 MOVE COB-SCR-F12 TO CK-S-F2
GC0310 MOVE COB-SCR-F13 TO CK-S-F3
GC0310 MOVE COB-SCR-F14 TO CK-S-F4
GC0310 MOVE COB-SCR-F15 TO CK-S-F5
GC0310 MOVE COB-SCR-F16 TO CK-S-F6
GC0310 MOVE COB-SCR-F17 TO CK-S-F7
GC0909 WHEN OS-Windows
84
OpenCOBOL 1.1 Programmers Guide
Sample Programs
06FEB2009 Version
Page 8-16
GC0909 MOVE '\' TO Dir-Char
GC0909 MOVE 'Windows' TO OS-Type-Literal
GC0310 MOVE COB-SCR-F13 TO CK-S-F1
GC0310 MOVE COB-SCR-F14 TO CK-S-F2
GC0310 MOVE COB-SCR-F15 TO CK-S-F3
GC0310 MOVE COB-SCR-F16 TO CK-S-F4
GC0310 MOVE COB-SCR-F17 TO CK-S-F5
GC0310 MOVE COB-SCR-F18 TO CK-S-F6
GC0310 MOVE COB-SCR-F19 TO CK-S-F7
GC0909 WHEN OS-Cygwin
GC0909 MOVE '/' TO Dir-Char
GC0410 MOVE 'Cygwin' TO OS-Type-Literal
GC0310 MOVE COB-SCR-F11 TO CK-S-F1
GC0310 MOVE COB-SCR-F12 TO CK-S-F2
GC0310 MOVE COB-SCR-F13 TO CK-S-F3
GC0310 MOVE COB-SCR-F14 TO CK-S-F4
GC0310 MOVE COB-SCR-F15 TO CK-S-F5
GC0310 MOVE COB-SCR-F16 TO CK-S-F6
GC0310 MOVE COB-SCR-F17 TO CK-S-F7
GC0909 WHEN OS-UNIX
GC0909 MOVE '/' TO Dir-Char
GC0410 MOVE 'UNIX ' TO OS-Type-Literal
GC0310 MOVE COB-SCR-F11 TO CK-S-F1
GC0310 MOVE COB-SCR-F12 TO CK-S-F2
GC0310 MOVE COB-SCR-F13 TO CK-S-F3
GC0310 MOVE COB-SCR-F14 TO CK-S-F4
GC0310 MOVE COB-SCR-F15 TO CK-S-F5
GC0310 MOVE COB-SCR-F16 TO CK-S-F6
GC0310 MOVE COB-SCR-F17 TO CK-S-F7
GC0909 END-EVALUATE
GC0909 .
102-Set-Environment-Vars.
SET ENVIRONMENT 'COB_SCREEN_EXCEPTIONS' TO 'Y'
SET ENVIRONMENT 'COB_SCREEN_ESC' TO 'Y'
.
103-Generate-Cobc-Output-Fn.
ACCEPT Env-TEMP
FROM ENVIRONMENT "TEMP"
END-ACCEPT
MOVE SPACES TO Cobc-Output-File
STRING TRIM(Env-TEMP,TRAILING)
GC0909 Dir-Char
GC0909 'OC-Messages.TXT'
DELIMITED SIZE
INTO Cobc-Output-File
END-STRING
.
104-Generate-Banner-Line-Info.
MOVE WHEN-COMPILED (1:12) TO OC-Compiled
INSPECT OC-Compiled
REPLACING ALL '/' BY ':'
AFTER INITIAL SPACE
.
105-Establish-Switch-Settings.
ACCEPT Command-Line-Args
FROM COMMAND-LINE
END-ACCEPT
MOVE TRIM(Command-Line-Args, Leading)
TO Command-Line-Args
MOVE 0 TO Tally
GC0410 INSPECT Command-Line-Args TALLYING Tally FOR ALL '@'
IF Tally = 0
MOVE Command-Line-Args TO File-Name
MOVE SPACES TO Command-Line-Args
ELSE
GC0410 UNSTRING Command-Line-Args DELIMITED BY '@'
INTO File-Name, Dummy
END-UNSTRING
INSPECT Command-Line-Args
GC0410 REPLACING FIRST '@' BY LOW-VALUES
UNSTRING Command-Line-Args
DELIMITED BY LOW-VALUES
INTO Dummy, Cmd
END-UNSTRING
MOVE SPACES TO Command-Line-Args
GC0410 STRING '@' Cmd DELIMITED SIZE
INTO Command-Line-Args
END-STRING
END-IF
IF File-Name = SPACES
Documents you may be interested
Documents you may be interested