SimoVREC - The COBOL Source Code
http://www.simotime.com
|
|
Read Variable Length Records SimoVREC - 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 the callable routine SimoVREC. Additional information about this program may be obtained by sending an e-mail to: helpdesk@simotime.com
The SimoVREC routine (or callable program) will provide access to a mainframe formatted sequential file with variable length records that has been downloaded from a mainframe using the File Transfer Protocol (FTP).
The
The following is an example of how to initialize the pass area. This only needs to be done one time prior to the first call.
move 'GET ' to VREC-REQUEST
move ZERO to VREC-RESPOND
move ZERO to VREC-LENGTH
move SPACES to VREC-BUFFER
The following is an example of a call statement for the callable routine.
call 'SIMOVREC' using PASSVREC-AREA
It is not necessary to do an explicit open of the input, byte-stream file. The first call to the routine will open the file and read the first record. Subsequent calls will return a logical record in the buffer with its record length in the RTN1-LENGTH field. When a call results in an end of file condition the routine will close the file.
01 PASSVREC-AREA.
05 VREC-REQUEST pic X(8).
05 VREC-RESPOND pic 9(4).
05 VREC-LENGTH pic 9(5).
05 VREC-BUFFER pic X(32760).
The following is a list of the parameters required when using the PASSVREC-AREA to call the SimoVREC routine.
| Parameter | Description | ||||||
| VREC-REQUEST | This parameter must be provided by the calling program.
|
||||||
| VREC-RESPOND | A zero (0) value indicates a successful completion of the request. A non-zero value indicates the request could not be completed successfully. | ||||||
| VREC-LENGTH | The length of the read or GET request is posted in this parameter by SimoVREC. This is the length of the record. The logical record size may be from 4 to 32,760 bytes. | ||||||
| VREC-BUFFER | This parameter will contain the logical record for a GET request. |
The following is the copy statement used in the LINKAGE section of the SIMOVREC callable routine.
COPY PASSVREC.
The following are environment variables used by the byte-stream read routine for mainframe formatted files with variable length records.
| Variable | Description | ||||||||||
| BSIODSN1 | This is the drive:directory\filename.ext for the input file. This will map the DD name to the fully qualified PC file name. | ||||||||||
| INITREC1 | Must be "A" or "E" to initialize the record area with x"20" or x"40". If not specified the default vale is "E". | ||||||||||
| EXTFH | Points to the EXTFH.CFG file if used. Optional variable | ||||||||||
| BSIOFMT1 | Identifies the format of the input file. The following are the
options for this environment variable.
Note: for a mainframe file with variable length records each record is preceded by a four byte Record Descriptor Word (RDW) and a possible four byte Block Descriptor Word (BDW). The first two bytes of the RDW (and possible BDW) contains a binary value that is the length of the record (or possible block). The second two bytes of the RDW (and possible BDW) usually contain binary zeroes (or x'00'). The reasonability check test to insure the second two bytes are binary zeroes. By using VO or VBO this reasonability check will be bypassed. |
The following is the COBOL Source Code.
IDENTIFICATION DIVISION.
PROGRAM-ID. SIMOVREC.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Source Member: SIMOVREC.CBL
* Copy Files: PASSVREC.CPY (used in LINKAGE Section)
* PASSBSIO.CPY (used in WORKING-STORAGE Section)
* Calls to: SIMOBSIO.CBL
*****************************************************************
*
* ************
* * VRECEXE1 *
* ********cmd*
* *
* ************
* * if exist *
* ********stmt*
* *
* ************ ************
* * VRECEXC1 *-----* SQEDDV01 *
* ********cbl* ********dat*
* *
* **********
* call * *
* * *
* ************ *
* * SIMOVREC * *
* ********cbl* *
* * * End
* call * * Of
* * * File
* ************ ************ *
* * BSIODSN1 *-----* SIMOBSIO * *
* ********dat* ********cbl* *
* *
* **********
* *
* ************
* * EOJ *
* ************
*
*****************************************************************
*ENVIRONMENT DIVISION.
*****************************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* SIMOVREC '.
05 T2 pic X(34) value 'File Reader via Byte-Stream I/O '.
05 T3 pic X(10) value ' v07.10.25'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* SIMOVREC '.
05 C2 pic X(20) value 'Copyright 1987-2009 '.
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 '* SIMOVREC '.
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 '* SIMOVREC '.
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 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* SIMOVREC '.
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 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 DEBUG-LEVEL pic 9(2) value 0.
01 FIRST-TIME pic X value 'Y'.
01 FILE-TYPE pic X(3) value 'V '.
01 DW-EDIT pic X value 'Y'.
01 DW-EXPECTED pic X value LOW-VALUES.
01 INITREC1-MESSAGE.
05 FILLER pic X(12) value 'InitREC1 is '.
05 OUTPUT-ENCODING pic X value 'E'.
01 VREDBV01-LREC pic 9(9) comp value 0.
01 VREDBV01-LREC-ALPHA redefines VREDBV01-LREC.
05 VREC-LEN-1 pic X(2).
05 VREC-LEN-2 pic X(2).
01 VREDBV01-LBLK pic 9(5) comp value 0.
01 VREDBV01-LBLK-ALPHA redefines VREDBV01-LBLK.
05 VBLK-LEN-1 pic X(2).
05 VBLK-LEN-2 pic X(2).
01 VBS-LOOP pic 9(9) comp value 0.
01 VBS-LOOP-ALPHA redefines VBS-LOOP.
05 VBS-LOOP-1 pic X.
05 VBS-LOOP-2 pic X.
05 VBS-LOOP-3 pic X.
05 VBS-LOOP-4 pic X.
01 OT-X1 pic 9(7) value 0.
01 RECORD-LENGTH-DISPLAY.
05 filler pic X(15) value 'Record length: '.
05 RECORD-LENGTH-VALUE pic 9(5) value 0.
01 RECORD-MIN-DISPLAY.
05 filler pic X(15) value 'Record MIN is: '.
05 RECORD-MIN-VALUE pic 9(4) value 0.
01 RECORD-MAX-DISPLAY.
05 filler pic X(15) value 'Record MAX is: '.
05 RECORD-MAX-VALUE pic 9(4) value 0.
01 BSIOREAD-TOTAL.
05 filler pic X(18) value 'BSIOREAD count is '.
05 BSIOREAD-COUNT pic 9(7) value 0.
01 BSIOBLOK-TOTAL.
05 filler pic X(18) value 'BSIOBLOK count is '.
05 BSIOBLOK-COUNT pic 9(7) value 0.
01 VREDBV01-TOTAL.
05 filler pic X(18) value 'VREDBV01 count is '.
05 VREDBV01-COUNT pic 9(7) value 0.
*****************************************************************
* The following copy file is the pass area for calling SIMOBSIO,
* the byte stream I/O routine.
*****************************************************************
*
COPY PASSBSIO.
*****************************************************************
LINKAGE SECTION.
COPY PASSVREC.
*****************************************************************
PROCEDURE DIVISION using PASSVREC-AREA.
if FIRST-TIME = 'Y'
perform GET-STARTED
perform BSIO-OPEN
move 'N' to FIRST-TIME
move ZERO to PSIO-OFFSET
end-if
if OUTPUT-ENCODING = 'E'
move all x'40' to VREC-BUFFER
else
move all x'20' to VREC-BUFFER
end-if
evaluate VREC-REQUEST
when 'GET ' if FILE-TYPE = 'VBS'
perform BSIO-READ-VREC-MULTIPLE
else
perform BSIO-READ-VREC
end-if
when other add 16 to ZERO giving PSIO-RETURN
add 16 to ZERO giving VREC-RESPOND
end-evaluate
if PSIO-RETURN = ZERO
evaluate FILE-TYPE
when 'V ' perform ACTION-FOR-V
when 'VB ' perform ACTION-FOR-VB
when 'VBS' perform ACTION-FOR-VBS
when other add 9301 to ZERO giving VREC-RESPOND
end-evaluate
else
add PSIO-RETURN to ZERO giving VREC-RESPOND
end-if
GOBACK.
*****************************************************************
ACTION-FOR-V.
add PSIO-LENGTH to ZERO giving VREC-LENGTH
move PSIO-BUFFER(1:VREDBV01-LREC)
to VREC-BUFFER(1:VREDBV01-LREC)
add PSIO-RETURN to ZERO giving VREC-RESPOND
exit.
*****************************************************************
ACTION-FOR-VB.
add PSIO-LENGTH to ZERO giving VREC-LENGTH
move PSIO-BUFFER(1:VREDBV01-LREC)
to VREC-BUFFER(1:VREDBV01-LREC)
add PSIO-RETURN to ZERO giving VREC-RESPOND
* if FILE-TYPE = 'VB '
* move BSIOBLOK-TOTAL to MESSAGE-TEXT
* perform Z-DISPLAY-CONSOLE-MESSAGE
* end-if
exit.
*****************************************************************
ACTION-FOR-VBS.
add PSIO-RETURN to ZERO giving VREC-RESPOND
exit.
*****************************************************************
* I/O ROUTINES FOR BYTE-Stream I/O... *
*****************************************************************
BSIO-READ-VREC.
* Get the Block Descriptor Word (BDW)...
if FILE-TYPE = 'VB'
and VREDBV01-LBLK < 1
add 4 to ZERO giving PSIO-LENGTH
move 'READBSIO' to PSIO-REQUEST
call 'SIMOBSIO' using PSIO-PASS-AREA
if DW-EDIT = 'Y'
if PSIO-BUFFER(3:2) not = LOW-VALUES
move 'Invalid Block Descriptor Word'
to MESSAGE-TEXT
perform Z-ABEND-PROGRAM
end-if
end-if
move PSIO-BUFFER(1:2) to VREDBV01-LBLK-ALPHA(3:2)
subtract 4 from VREDBV01-LBLK
add 4 to PSIO-OFFSET
add 1 to BSIOBLOK-COUNT
end-if
* Get the Record Descriptor Word (RDW)...
add 4 to ZERO giving PSIO-LENGTH
move 'READBSIO' to PSIO-REQUEST
call 'SIMOBSIO' using PSIO-PASS-AREA
if PSIO-RETURN = 0
if DW-EDIT = 'Y'
if PSIO-BUFFER(3:2) not = LOW-VALUES
* For VBS this will post an error if a record
* attempts to span segments.
move 'Invalid Descriptor Word Content'
to MESSAGE-TEXT
perform Z-ABEND-PROGRAM
end-if
end-if
move PSIO-BUFFER(1:2) to VREDBV01-LREC-ALPHA(3:2)
if FILE-TYPE = 'VB'
subtract VREDBV01-LREC from VREDBV01-LBLK
end-if
subtract 4 from VREDBV01-LREC
* Read the variable-length record.
add PSIO-LENGTH to PSIO-OFFSET
add VREDBV01-LREC to ZERO giving PSIO-LENGTH
if PSIO-LENGTH > PSIO-MAX-SIZE
add PSIO-MAX-SIZE to ZERO giving VREDBV01-LREC
display 'Record read size exceeds max size '
PSIO-LENGTH ' vs ' PSIO-MAX-SIZE
' Record Number is ' BSIOREAD-COUNT
upon console
end-if
call 'SIMOBSIO' using PSIO-PASS-AREA
add 1 to BSIOREAD-COUNT
add PSIO-LENGTH to PSIO-OFFSET
end-if
exit.
*---------------------------------------------------------------*
BSIO-READ-VREC-MULTIPLE.
move x'01' to VBS-LOOP-3
move ZERO to VREC-LENGTH
add 1 to ZERO giving OT-X1
perform until VBS-LOOP-3 = LOW-VALUE
or VBS-LOOP-3 = x'02'
perform BSIO-READ-VREC-MULTIPLE-02
if PSIO-RETURN = 0
add PSIO-LENGTH to VREC-LENGTH
move PSIO-BUFFER(OT-X1:VREDBV01-LREC)
to VREC-BUFFER(OT-X1:VREDBV01-LREC)
add PSIO-LENGTH to OT-X1
end-if
end-perform
exit.
*---------------------------------------------------------------*
BSIO-READ-VREC-MULTIPLE-02.
* Get the Segment Descriptor Word (RDW)...
add 4 to ZERO giving PSIO-LENGTH
move 'READBSIO' to PSIO-REQUEST
call 'SIMOBSIO' using PSIO-PASS-AREA
if PSIO-RETURN = 0
move PSIO-BUFFER(1:4) to VBS-LOOP-ALPHA
if DW-EDIT = 'Y'
if VBS-LOOP-3 not = LOW-VALUE
and VBS-LOOP-3 not = x'01'
and VBS-LOOP-3 not = x'02'
and VBS-LOOP-3 not = x'03'
* For VBS this will post an error if a record
* attempts to span segments.
move 'Invalid Descriptor Word Content'
to MESSAGE-TEXT
perform Z-ABEND-PROGRAM
end-if
end-if
move PSIO-BUFFER(1:2) to VREDBV01-LREC-ALPHA(3:2)
subtract 4 from VREDBV01-LREC
* Read the variable-length record.
add PSIO-LENGTH to PSIO-OFFSET
add VREDBV01-LREC to ZERO giving PSIO-LENGTH
if PSIO-LENGTH > PSIO-MAX-SIZE
add PSIO-MAX-SIZE to ZERO giving VREDBV01-LREC
display 'Record read size exceeds max size '
PSIO-LENGTH ' vs ' PSIO-MAX-SIZE
' Record Number is ' BSIOREAD-COUNT
upon console
end-if
call 'SIMOBSIO' using PSIO-PASS-AREA
add 1 to BSIOREAD-COUNT
add PSIO-LENGTH to PSIO-OFFSET
else
move LOW-VALUE to VBS-LOOP-3
end-if
exit.
*---------------------------------------------------------------*
BSIO-OPEN.
move PSIO-FILENAME to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move 'OPEN ' to PSIO-REQUEST
call 'SIMOBSIO' using PSIO-PASS-AREA
if PSIO-RETURN = 0
move 'AOK, OPEN Input File for BSIO' to MESSAGE-TEXT
else
move 'NOK, OPEN Input File FAILURE ' to MESSAGE-TEXT
perform Z-ABEND-PROGRAM
end-if
perform Z-DISPLAY-CONSOLE-MESSAGE
move 'FILEINFO' to PSIO-REQUEST
call 'SIMOBSIO' using PSIO-PASS-AREA
if PSIO-RETURN = 0
move 'AOK, File Info Request for BSIO' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move PSIO-FILE-SIZE to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
else
move 'NOK, File Info Request FAILURE ' to MESSAGE-TEXT
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
BSIO-CLOSE.
move 'CLOSE ' to PSIO-REQUEST
call 'SIMOBSIO' using PSIO-PASS-AREA
exit.
*****************************************************************
* Get an environment variable. *
*****************************************************************
GET-ENVIRONMENT-VARIABLE.
move SPACES to ENV-VAR-VALUE
move ZERO to RETURN-CODE
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.
*****************************************************************
* Get started or first time logic... *
*****************************************************************
GET-STARTED.
perform Z-POST-COPYRIGHT
* Get the fully qualified File Name
move SPACES to ENV-VAR-NAME
move 'BSIODSN1' to ENV-VAR-NAME
perform GET-ENVIRONMENT-VARIABLE
if ENV-VAR-VALUE not = SPACES
move ENV-VAR-VALUE to PSIO-FILENAME
else
move 'Invalid file name for BSIO Function'
to MESSAGE-TEXT
perform Z-ABEND-PROGRAM
end-if
* Get the record initialization value
move SPACES to ENV-VAR-NAME
move 'INITREC1' to ENV-VAR-NAME
perform GET-ENVIRONMENT-VARIABLE
if ENV-VAR-VALUE not = SPACES
move ENV-VAR-VALUE to OUTPUT-ENCODING
if OUTPUT-ENCODING = 'E' or 'A'
move INITREC1-MESSAGE to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
else
move 'E' to OUTPUT-ENCODING
move 'Invalid INITREC1, not A or E, assumed EBCDIC'
to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
end-if
else
move 'E' to OUTPUT-ENCODING
move 'Invalid INITREC1, must be A or E, assumed EBCDIC'
to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
end-if
* Get a possible EXTFH value...
move SPACES to ENV-VAR-NAME
move 'EXTFH ' to ENV-VAR-NAME
perform GET-ENVIRONMENT-VARIABLE
if ENV-VAR-VALUE not = SPACES
move ENV-VAR-VALUE to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
else
move 'Info Only, EXTFH Environment variable not found.'
to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
end-if
* Get the File Format, should be V or VB
move SPACES to ENV-VAR-NAME
* move 'BSIOFMT1' to ENV-VAR-NAME
move 'BSIOFMT1' to ENV-VAR-NAME
perform GET-ENVIRONMENT-VARIABLE
inspect ENV-VAR-VALUE converting 'bov' to 'BOV'
if ENV-VAR-VALUE = 'VO '
move 'N' to DW-EDIT
move 'V ' to ENV-VAR-VALUE
end-if
if ENV-VAR-VALUE = 'VBO'
move 'N' to DW-EDIT
move 'VB ' to ENV-VAR-VALUE
end-if
if ENV-VAR-VALUE = 'V '
or ENV-VAR-VALUE = 'VB '
or ENV-VAR-VALUE = 'VBS'
move ENV-VAR-VALUE to FILE-TYPE
else
move 'V ' to FILE-TYPE
move 'File Format must be V or VB, assumed V'
to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
end-if
add 32760 to ZERO giving PSIO-MAX-SIZE
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-CONSOLE-MESSAGE
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
add 12 to ZERO giving RETURN-CODE
STOP RUN
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-CONSOLE-MESSAGE.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79) upon console
else
display MESSAGE-BUFFER upon console
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE upon console
display SIM-COPYRIGHT upon console
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 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 an example of a COBOL program that uses SimoVREC at http://www.simotime.com/vrecex01.htm.
You may view the complete list of SimoTime callable Modules or Driver Programs at http://www.simotime.com/simomods.htm.
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.
To review all the information available on this site start at The SimoTime Home Page .
This link provides information about The Training Sessions and Self-Study Courses available from SimoTime Enterprises.
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 |