 |
|
| When technology complements business | Source Code Scanning |
| Copyright © 1987-2008 SimoTime Enterprises, LLC All Rights Reserved | http://www.simotime.com |
|
|||||
|
This set of programs (three COBOL programs) will scan a record sequential file of 80-byte fixed length records and has the ability to replace the non-display or non-printable characters with a space character and document the change. This utility is referred to as the Hexadecimal Scanner (or HS80). HS80 will scan data strings of 80 bytes in length. HS80 is typically used to scan mainframe source members that have been downloaded to a Windows system that is running a Micro Focus environment. The source members that will be scanned should be downloaded in BINARY mode to retain their eighty (80) byte fixed record length with EBCDIC encoded contents.
This set of sample programs will help identify mainframe COBOL or Assembler source members that contain embedded hexadecimal (or HEX) characters. The EBCDIC format provides for 256, single-byte characters from X'00' to X'FF'. A subset of the character set for EBCDIC or ASCII encoded formats is not printable or displayable to a screen. Source members should only contain characters that are printable or displayable. All other characters are referred to as embedded hexadecimal (or HEX) characters. The non-printable or hex characters are typically used as control characters and should be considered as "bit-sensitive" binary values
Before we look at solving the problem lets review how the problem was created. Prior to the mid-1980's it was necessary to use an editor with hex capability to key in hexadecimal values. Once a source member contained hexadecimal values it had to be carefully monitored because many editors would only display a space since the hex value could not be displayed. In addition, the compiler listing would display spaces and the embedded hex characters were hidden from view. A programmer could make a change that had nothing to do with the hex values and inadvertently change the hex value to a space when the member was saved. The program would then fail in a completely unexpected manner and the resulting debugging effort could take a significant amount of time. In other words this was (and still is) an accident waiting to happen on the mainframe.
Code generators were another area where hexadecimal characters were introduced into source members. This was especially true of copy files that generated tables. These programs required extra effort to understand and maintain.
During the mid-1980's IBM introduced COBOL/2 and it provided COBOL programmers with a method for defining data fields containing hexadecimal values. The following statement is an example of using the Hex coding capability provided in the mainframe COBOL/2 dialect to define a field (HEX-1F) containing an X'1F'.
01 HEX-1F PIC X VALUE X'1F'.
When source members are ported to a Windows or UNIX platform the translation from EBCDIC to ASCII introduces a whole new set of problems. In many cases the hexadecimal characters were incorrectly converted. Certain characters will be accepted into an ASCII/Text file and will either display a space or graphics character. Other characters such as X'0A', X'0D' and X'1A' function as control characters such as Line Feed, Carriage Return and End-of-File. These will definitely cause problems in opening, reading or displaying the contents of the file. The X'1A' or End-of-File can result in lost data when attempting to copy the file or opening and closing with a text editor.
Over the years much of the source code containing embedded hexadecimal characters has been replaced using the capability provided in the Hex coding capability provided in the IBM Mainframe COBOL/2 dialect (introduced in the mid-1980's). However, code with embedded hexadecimal characters still exists and assistance is needed to help identify source member and records within the source members. The primary purpose of this set of programs is to scan a list of COBOL source members and identify the records containing embedded hexadecimal values. This suite of programs runs on a Windows platform using Micro Focus Net Express, version 3.1 or later. The mainframe source members must be downloaded to the PC in their original fixed, 80-byte, EBCDIC format.
The following is a flowchart of the programs that are linked together into a single executable member using Micro Focus Net Express.
The following is a block diagram of the program and data flow. The BLUE boxes identify the data. The AQUA boxes identify the control information or parameters. The RED boxes identify the program or process steps that execute on a Windows platform with Micro Focus Net Express. The GRAY boxes with green text identify the display screen or console.
|
Installation Verification Program | ||||||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||||||
|
|
|
Process Member List | ||||||||||||||||||||||||||||
|
|
|
|
||||||||||||||||||||||||||||
|
|
|
|
|
|
End | Scan Source Member, Post HEX content, Convert to ASCII |
||||||||||||||||||||||||
|
|
of | |||||||||||||||||||||||||||||
|
|
|
|
File | Write to Log, Display to Screen |
||||||||||||||||||||||||||
|
|
|
|
|
||||||||||||||||||||||||||||
|
The programs in this application are written in COBOL and are intended to be compiled and linked to run on a PC platform with Windows. The following is required.
| Item | Description |
| Windows/NT or XP | The programs have not been tested and are not supported for previous versions of Windows. |
| Net Express | Version 3.1 or later is provided by Micro Focus. The programs will not work on previous versions of Net Express. |
| SimoMODS by SimoTime | The is a package of commonly used (or commonly called) programs or script files that is provided by SimoTime Enterprises. This evaluation package of the SimoMODS software may be downloaded. For more information refer to The SimoMODS Series |
The first COBOL program contains Micro Focus dialect and will not compile on the mainframe. The second and third programs may be compiled and executed on the mainframe but will only process a single source member at a time.
This section will describe the features included in the hexadecimal scan programs.
The hexadecimal scan program uses a table that is defined in a copy file to determine if a character is printable.
The hexadecimal scan process has the ability to replace an embedded hexadecimal character with a displayable or printable character. The replacement character is defined by using the HSACTION environment variable.
set HSACTION=REPLACEALL(^)
The preceding set statement will cause the hex scan program to replace all embedded hex characters with the "^" character. The default action is to leave the the embedded hex unchanged.
set HSACTION=NONE
The hexadecimal scan process has the ability to dump a record showing the actual values of the embedded hexadecimal characters. This is done by inserting three records after the record with the embedded hex characters. The first inserted line shows the value of the zone or leftmost nibble of each byte in the record. The second inserted line shows the value of the decimal or rightmost nibble of each byte in the record. The third line has an asterisk in the positions that have been recognized as embedded hexadecimal.
Since the dump information is a text line inserted into the source code it will cause a compile error. To prevent a compile error it is possible to make a comment line out of the dump lines. This is done by using the HSNOTICE environment variable.
set HSNOTICE=DUMPCMT(*,07)
In the preceding example the DUMPCMT identifies the variable as a specification for defining a comment. The asterisk is the character to be inserted and the "07" is the position to insert the character. This example will work when scanning COBOL source code. For mainframe Assembler (HLASM) the asterisk would need to be inserted in position 1.
Each character within the individual records will be converted from its EBCDIC encoded format to an ASCII encoded format with the exception of the embedded hexadecimal characters. The embedded hexadecimal characters are converted based on the HSACTION environment variable..
This set of programs is primarily intended for use with COBOL source members. It will also scan other mainframe source members that are downloaded to the PC in EBCDIC, fixed, 80-byte format. It has been used to scan JCL, Assembler, copy files and Assembler macro files.
The source members need to be downloaded from the mainframe to the PC in their original EBCDIC, fixed, 80-byte format. If FTP is used for the download then use the "BINARY" format. Do not use the "ASCII" format.
Since the name of the downloaded EBCDIC member is the same as the ASCII member to be created it will be necessary to have an input and an output directory.
An easy way to create the member list file (MEMLIST1) is to use the following command line statement.
C:\>dir c:\mydir\*.ext /on /a-d /b >memlist1.txt
If the COBOL programs contain OSVS dialect and are compiled on the mainframe using the OSVS COBOL compiler the programs will need to be upgraded to COBOL/2 or later. The OSVS COBOL dialect does not support the hexadecimal coding syntax (i.e. X’xx'). The hexadecimal coding syntax was introduced by IBM in the mid-1980's with the announcement of the IBM COBOL/2 compiler.
If the source code is mainframe assembler the utility will catch the problem but the solution will require a specialized skill to fix. An individual with mainframe assembler programming expertise will be required.
The first step in the process is to correctly identify hexadecimal values in source code. This is not a foolproof technical solution. For example, some hexadecimal items may coincidently have a valid conversion to ASCII and would not be recognized as an embedded hex character or binary string. For example, lets take a look at a sample binary string containing four bytes of hex information as follows 00.C1.F0.FF. The x'00' and x'FF' (the 1st and 4th bytes) will be recognized as hex values. The x'C1' and x'F0' (the 2nd an 3rd bytes) will be recognized as valid EBCDIC characters of "A" and "0" that could be converted to x'41' and x'30' which are the ASCII-encoded representation for "A" and "0". The decision as to how to convert this data string must be made by an individual that has knowledge of what the program expects.
The second step begins once the embedded hexadecimal values have been identified. The source members containing the embedded hexadecimal values should be corrected in their EBCDIC-encoded format prior to converting to ASCII. This can easily be done on the mainframe. Another alternative is to download to a Windows platform and use the Micro Focus Data File Editor to view and correct the embedded hex coding. The Data File Editor has the ability to view and change hexadecimal values within a record within a file. Please note, the source members must be downloaded in the original EBCDIC-encoded format. This can be done using the BINARY mode of FTP or the Micro Focus Mainframe Access program.
The third step in the process is to convert the source members from their EBCDIC-encoded formats to an ASCII-encoded format. This can be done on the mainframe, during the download process or on the client or server machine.
The UtlHexScanCblForHex.CMD file is primarily intended as an Installation Verification Program (IVP). It also serves as an example of how to run the Hexadecimal Scan Program and map the PC file names to the program file names.
@echo OFF
echo * ScanCblForHex.CMD is Starting...
echo ******************************************************************
echo * This program is provided by: *
echo * SimoTime Enterprises, LLC *
echo * (C) Copyright 1987-2008 All Rights Reserved *
echo * Web Site URL: http://www.simotime.com *
echo * e-mail: helpdesk@simotime.com *
echo ******************************************************************
rem *
rem ******************************************************************
rem * Step 1 Set SYSLOG and Delete any previously created SYSLOG...
rem ******************************************************************
rem *
call Env1PROD
set SYSLOG=%BaseLib1%\LOGS\SYSLOG_HS80LOGS.TXT
set CmdName=UtlHexScanCblForHex
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting JobName %CmdName%"
rem *
rem ******************************************************************
rem * Step 2 Set DataEbc1 and DataAsc1 drive:\directory values
rem ******************************************************************
rem * The following two set statements define...
rem * 1. The drive and directory containing the EBCDIC Source Code.
rem * 2. The drive and directory to contain the ASCII Source Code.
set DataEbc1=%BaseLib1%\DataLibA\CblEbc
set DataAsc1=%BaseLib1%\DataLibA\CblAsc
rem *
rem ******************************************************************
rem * Step 3 Set MEMLIST for the member-list file...
rem ******************************************************************
rem * The following set statement defines the file containing a list
rem * of source members that will be scanned.
set memlist1=%BaseLib1%\DataLibA\Txt1\memList1.txt
set HSACTION=REPLACEALL(!)
set HSNOTICE=DUMPCMT(*,07)
rem *
rem ******************************************************************
rem * Step 4 Execute the program...
rem ******************************************************************
rem * The following statement will execute the scanner program
run utlhexc1
if not "%ERRORLEVEL%" == "0" set JobStatus=0010
if not "%JobStatus%" == "0000" goto :EojNOK
:EojAOK
call SimoNOTE "Finished CmdName %CmdName%, Job Status is %JobStatus%"
goto :End
:EojNOK
call SimoNOTE "ABENDING CmdName %CmdName%, Job Status is %JobStatus%"
echo %DATE% - %TIME% Starting User ABEND Processing...>>%SYSLOG%
set >>%SYSLOG%
echo %DATE% - %TIME% Complete User ABEND Processing...>>%SYSLOG%
goto :End
:End
call SimoNOTE "Conclude SysOut is %SYSOUT%"
if not "%1" == "nopause" pause
exit /B %JobStatus%
The first program (UTLHEXC1.CBL) simply reads an ASCII/Text file containing a list of members to be scanned and converted to ASCII/Text files. The environment variables are set to map the PC file names to the program names. A second program (UTLHEXC2.CBL) is called to do the scanning, hex detection and conversion. The third program (UTLHEXC3.CBL) is called to display and log information.
The first program (UTLHEXC1.CBL) simply reads an ASCII/Text file containing a list of members to be scanned and converted to ASCII/Text files. The environment variables are set to map the PC file names to the program names.
IDENTIFICATION DIVISION.
PROGRAM-ID. UTLHEXC1.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2006 SimoTime Enterprises, LLC. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Enterprises. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Enterprises. *
* *
* Permission to use, copy and modify this software for any *
* non-commercial purpose and without fee is hereby granted, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used in *
* any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Enterprises. *
* *
* SimoTime Enterprises makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any express or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Enterprises shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Enterprises *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
* MAINTENANCE
* -----------
* 1994/02/27 Simmons, Created program.
*
*****************************************************************
* Source Member: UTLHEXC1.CBL
* Copy Files: UTLHEXB2
* Calls to: UTLHEXC2
*****************************************************************
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT MEMLIST1 ASCII/CRLF VARIABLE 00512 *
* *
*****************************************************************
* This program will get the parameters from the MEMLIST1 file,
* set an environment variable based on the MEMLIST1 file input
* and then call a second COBOL program - UTLHEXC2.
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SYSUT1-FILE ASSIGN TO MEMLIST1
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS SYSUT1-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD SYSUT1-FILE
DATA RECORD IS SYSUT1-RECORD
RECORDING MODE IS VARIABLE
.
01 SYSUT1-RECORD.
05 SYSUT1-DATA-01 PIC X(00512).
*****************************************************************
WORKING-STORAGE SECTION.
*****************************************************************
* Data-structure for Title and Copyright...
*****************************************************************
01 SIM-TITLE.
05 T1 pic X(11) value '* UTLHEXC1 '.
05 T2 pic X(34) value 'Scan for Embedded Hex Characters '.
05 T3 pic X(10) value ' v06.08.03'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* UTLHEXC1 '.
05 C2 pic X(20) value 'Copyright 1987-2006 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 SIM-THANKS-01.
05 C1 pic X(11) value '* UTLHEXC1 '.
05 C2 pic X(32) value 'Thank you for using this sample '.
05 C3 pic X(32) value 'by SimoTime Enterprises, LLC '.
05 C4 pic X(04) value ' '.
01 SIM-THANKS-02.
05 C1 pic X(11) value '* UTLHEXC1 '.
05 C2 pic X(32) value 'Please send comments or suggesti'.
05 C3 pic X(32) value 'ons to helpdesk@simotime.com '.
05 C4 pic X(04) value ' '.
*****************************************************************
01 SYSUT1-STATUS.
05 SYSUT1-STATUS-L pic X.
05 SYSUT1-STATUS-R pic X.
01 SYSUT1-EOF pic X value 'N'.
01 SYSUT1-OPEN-FLAG pic X value 'C'.
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 TWO-BYTES.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
01 TWO-BYTES-BINARY redefines TWO-BYTES pic 9(4) comp.
01 IO-STATUS-4 pic 9(4) value 0.
01 IO-STATUS-4A redefines IO-STATUS-4 pic X(4).
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* UTLHEXC1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
*****************************************************************
* Data-structure for environment variable get routine...
*****************************************************************
01 ENV-VAR-NAME pic X(16) value SPACES.
01 ENV-VAR-VALUE pic X(256) value SPACES.
01 ENV-VAR-SIZE pic 9(3) value 0.
01 BUFFER-SIZE pic 9(3) value 80.
01 PTR-01 pic 9(3) value 0.
01 NUMB-01 pic 9(3) value 0.
01 SYSUT1-TOTAL.
05 filler pic X(23) value 'Source member count is '.
05 SYSUT1-RDR pic 9(9) value 0.
05 filler pic X value SPACE.
01 SYSUT1-TOTAL-2.
05 filler pic X(23) value 'Total Lines of Code is '.
05 TOTAL-LOC pic 9(9) value 0.
05 filler pic X(20) value ' Total Hex count is '.
05 TOTAL-ERR pic 9(9) value 0.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 UTLHEXC3-PASS-AREA.
05 UTLHEXC3-REQUEST pic X(8).
05 UTLHEXC3-RESPOND pic 9999.
05 UTLHEXC3-MESSAGE pic X(267).
COPY UTLHEXB2.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
perform SYSUT1-OPEN
perform until SYSUT1-STATUS not = '00'
perform SYSUT1-READ
if SYSUT1-STATUS = '00'
add 1 to SYSUT1-RDR
perform BUILD-ENVIRONMENT-FOR-CALL
if RETURN-CODE = 0
call 'UTLHEXC2' using UTLHEXC2-PASS-AREA
add UTLHEXC2-LOC to TOTAL-LOC
add UTLHEXC2-ERR to TOTAL-ERR
end-if
end-if
end-perform
move SYSUT1-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SYSUT1-TOTAL-2 to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
if APPL-EOF
move 'is Complete...' to MESSAGE-TEXT
else
move 'is ABENDING...' to MESSAGE-TEXT
end-if
perform Z-DISPLAY-MESSAGE-TEXT
perform SYSUT1-CLOSE
perform Z-THANK-YOU.
GOBACK.
*****************************************************************
BUILD-ENVIRONMENT-FOR-CALL.
move 'SCANCODE' to UTLHEXC2-REQUEST
perform BUILD-ENVIRONMENT-FOR-COMMON
perform BUILD-ENVIRONMENT-FOR-INPUT
perform BUILD-ENVIRONMENT-FOR-OUTPUT
exit.
*****************************************************************
BUILD-ENVIRONMENT-FOR-COMMON.
move 'N' to HS-ACTION-FLAG
move SPACES to ENV-VAR-NAME
move 'HSACTION' to ENV-VAR-NAME
perform ENVIRONMENT-VARIABLE-GET
if ENV-VAR-VALUE not = SPACES
if ENV-VAR-VALUE(1:11) = 'REPLACEALL('
and ENV-VAR-VALUE(13:1) = ')'
move ENV-VAR-VALUE(12:1) to HS-REPLACEALL-BYTE
move 'B' to HS-ACTION-FLAG
end-if
end-if
move 'N' to HS-NOTICE-FLAG
move SPACES to ENV-VAR-NAME
move 'HSNOTICE' to ENV-VAR-NAME
perform ENVIRONMENT-VARIABLE-GET
if ENV-VAR-VALUE not = SPACES
* process DUMPCMT(*,07)
if ENV-VAR-VALUE not = SPACES
if ENV-VAR-VALUE(1:8) = 'DUMPCMT('
and ENV-VAR-VALUE(10:1) = ','
and ENV-VAR-VALUE(13:1) = ')'
and ENV-VAR-VALUE(11:2) is NUMERIC
move ENV-VAR-VALUE(9:1) to HS-DUMPCMT-BYTE
move ENV-VAR-VALUE(11:2) to HS-DUMPCMT-POS-X
move 'C' to HS-NOTICE-FLAG
end-if
end-if
exit.
*****************************************************************
BUILD-ENVIRONMENT-FOR-INPUT.
move SPACES to ENV-VAR-NAME
move 'DATAEBC1' to ENV-VAR-NAME
perform ENVIRONMENT-VARIABLE-GET
if ENV-VAR-VALUE not = SPACES
perform ENVIRONMENT-VALUE-SIZE
if ENV-VAR-VALUE(ENV-VAR-SIZE:1) not = '\'
add 1 to ENV-VAR-SIZE
move '\' to ENV-VAR-VALUE(ENV-VAR-SIZE:1)
subtract ENV-VAR-SIZE from 256 giving NUMB-01
move SYSUT1-DATA-01
to ENV-VAR-VALUE(ENV-VAR-SIZE + 1:NUMB-01)
end-if
else
move SYSUT1-DATA-01 to ENV-VAR-VALUE
end-if
move SPACES to ENV-VAR-NAME
move 'CODEEBC1' to ENV-VAR-NAME
perform ENVIRONMENT-VARIABLE-SET
if RETURN-CODE = 0
move ENV-VAR-VALUE to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
else
move 'SET-ENV Failed for CODEEBC1...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ENV-VAR-VALUE to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
BUILD-ENVIRONMENT-FOR-OUTPUT.
move SPACES to ENV-VAR-NAME
move 'DATAASC1' to ENV-VAR-NAME
perform ENVIRONMENT-VARIABLE-GET
if ENV-VAR-VALUE not = SPACES
perform ENVIRONMENT-VALUE-SIZE
if ENV-VAR-VALUE(ENV-VAR-SIZE:1) not = '\'
add 1 to ENV-VAR-SIZE
move '\' to ENV-VAR-VALUE(ENV-VAR-SIZE:1)
subtract ENV-VAR-SIZE from 256 giving NUMB-01
move SYSUT1-DATA-01
to ENV-VAR-VALUE(ENV-VAR-SIZE + 1:NUMB-01)
end-if
else
move SYSUT1-DATA-01 to ENV-VAR-VALUE
end-if
move SPACES to ENV-VAR-NAME
move 'CODEASC1' to ENV-VAR-NAME
perform ENVIRONMENT-VARIABLE-SET
if RETURN-CODE = 0
move ENV-VAR-VALUE to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
else
move 'SET-ENV Failed for CODEASC1...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
ENVIRONMENT-VALUE-SIZE.
add 1 to ZERO giving PTR-01
subtract ENV-VAR-SIZE from ENV-VAR-SIZE
perform until PTR-01 > BUFFER-SIZE
if ENV-VAR-VALUE(PTR-01:1) not = SPACE
add PTR-01 to ZERO giving ENV-VAR-SIZE
end-if
add 1 to PTR-01
end-perform
exit.
*****************************************************************
* Get an environment variable.
*****************************************************************
ENVIRONMENT-VARIABLE-GET.
subtract RETURN-CODE from RETURN-CODE
move SPACES to ENV-VAR-VALUE
display ENV-VAR-NAME upon ENVIRONMENT-NAME
on exception add 4 to ZERO giving RETURN-CODE
end-display
accept ENV-VAR-VALUE from ENVIRONMENT-VALUE
on exception add 4 to ZERO giving RETURN-CODE
end-accept
if RETURN-CODE not = 0
move SPACES to ENV-VAR-VALUE
end-if
exit.
*****************************************************************
* Set an environment variable.
*****************************************************************
ENVIRONMENT-VARIABLE-SET.
display ENV-VAR-NAME upon ENVIRONMENT-NAME
on exception add 4 to ZERO giving RETURN-CODE
end-display
display ENV-VAR-VALUE upon ENVIRONMENT-VALUE
on exception add 4 to ZERO giving RETURN-CODE
end-display
exit.
*****************************************************************
* I/O ROUTINES FOR SYSUT1... *
*****************************************************************
SYSUT1-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close SYSUT1-FILE
if SYSUT1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'MEMLIST1-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SYSUT1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
SYSUT1-READ.
read SYSUT1-FILE
if SYSUT1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if SYSUT1-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if
if APPL-AOK
CONTINUE
else
if APPL-EOF
move 'Y' to SYSUT1-EOF
else
move 'MEMLIST1-Failure-GET...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SYSUT1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
SYSUT1-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input SYSUT1-FILE
if SYSUT1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to SYSUT1-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'MEMLIST1-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SYSUT1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* The following Z-Routines perform administrative tasks *
* for this program. *
*****************************************************************
*****************************************************************
* ABEND the program, post a message to the console and issue *
* a STOP RUN. *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-DISPLAY-MESSAGE-TEXT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 12 to ZERO giving RETURN-CODE
STOP RUN
exit.
*****************************************************************
Z-POST-COPYRIGHT.
move SIM-TITLE to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
move SIM-COPYRIGHT to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-4
move IO-STAT1 to IO-STATUS-4A(1:1)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-4A to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-4A
move IO-STATUS to IO-STATUS-4A(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-4A to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
move 'FILESHOW' to UTLHEXC3-REQUEST
move MESSAGE-BUFFER to UTLHEXC3-MESSAGE
call 'UTLHEXC3' using UTLHEXC3-PASS-AREA
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
Z-THANK-YOU.
move SIM-THANKS-01 to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
move SIM-THANKS-02 to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
* This example is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
The second program (UTLHEXC2.CBL) reads the source member that is in EBCDIC, fixed, 80-byte format and writes to an ASCII/Text file. Each record is scanned and if no embedded hex characters are found the record is converted to ASCII and written to the output, ASCII/Text file.
If embedded hex characters are found then multiple records are written to the ASCII/Text file. The first record is an ASCII record with the embedded hex characters converted to periods. The second and third records provide a hex dump of the original EBCDIC record. The fourth record has an asterisk in each position that contains an embedded hex character and the fifth record is a position indicator.
* The following 01 has non-visible, embedded hex character.
* 1
* F
01 HEX-1F-WRONG pic X value '?'.
4444444FF44CCE6FC6EDDDC44449884E4444A89A8471744444444444444444444444444444444444
000000001008570110696570000793070000513450DFDB0000000000000000000000000000000000
*
....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8
The following is the source code listing.
IDENTIFICATION DIVISION.
PROGRAM-ID. UTLHEXC2.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2008 SimoTime Enterprises, LLC. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute this software *
* for any non-commercial purpose and without fee is hereby *
* granted, provided the SimoTime copyright notice appear on all *
* copies of the software. The SimoTime name or Logo may not be *
* used in any advertising or publicity pertaining to the use *
* of the software without the written permission of SimoTime *
* Enterprises. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Enterprises. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Enterprises. *
* *
* SimoTime Enterprises makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any express or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Enterprises shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Enterprises *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
*****************************************************************
* This base program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Record Record Key *
* Function Name Organization Format Max-Min Pos-Len *
* INPUT CODEEBC1 SEQUENTIAL FIXED 00080 *
* OUTPUT CODEASC1 ASCII/CRLF VARIABLE 00080 *
* *
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CODEEBC1-FILE ASSIGN TO CODEEBC1
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS CODEEBC1-STATUS.
SELECT CODEASC1-FILE ASSIGN TO CODEASC1
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS CODEASC1-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD CODEEBC1-FILE
DATA RECORD IS CODEEBC1-RECORD
.
01 CODEEBC1-RECORD.
05 CODEEBC1-DATA-01 PIC X(00080).
FD CODEASC1-FILE
DATA RECORD IS CODEASC1-RECORD
RECORDING MODE IS VARIABLE
.
01 CODEASC1-RECORD.
05 CODEASC1-DATA-01 PIC X(00080).
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* UTLHEXC2 '.
05 T2 pic X(34) value 'Find embedded Hex, write ASCII... '.
05 T3 pic X(10) value 'v07.10.17 '.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* UTLHEXC2 '.
05 C2 pic X(20) value 'Copyright 1987-2008 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 SIM-THANKS-01.
05 C1 pic X(11) value '* UTLHEXC2 '.
05 C2 pic X(32) value 'Thank you, this technology was p'.
05 C3 pic X(32) value 'roduced at SimoTime Enterprises,'.
05 C4 pic X(04) value ' LLC'.
01 SIM-THANKS-02.
05 C1 pic X(11) value '* UTLHEXC2 '.
05 C2 pic X(32) value 'Please send all inquires or sugg'.
05 C3 pic X(32) value 'estions to the helpdesk@simotime'.
05 C4 pic X(04) value '.com'.
01 CODEEBC1-STATUS.
05 CODEEBC1-STATUS-L pic X.
05 CODEEBC1-STATUS-R pic X.
01 CODEEBC1-EOF pic X value 'N'.
01 CODEEBC1-OPEN-FLAG pic X value 'C'.
01 CODEASC1-STATUS.
05 CODEASC1-STATUS-L pic X.
05 CODEASC1-STATUS-R pic X.
01 CODEASC1-OPEN-FLAG pic X value 'C'.
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 TWO-BYTES.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
01 TWO-BYTES-BINARY redefines TWO-BYTES pic 9(4) comp.
01 IO-STATUS-4 pic 9(4) value 0.
01 IO-STATUS-4A redefines IO-STATUS-4 pic X(4).
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* UTLHEXC2 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 MESSAGE-BUFFER-SIZE pic 9(3) value 267.
01 MSG-PTR pic 9(3) value 0.
01 MSG-LEN pic 9(3) value 0.
01 PROGRAM-NAME pic X(8) value 'UTLHEXC2'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 WORK-05 pic X(05) value SPACES.
01 WORK-80 pic X(80) value SPACES.
01 EMBEDDED-HEX-STATUS pic X value 'N'.
01 ASCII-SOURCE-STATUS pic X value 'Y'.
01 CODEEBC1-TOTAL.
05 filler pic X(20) value 'INPUT File contains '.
05 CODEEBC1-RDR pic 9(9) value 0.
05 filler pic X(10) value ' records. '.
05 filler pic X(19) value 'HEX record count = '.
05 CODEEBC1-ERR pic 9(9) value 0.
05 filler pic X value '.'.
05 CODEEBC1-ATTN pic X(8) value SPACES.
01 HEX-HEADER.
05 filler pic X(20) value '....+....1....+....2'.
05 filler pic X(20) value '....+....3....+....4'.
05 filler pic X(20) value '....+....5....+....6'.
05 filler pic X(20) value '....+....7....+....8'.
01 SOURCE-01 PIC X(80).
01 RESULT-01 PIC X(80).
01 RESULT-02 PIC X(80).
01 RESULT-03 PIC X(80).
01 IDX-01 PIC 9(4) COMP VALUE 0.
01 HEX-HW REDEFINES IDX-01.
05 HEX-HW-HI PIC X.
05 HEX-HW-LO PIC X.
01 PTR-01 PIC 9(4) VALUE 0.
01 PT-IDX pic 9(3) value 0.
01 UTLHEXC3-PASS-AREA.
05 UTLHEXC3-REQUEST pic X(8).
05 UTLHEXC3-RESPOND pic 9999.
05 UTLHEXC3-MESSAGE pic X(267).
*****************************************************************
* The following copy file contains the translation tables for *
* the ASCII and EBCDIC conversion. Sections of the tables may *
* also be used for case conversion. *
*****************************************************************
COPY ASCEBCB1.
*****************************************************************
* The following tables are used to convert non-printable, *
* EBCDIC characters to SPACES. *
*****************************************************************
*COPY HEX256B2.
COPY BIN256B1.
COPY PRTEBCB2.
*****************************************************************
* The following copy file is for the Hex Dump routine. *
*****************************************************************
COPY HEXTABLE.
*****************************************************************
LINKAGE SECTION.
COPY UTLHEXB2.
*****************************************************************
PROCEDURE DIVISION using UTLHEXC2-PASS-AREA.
perform INITIALIZE-DATA
perform CODEEBC1-OPEN
perform CODEASC1-OPEN
perform until CODEEBC1-STATUS not = '00'
perform CODEEBC1-READ
if CODEEBC1-STATUS = '00'
perform EMBEDDED-HEX-TEST
if EMBEDDED-HEX-STATUS = 'N'
add 1 to CODEEBC1-RDR
else
add 1 to CODEEBC1-RDR
add 1 to CODEEBC1-ERR
end-if
perform BUILD-OUTPUT-INFORMATION
end-if
end-perform
if CODEEBC1-ERR > 0
add 4 to ZERO giving RETURN-CODE
move 'RC=0004 ' to UTLHEXC2-RESPOND
move ' !!!! ' to CODEEBC1-ATTN
move CODEEBC1-TOTAL to UTLHEXC2-MESSAGE
end-if
move CODEEBC1-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
perform CODEASC1-CLOSE
perform CODEEBC1-CLOSE
add CODEEBC1-RDR to ZERO giving UTLHEXC2-LOC
add CODEEBC1-ERR to ZERO giving UTLHEXC2-ERR
perform Z-THANK-YOU.
GOBACK.
*****************************************************************
* The following routines are in alphabetical sequence.. *
*****************************************************************
*****************************************************************
BUILD-HEX-DUMP-INFO.
move all SPACES to RESULT-01
subtract PTR-01 from PTR-01
perform 80 times
add 1 to PTR-01
subtract IDX-01 from IDX-01
move CODEEBC1-DATA-01(PTR-01:1) to HEX-HW-LO
add 1 to IDX-01 giving PT-IDX
move TAB-X1(PT-IDX) to WORK-05
move WORK-05(1:1) to RESULT-01(PTR-01:1)
move WORK-05(2:1) to RESULT-02(PTR-01:1)
move WORK-05(3:1) to RESULT-03(PTR-01:1)
end-perform
exit.
*****************************************************************
BUILD-OUTPUT-INFORMATION.
if EMBEDDED-HEX-STATUS = 'Y'
* move HEX-HEADER to CODEASC1-RECORD
* perform CODEASC1-WRITE
perform BUILD-HEX-DUMP-INFO
move RESULT-03 to CODEASC1-RECORD
subtract PTR-01 from PTR-01
perform 80 times
add 1 to PTR-01
if CODEEBC1-DATA-01(PTR-01:1) not = WORK-80(PTR-01:1)
move HS-REPLACEALL-BYTE
to CODEASC1-DATA-01(PTR-01:1)
end-if
end-perform
perform CODEASC1-WRITE
move RESULT-01 to CODEASC1-RECORD
if HS-NOTICE-FLAG = 'C'
* make the line a comment
move HS-DUMPCMT-BYTE
to CODEASC1-RECORD(HS-DUMPCMT-POS:1)
end-if
perform CODEASC1-WRITE
move RESULT-02 to CODEASC1-RECORD
if HS-NOTICE-FLAG = 'C'
* make the line a comment
move HS-DUMPCMT-BYTE
to CODEASC1-RECORD(HS-DUMPCMT-POS:1)
end-if
perform CODEASC1-WRITE
move SPACES to CODEASC1-DATA-01
subtract PTR-01 from PTR-01
* move asterisk to positions of difference
perform 80 times
add 1 to PTR-01
if CODEEBC1-DATA-01(PTR-01:1) not = WORK-80(PTR-01:1)
move '*' to CODEASC1-DATA-01(PTR-01:1)
end-if
end-perform
if HS-NOTICE-FLAG = 'C'
* make the line a comment
move HS-DUMPCMT-BYTE
to CODEASC1-RECORD(HS-DUMPCMT-POS:1)
end-if
perform CODEASC1-WRITE
move HEX-HEADER to CODEASC1-RECORD
if HS-NOTICE-FLAG = 'C'
* make the line a comment
move HS-DUMPCMT-BYTE
to CODEASC1-RECORD(HS-DUMPCMT-POS:1)
end-if
perform CODEASC1-WRITE
end-if
if ASCII-SOURCE-STATUS = 'Y'
and EMBEDDED-HEX-STATUS = 'N'
move WORK-80 to CODEASC1-RECORD
inspect CODEASC1-RECORD
converting E-INFO to A-INFO
perform CODEASC1-WRITE
end-if
exit.
*****************************************************************
* TheTest the input record for embedded hex... *
*****************************************************************
EMBEDDED-HEX-TEST.
move 'N' to EMBEDDED-HEX-STATUS
move CODEEBC1-RECORD to WORK-80
inspect WORK-80 converting BINARY-DATA to P2-EBC
if WORK-80 not = CODEEBC1-RECORD
move 'Y' to EMBEDDED-HEX-STATUS
end-if
exit.
*****************************************************************
INITIALIZE-DATA.
move ZERO to CODEEBC1-RDR
move ZERO to CODEEBC1-ERR
move SPACES to CODEEBC1-ATTN
exit.
*****************************************************************
* I/O ROUTINES FOR CODEEBC1... *
*****************************************************************
CODEEBC1-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CODEEBC1-FILE
if CODEEBC1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CODEEBC1-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CODEEBC1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CODEEBC1-READ.
read CODEEBC1-FILE
if CODEEBC1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if CODEEBC1-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if
if APPL-AOK
CONTINUE
else
if APPL-EOF
move 'Y' to CODEEBC1-EOF
else
move 'CODEEBC1-Failure-GET...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CODEEBC1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
CODEEBC1-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input CODEEBC1-FILE
if CODEEBC1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CODEEBC1-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CODEEBC1-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CODEEBC1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O ROUTINES FOR CODEASC1... *
*****************************************************************
CODEASC1-WRITE.
if CODEASC1-OPEN-FLAG = 'C'
perform CODEASC1-OPEN
end-if
write CODEASC1-RECORD
if CODEASC1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if CODEASC1-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if.
if APPL-AOK
CONTINUE
else
move 'CODEASC1-Failure-WRITE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CODEASC1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CODEASC1-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT CODEASC1-FILE
if CODEASC1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CODEASC1-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CODEASC1-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CODEASC1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CODEASC1-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CODEASC1-FILE
if CODEASC1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to CODEASC1-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CODEASC1-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CODEASC1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* The following Z-ROUTINES provide administrative functions *
* for this program. *
*****************************************************************
*
*****************************************************************
* ABEND the program, post a message to the console and issue *
* a STOP RUN. *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-DISPLAY-MESSAGE-TEXT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 12 to ZERO giving RETURN-CODE
STOP RUN
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
move 'FILESHOW' to UTLHEXC3-REQUEST
move MESSAGE-BUFFER to UTLHEXC3-MESSAGE
call 'UTLHEXC3' using UTLHEXC3-PASS-AREA
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-4
move IO-STAT1 to IO-STATUS-4A(1:1)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-4A to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-4A
move IO-STATUS to IO-STATUS-4A(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-4A to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-THANK-YOU.
display SIM-THANKS-01 upon console
display SIM-THANKS-02 upon console
exit.
*****************************************************************
* This example is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
The third program (UTLHEXC3.CBL) simply displays information to the screen and writes to a log file.
IDENTIFICATION DIVISION.
PROGRAM-ID. UTLHEXC3.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2006 SimoTime Enterprises, LLC. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute this software *
* for any non-commercial purpose and without fee is hereby *
* granted, provided the SimoTime copyright notice appear on all *
* copies of the software. The SimoTime name or Logo may not be *
* used in any advertising or publicity pertaining to the use *
* of the software without the written permission of SimoTime *
* Enterprises. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Enterprises. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Enterprises. *
* *
* SimoTime Enterprises makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any express or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Enterprises shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Enterprises *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
* Source Member: UTLHEXC3.CBL
*****************************************************************
*
*>UTLHEXC3 - Call UTLHEXC3 to write record to the Message file.
*
* CALLING PROTOCOL
* ----------------
* Use standard procedure to EXECUTE, RUN or ANIMATE.
*
* DESCRIPTION
* -----------
* This program will write a message to the SYSLOG file.
*
*****************************************************************
*
* MAINTENANCE
* -----------
* 1997/12/18 Simmons, Created program.
* 1997/12/18 Simmons, No changes to date.
*
*****************************************************************
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*****************************************************************
SELECT SYSLOG-FILE
ASSIGN to SYSLOG
ORGANIZATION is LINE SEQUENTIAL
ACCESS MODE is SEQUENTIAL
FILE STATUS is SYSLOG-LOG-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
*****************************************************************
FD SYSLOG-FILE.
01 SYSLOG-RECORD.
05 SYSLOG-DATE pic X(10).
05 filler pic X.
05 SYSLOG-TIME pic X(11).
05 filler pic X.
05 SYSLOG-DATA pic X(489).
*****************************************************************
WORKING-STORAGE SECTION.
01 SYSLOG-LOG-STATUS.
05 SYSLOG-LOG-STAT1 pic X.
05 SYSLOG-LOG-STAT2 pic X.
01 SYSLOG-OPEN-FLAG pic X value 'N'.
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 TWO-BYTES.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
01 TWO-BYTES-BINARY redefines TWO-BYTES pic 9(4) comp.
01 IO-STATUS-4 pic 9(4) value 0.
01 IO-STATUS-4A redefines IO-STATUS-4 pic X(4).
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* UTLHEXC3 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 MESSAGE-BUFFER-SIZE pic 9(3) value 267.
01 MSG-PTR pic 9(3) value 0.
01 MSG-LEN pic 9(3) value 0.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 WORK-DATE.
05 WORK-DATE-08 pic X(8).
01 WORK-TIME pic X(8).
01 LOG-DATE pic X(10) value 'yyyy/nn/nn'.
01 LOG-TIME pic X(11) value 'nn:nn:nn:nn'.
*****************************************************************
LINKAGE SECTION.
01 UTLHEXC3-PASS-AREA.
05 UTLHEXC3-REQUEST pic X(8).
05 UTLHEXC3-RESPOND pic 9999.
05 UTLHEXC3-MESSAGE pic X(267).
*****************************************************************
PROCEDURE DIVISION using UTLHEXC3-PASS-AREA.
evaluate UTLHEXC3-REQUEST
when 'FILEONLY' perform POST-TO-LOG
when 'SHOWONLY' perform POST-TO-CONSOLE
when 'FILESHOW' perform POST-TO-LOG
perform POST-TO-CONSOLE
when 'SHOWFILE' perform POST-TO-LOG
perform POST-TO-CONSOLE
when OTHER perform POST-TO-LOG
end-evaluate
if APPL-AOK
move ZERO to UTLHEXC3-RESPOND
end-if
GOBACK.
*****************************************************************
GET-DATE-AND-TIME.
accept WORK-DATE from DATE YYYYMMDD
accept WORK-TIME from TIME
move WORK-DATE(1:4) to LOG-DATE(1:4)
move WORK-DATE(5:2) to LOG-DATE(6:2)
move WORK-DATE(7:2) to LOG-DATE(9:2)
move WORK-TIME(1:2) to LOG-TIME(1:2)
move WORK-TIME(3:2) to LOG-TIME(4:2)
move WORK-TIME(5:2) to LOG-TIME(7:2)
move WORK-TIME(7:2) to LOG-TIME(10:2)
exit.
*****************************************************************
POST-TO-CONSOLE.
move UTLHEXC3-MESSAGE to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************