000100$$ SET LINEINFO BINDINFO 000200$$ FEDLEVEL=5 001000 001100 IDENTIFICATION DIVISION. 001200 PROGRAM-ID. UNITE-C74-STREAMCOPY. 001300 AUTHOR. P.KIMPEL. 001400 INSTALLATION. PARADIGM CORPORATION, SAN DIEGO CA 92126. 001500 DATE-WRITTEN. OCTOBER 2001. 001600 DATE-COMPILED. 002000 002100****************************************************************** 002110* * 002120* UNITE/STREAMFILES/COBOL74/STREAMCOPY * 002130* * 002140****************************************************************** 002150* * 002160* Copyright (C) 2001: * 002170* Paradigm Corporation * 002180* 9625 Black Mountain Road, Suite 218 * 002190* San Diego, CA 92126-4598 * 002200* 858-536-5533; fax 858-536-5545 * 002210* http://www.digm.com * 002220* * 002230* This material may be copied and used for any purpose * 002240* providing this copyright notice is preserved and that * 002250* appropriate credit is given. * 002260* * 002270* This material is offered AS-IS WITH NO WARRANTY. * 002280* Paradigm hereby disclaims all warranties respecting this * 002290* material, expressed or implied, including without limita- * 002300* tion warranty of design, merchantability, fitness for a * 002310* particular purpose and against infringement. * 005000* * 005100****************************************************************** 005200* 005300* STREAMCOPY SIMPLY COPIES A TRADITIONAL MCP FILE TO A BYTE 005400* STREAM FILE. THE PROGRAM READS EACH LINE OF THE TRADITIONAL 005500* FILE, TRIMS ANY TRAILING BLANKS AND EBCDIC CONTROL 005600* CHARACTERS, AND WRITES THE RESULTING TEXT TO THE BYTE STREAM 005700* FILE WITH A CARRIAGE-RETURN/LINE-FEED DELIMITER PAIR. 005800* 005900* TO USE, RUN THE PROGRAM WITH THE FOLLOWING FILE EQUATIONS: 006000* 006100* MFF-MCP-FILE THE INPUT TRADITIONAL FILE 006200* 006300* BSF-BYTE-STREAM THE OUTPUT BYTE STREAM FILE. 007800* 007900* THIS PROGRAM IS CURRENTLY CAPABLE OF PROCESSING FILES WITH 008000* LOGICAL LINES UP TO 3000 CHARACTERS IN LENGTH. IT MAY BE 008100* COMPILED WITH EITHER COBOL-74 OR COBOL-85. 010000* 010100* THIS PROGRAM MAY BE USED WITH THE MCP FILE REDIRECTOR TO 010200* DIRECTLY STORE FILES ON MICROSOFT NETWORKING SHARES. 010300* TO ACCESS THE SHARE, SET (OR FILE EQUATE) THE FOLLOWING 010400* ADDITIONAL ATTRIBUTES: 010500* 010600* REDIRECTION = TRUE, 010700* IOHSTRING= "CREDENTIALS=username/password", 010800* LTITLE = *UNC/server/share/pathname. 010900* 011000* WHERE server IS THE NAME OF THE REMOTE SERVER, share IS 011100* THE NAME OF THE DIRECTORY SHARE ON THAT SERVER, username 011200* IS AN ACCOUNT ON THE REMOTE SERVER WITH WRITE ACCESS TO 011300* THE SHARE AND UNDERLYING DIRECTORY, password IS THE 011400* PASSWORD FOR THAT ACCOUNT, AND pathname IS THE PATH 011500* UNDER WHICH THE FILE WILL BE STORED. THE PATH MAY HAVE 011600* MULTIPLE NODES, SEPARATED BY -FORWARD- SLASHES. IF ANY 011700* OF THE NODES HAVE SPECIAL CHARACTERS IN THEM, THE 011800* INDIVIDUAL NODES MUST BE ENCLOSED IN QUOTES, E.G., 011900* 012000* LTITLE=*UNC/NTSERV/MYSHARE/INPUTFOLDER/"message.txt" 012100* 012200* SEE THE I/O SUBSYSTEM GUIDE FOR MORE INFORMATION ON THE 012300* REDIRECTOR, THE IOHSTRING ATTRIBUTE, AND HOW TO SPECIFY 012400* REMOTE SERVER, SHARE, AND PATH NAMES. 050000* 050010****************************************************************** 050020* MODIFICATION LOG. 050030* ----------------- 050040* 2001-10-26 P.KIMPEL 050050* ORIGINAL VERSION, CLONED FROM COBOL74/STREAMLIST. 099900****************************************************************** 100000/ 100100 ENVIRONMENT DIVISION. 100200****************************************************************** 100300 CONFIGURATION SECTION. 100400****************************************************************** 100500 SOURCE-COMPUTER. 100550 UNISYS-MCP-AS. 100600 OBJECT-COMPUTER. 100700 UNISYS-MCP-AS. 110000 110100****************************************************************** 110200 INPUT-OUTPUT SECTION. 110300****************************************************************** 110400 FILE-CONTROL. 110500 SELECT BSF-BYTE-STREAM 110600 ASSIGN TO DISK 110700 ORGANIZATION SEQUENTIAL 110800 ACCESS MODE SEQUENTIAL 110900 FILE STATUS WBS-FILE-STATUS. 111700 SELECT MFF-MCP-FILE 111800 ASSIGN TO DISK 111900 ORGANIZATION SEQUENTIAL 112000 ACCESS MODE SEQUENTIAL 112100 FILE STATUS WMF-FILE-STATUS. 150000 150100 DATA DIVISION. 150200****************************************************************** 150300 FILE SECTION. 150400****************************************************************** 160000 160100 FD BSF-BYTE-STREAM 160200 RECORD CONTAINS 0 TO 4096 CHARACTERS 160300 DEPENDING ON WBS-REC-SIZE 160400 VALUE OF FILESTRUCTURE STREAM 160500 VALUE OF BLOCKSTRUCTURE FIXED 160600 VALUE OF MAXRECSIZE 1 160700 VALUE OF FRAMESIZE 8 160800 VALUE OF EXTMODE ASCII 160900 VALUE OF INTMODE EBCDIC 161000 VALUE OF ANYSIZEIO TRUE 161100 VALUE OF AREAS 10 161200 VALUE OF FLEXIBLE TRUE 162000 LABEL RECORDS STANDARD. 162100 01 BSF-REC. 162200 05 BSF-C PIC X(1) 162300 OCCURS 4096 INDEXED BSF-CX. 170000 170100 FD MFF-MCP-FILE 170200 RECORD CONTAINS 0 TO 3000 CHARACTERS 170300 DEPENDING ON WMF-REC-SIZE 170400 VALUE OF DEPENDENTSPECS TRUE 170500 VALUE OF INTMODE EBCDIC 170520 VALUE OF SIZEVISIBLE FALSE 172000 LABEL RECORDS STANDARD. 172100 01 MFF-REC. 172200 05 MFF-C PIC X(1) 172300 OCCURS 3000 INDEXED MFF-CX. 300000 300100****************************************************************** 300200 WORKING-STORAGE SECTION. 300300****************************************************************** 300400 77 W-COPYRIGHT PIC X(60) VALUE 300500 "[Copyright (C) 2001, Paradigm Corporation]". 300600 77 W-TRUE PIC 9(1) VALUE 1 BINARY. 300700 77 W-FALSE PIC 9(1) VALUE ZERO BINARY. 310000 310100 01 WMC-MISCELLANEOUS. 310200 05 WMC-SYS-DATE PIC 9(8). 310300 05 WMC-SYS-DATE-FIELDS REDEFINES WMC-SYS-DATE. 310400 10 WMC-SYS-YEAR PIC 9(4). 310500 10 WMC-SYS-MONTH PIC 9(2). 310600 10 WMC-SYS-DAY PIC 9(2). 310700 05 WMC-SYS-TIME PIC 9(8). 310800 05 WMC-SYS-TIME-FIELDS REDEFINES WMC-SYS-TIME. 310900 10 WMC-SYS-HOUR PIC 9(2). 311000 10 WMC-SYS-MINUTE PIC 9(2). 311100 10 WMC-SYS-SECOND PIC 99V99. 320000 320100 01 WBS-BYTE-STREAM-CTL. 320200 05 WBS-BUFFER-MAX PIC 9(4) VALUE 4096 BINARY. 321300 05 WBS-REC-SIZE PIC S9(4) BINARY. 323000 05 WBS-FILE-STATUS. 323100 10 WBS-FILE-STATUS-1 PIC X(1). 323200 10 WBS-FILE-STATUS-2 PIC X(1). 323300 05 WBS-LINE-DELIMITERS. 323400 10 WBS-FF PIC X(1) VALUE @0C@. 323500 10 WBS-CR PIC X(1) VALUE @0D@. 323600 10 WBS-LF PIC X(1) VALUE @25@. 330000 330100 01 WMF-MCP-FILE-CTL. 330200 05 WMF-MSG-MAX PIC 9(4) VALUE 3000 BINARY. 330300 05 WMF-MAXREC-SIZE PIC S9(4) BINARY. 330400 05 WMF-RECSIZE-FACTOR REAL. 330500 05 WMF-REC-SIZE PIC S9(4) BINARY. 330600 05 WMF-MSG-EOF PIC 9(1) BINARY. 330700 05 WMF-LINE-NR PIC S9(6) BINARY. 330800 05 WMF-LINE-SIZE PIC S9(4) BINARY. 330900 05 WMF-FILE-STATUS. 331000 10 WMF-FILE-STATUS-1 PIC X(1). 331100 10 WMF-FILE-STATUS-2 PIC X(1). 500000/ 500100 PROCEDURE DIVISION. 500200****************************************************************** 500300 0000-MAIN-SECTION SECTION. 500400****************************************************************** 500500 0000-MAIN-LINE. 500600* MAINLINE INITIALIZATION & DRIVER ROUTINE. 500700 501200 ACCEPT WMC-SYS-DATE FROM DATE YYYYMMDD. 501300 ACCEPT WMC-SYS-TIME FROM TIME. 502600 502700 PERFORM 1000-COPY-STREAM-FILE THRU 1000-EXIT. 505700 505800 0000-EXIT. 505900 STOP RUN. 600000 600100****************************************************************** 600200 1000-SECTION SECTION. 600300****************************************************************** 600400 1000-COPY-STREAM-FILE. 600500* DRIVER FOR FORMATTING LINES FROM A TRADITIONAL MCP FILE TO 600600* A BLANK-TRIMMED BYTE STREAM FILE WITH CR-LF DELIMITERS. 600700 600800 MOVE ZERO TO WMF-LINE-NR. 601100 MOVE W-FALSE TO WMF-MSG-EOF. 601300 OPEN INPUT MFF-MCP-FILE. 601400 COMPUTE WMF-RECSIZE-FACTOR = 601500 ATTRIBUTE FRAMESIZE OF MFF-MCP-FILE / 8. 601600 MOVE ATTRIBUTE MAXRECSIZE OF MFF-MCP-FILE TO WMF-MAXREC-SIZE. 602000 602100 OPEN OUTPUT BSF-BYTE-STREAM. 602200 602300 PERFORM 1010-FORMAT-STREAM-LINE THRU 1010-EXIT UNTIL 602400 WMF-MSG-EOF = W-TRUE. 602500 602600 CLOSE BSF-BYTE-STREAM WITH CRUNCH 602700 CLOSE MFF-MCP-FILE WITH RELEASE. 604000 604100 1000-EXIT. 604200 EXIT. 610000 610100****************************************************************** 610200 1010-FORMAT-STREAM-LINE. 610300* READS ONE RECORD FROM MFF-MCP-FILE, TRIMS ANY TRAILING 610400* BLANKS OR CONTROL CHARACTERS, APPENDS A CR-LF PAIR, AND 610500* WRITES THE TRIMMED TEXT TO BSF-BYTE-STREAM. 610600 610700 MOVE WMF-MAXREC-SIZE TO WMF-REC-SIZE. 610800 READ MFF-MCP-FILE AT END 610900 MOVE W-TRUE TO WMF-MSG-EOF 611000 GO TO 1010-EXIT. 611100 611200 ADD 1 TO WMF-LINE-NR. 611300 COMPUTE WMF-LINE-SIZE = WMF-REC-SIZE * WMF-RECSIZE-FACTOR. 611400 IF WMF-LINE-SIZE > ZERO 611500 SET MFF-CX TO WMF-LINE-SIZE 611600 ELSE 611700 SET MFF-CX TO 1. 611800 611900 1010-TRIM-LOOP. 612000 IF WMF-LINE-SIZE > ZERO 612100 IF MFF-C (MFF-CX) NOT > SPACE 612200 SUBTRACT 1 FROM WMF-LINE-SIZE 612300 SET MFF-CX DOWN BY 1 612400 GO TO 1010-TRIM-LOOP. 612500 612600 STRING MFF-REC FOR WMF-LINE-SIZE, 612700 WBS-CR, WBS-LF DELIMITED BY SIZE INTO BSF-REC. 612800 COMPUTE WBS-REC-SIZE = WMF-LINE-SIZE + 2. 612900 613000 WRITE BSF-REC. 613100 IF WBS-FILE-STATUS-1 NOT = ZERO 613200 DISPLAY "STREAMCOPY: Invalid write on BSF: ", 613220 WBS-FILE-STATUS 613300 CHANGE ATTRIBUTE STATUS OF MYSELF TO TERMINATED. 613400 613500 1010-EXIT. 613600 EXIT.