![]() |
Parse a Data String SimoPARS - The COBOL Source Code http://www.simotime.com |
| When technology complements business | Copyright © 1987-2010 SimoTime Enterprises All Rights Reserved |
|
This document provides a listing of the COBOL source code for viewing. Additional information about this program may be obtained by sending an e-mail to: helpdesk@simotime.com
The following is the COBOL Source Code.
IDENTIFICATION DIVISION.
PROGRAM-ID. SIMOPARS.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2010 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: SIMOPARS.CBL
* Copy Files PASSPARS.CPY
*****************************************************************
*
* SIMOPARS - Parse Buffer defined in pass area.
*
* CALLING PROTOCOL
* ----------------
* call 'SIMOPARS' using PRS-PARAMETERS
*
* 01 PRS-PARAMETERS.
* 05 PRS-REQUEST PIC X VALUE '0'.
* 05 PRS-STATUS PIC 9(4).
* 05 PRS-DELIMITER PIC X VALUE SPACE.
* 05 PRS-KEEP-NULL-FIELDS PIC X VALUE 'N'.
* 05 PRS-SUSPEND PIC X VALUE 'N'.
* 05 PRS-SUSPEND-BYTE PIC X VALUE SPACE.
* 05 PRS-TERMINATOR PIC X VALUE 'N'.
* 05 PRS-TERMINATOR-BYTE PIC X VALUE SPACE.
* 05 PRS-BUFFER-SIZE PIC 9(4) VALUE 2048.
* 05 PRS-BUFFER PIC X(2048).
* 05 PRS-TABLE-MAX PIC 9(4) VALUE 128.
* 05 PRS-NUMBER-OF-ITEMS PIC 9(4) VALUE 0.
* 05 PRS-LAST-SIG-BYTE PIC 9(4) VALUE 0.
* 05 PRS-POSITION OCCURS 128 TIMES
* PIC 9(4) VALUE 0.
* 05 PRS-SIZE OCCURS 128 TIMES
*
* This routine uses reference modification to identify the
* position of the first significant character after the
* delimiter character. This approach compensates for multiple
* leading or embedded delimiter characters. The string function
* of COBOL does not handle leading spaces.
*
* For example, if the delimiter character is a space then
* leading spaces will be ignored and multiple, embedded spaces
* will be treated as a single space.
*
* MAINTENANCE
* -----------
* 1998/01/02 Simmons, CREATED PROGRAM.
* 1998/01/02 Simmons, No changes to date...
*
*****************************************************************
*
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*****************************************************************
* Data-structure for Program use... *
*****************************************************************
01 I-PTR pic 9(4) value 0.
01 O-PTR pic 9(4) value 0.
01 B-COUNT pic 9(4) value 0.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* SIMOPARS '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
*****************************************************************
LINKAGE SECTION.
COPY PASSPARS.
*****************************************************************
PROCEDURE DIVISION using PRS-PARAMETERS.
if PRS-REQUEST not = '2'
perform EDIT-LINKAGE-ITEMS
end-if
add 8 to ZERO giving RETURN-CODE
add 9 to ZERO giving PRS-STATUS
move ZERO to PRS-NUMBER-OF-ITEMS
evaluate PRS-REQUEST
when '0' perform PARSE-BUFFER
when '1' perform INITIALIZE-TABLE-ELEMENTS
when '2' perform INITIALIZE-DEFAULT-VALUES
when OTHER add 12 to ZERO giving PRS-STATUS
end-evaluate
if PRS-STATUS = 9
subtract PRS-STATUS from PRS-STATUS
end-if
GOBACK.
*****************************************************************
EDIT-LINKAGE-ITEMS.
if PRS-TABLE-MAX not numeric
add 128 to ZERO giving PRS-TABLE-MAX
move 'PRS-TABLE-MAX set to 128' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if PRS-TABLE-MAX > 128
add 128 to ZERO giving PRS-TABLE-MAX
move 'PRS-TABLE-MAX set to 128' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if PRS-BUFFER-SIZE not numeric
add 2048 to ZERO giving PRS-BUFFER-SIZE
move 'PRS-BUFFER-SIZE set to 2048' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if PRS-BUFFER-SIZE > 2048
add 2048 to ZERO giving PRS-BUFFER-SIZE
move 'PRS-BUFFER-SIZE set to 2048' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
INITIALIZE-DEFAULT-VALUES.
move ',' to PRS-DELIMITER
move 'Y' to PRS-SPACE-TRUNCATION
move 'Y' to PRS-KEEP-NULL-FIELDS
add 128 to ZERO giving PRS-TABLE-MAX
add 2048 to ZERO giving PRS-BUFFER-SIZE
perform INITIALIZE-TABLE-ELEMENTS
move '0' to PRS-REQUEST
move ZERO to PRS-STATUS
move ZERO to PRS-NUMBER-OF-ITEMS
move ZERO to PRS-LAST-SIG-BYTE
exit.
*****************************************************************
INITIALIZE-TABLE-ELEMENTS.
move 1 to I-PTR
move 1 to O-PTR
perform until O-PTR > PRS-TABLE-MAX
move 0 to PRS-POSITION(O-PTR)
move 0 to PRS-SIZE(O-PTR)
add 1 to O-PTR
end-perform
subtract RETURN-CODE from RETURN-CODE
exit.
*****************************************************************
PARSE-BUFFER.
*! Initialize Offset/Length tables to zero (0).
perform INITIALIZE-TABLE-ELEMENTS
move ZERO to PRS-LAST-SIG-BYTE
*! Parse the Buffer.
add 1 to ZERO giving O-PTR
perform until I-PTR > PRS-BUFFER-SIZE
perform PARSE-BUFFER-10
end-perform
* Wrap-up the parse of this buffer...
if PRS-LAST-SIG-BYTE > 0
and PRS-BUFFER(PRS-LAST-SIG-BYTE:1) not = PRS-DELIMITER
add 1 to PRS-NUMBER-OF-ITEMS
end-if
if PRS-POSITION(O-PTR) = 0
subtract 1 from O-PTR
end-if
subtract RETURN-CODE from RETURN-CODE
exit.
*---------------------------------------------------------------*
PARSE-BUFFER-10.
if PRS-BUFFER(I-PTR:1) not = SPACE
add I-PTR to ZERO giving PRS-LAST-SIG-BYTE
end-if
if PRS-BUFFER(I-PTR:1) = PRS-DELIMITER
add 1 to B-COUNT
if PRS-KEEP-NULL-FIELDS = 'Y'
or B-COUNT = 1
and PRS-SIZE(O-PTR) > 0
if O-PTR < PRS-TABLE-MAX
add 1 to O-PTR
add 1 to PRS-NUMBER-OF-ITEMS
else
move PRS-BUFFER-SIZE to I-PTR
end-if
end-if
else
subtract B-COUNT from B-COUNT
add 1 to PRS-SIZE(O-PTR)
if PRS-SIZE(O-PTR) = 1
move I-PTR to PRS-POSITION(O-PTR)
end-if
end-if
add 1 to I-PTR
if PRS-TERMINATOR = 'Y'
and I-PTR not > PRS-BUFFER-SIZE
and PRS-BUFFER(I-PTR:1) = PRS-TERMINATOR-BYTE
if PRS-SIZE(O-PTR) > 0
add 1 to PRS-NUMBER-OF-ITEMS
end-if
add PRS-BUFFER-SIZE to 1 giving I-PTR
end-if
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79)
else
display MESSAGE-BUFFER
end-if
move all SPACES to 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 purpose of this document is to provide a COBOL Source member for viewing.
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, modify and distribute this software for a 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.
You may view the complete list of SimoTime callable Modules or Driver Programs at http://www.simotime.com/simomods.htm.
The SimoZAPS Utility Program has the capability of generating a COBOL program that will do the conversion of sequential and VSAM (KSDS) files between EBCDIC and ASCII. SimoZAPScan also read a sequential file in EBCDIC format and create an ASCII/CRLF file or VSAM KSDS file in ASCII format. The conversion tables may be viewed or modified to meet unique requirements. The Hexcess/2 function provides the capability of viewing, finding or patching the contents of a file in hexadecimal.
This item will provide a link to an ASCII or EBCDIC translation table. A column for decimal, hexadecimal and binary is also included.
This document provides a quick summary of the File Status Key for VSAM data sets and QSAM files.
Check out The SimoTime Library for a wide range of topics for Programmers, Project Managers and Software Developers.
To review all the information available on this site start at The SimoTime Home Page .
Check out The SimoTime Glossary for a list of terms and definitions used in the documents provided by SimoTime.
If you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com
We appreciate your comments and feedback.
Founded in 1987, SimoTime Enterprises is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. This includes the smallest thin client using the Internet and the very large mainframe systems. There is more to making the Internet work for your company's business than just having a nice looking WEB site. It is about combining the latest technologies and existing technologies with practical business experience. It's about the business of doing business and looking good in the process. Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com
| Return-to-Top |
| Copyright © 1987-2010 SimoTime Enterprises All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |