Just FYI,
PRINT fxrfile > vlrfile
also converts a fixed-length record file to variable length, with trailing
spaces deleted.
Regards,
Tad.
----- Original Message -----
From: ed <[log in to unmask]>
To: <[log in to unmask]>
Sent: 22 September 2000 00:23
Subject: Re: [HP3000-L] FTP HP3000 to NT
> Here is some cobol codes which deletes trailing blanks.
>
>
> 1 $control uslinit,nolist,optimize=1
> 1.1 identification division.
> 1.2 program-id. c010.
> 1.3 *
> 1.4 * copies fix record length file to variable record length
> 1.5 * file deleting trailing blanks.
> 1.6 *
> 1.7 * input file: "FIXED" temporary binary (powerhouse subfile)
> 1.8 * record length 124 bytes.
> 1.9 * output file: "VARIABLE" permanent binary variable record
length
> 2 * created by program.
> 2.1 *
> 2.2 * to use:
> 2.3 *
> 2.4 * :file fixed=xxxx
> 2.5 * :purge yyyy
> 2.6 * :file variable=yyyy
> 2.7 * :run c010.pub
> 2.8 *
> 2.9 * to compile and link:
> 3.11 * :cob85xlk c010.source,c010.pub
> 3.12 *
> 3.13 * or inside of qedit
> 3.14 * cob85xlk *,c010.pub
> 3.2 *
> 3.3 author. ed culp.
> 3.4 installation. forsythe/mcarthur.
> 3.5 date-written. wed, apr 28, 1991.
> 3.6 date-compiled.
> 3.7 environment division.
> 3.8 configuration section.
> 3.9 special-names.
> 4 condition-code is c-c.
> 4.1 data division.
> 4.2 working-storage section.
> 4.3 01 text-line.
> 4.4 05 word-in occurs 31 times.
> 4.5 07 filler pic xxxx value space.
> 4.6 01 in-fnum pic s9(4) comp.
> 4.7 01 out-fnum pic s9(4) comp.
> 4.8 01 fnum pic s9(4) comp.
> 4.9 01 i pic s9(9) binary sync.
> 5 01 input-name pic x(10) value "FIXED;".
> 5.1 01 output-name pic x(10) value "VARIABLE;".
> 5.2 01 lgth pic s9(4) comp.
> 5.3 01 kount pic s9(4) comp.
> 5.4
> 5.5 procedure division.
> 5.6 000-main.
> 5.7 * %2 old temporary binary
> 5.8 call intrinsic "FOPEN" using input-name, %2
> 5.9 giving in-fnum
> 6 if c-c not = 0 display "FOPEN INPUT"
> 6.1 move in-fnum to fnum perform 100-file-error.
> 6.2 *** display "IN-FNUM " in-fnum
> 6.3 * %100 new binary variable
> 6.31 * %104 new ascii variable
> 6.4 * %1 write
> 6.41 * 62 record length in 2-byte words
> 6.5 call intrinsic "FOPEN" using output-name, %104, %1, 62
> 6.6 giving out-fnum
> 6.7 if c-c not = 0 display "FOPEN OUTPUT"
> 6.8 move out-fnum to fnum perform 100-file-error.
> 6.9 *** display "OUT-FNUM " out-fnum
> 7 *** move 0 to kount.
> 7.1 **************************************************************
> 7.2 100-loop.
> 7.3 call intrinsic "FREAD" using in-fnum, text-line, -124
> 7.4 giving lgth
> 7.5 *read error
> 7.6 if c-c < 0 display "FREAD" perform 100-file-error end-if
> 7.7 *end of file
> 7.8 if c-c > 0 go to 100-close end-if
> 7.9 *** display "LGTH " lgth
> 8 *** display text-line
> 8.1 *** add 1 to kount
> 8.15 perform varying i from 31 by -1
> 8.2 until i = 1 or word-in (i) not = spaces
> 8.25 continue
> 8.3 *** display "PERFORM " i word-in (i)
> 8.35 end-perform
> 8.4 if word-in (i) (2:3) = spaces
> 8.5 compute i = - ( 1 + 4 * ( i - 1 ) )
> 8.51 else
> 8.55 if word-in (i) (3:2) = spaces
> 8.6 compute i = 1 + 2 * ( i - 1 )
> 8.61 else
> 8.65 if word-in (i) (4:1) = space
> 8.7 compute i = - ( 3 + 4 * ( i - 1 ) )
> 8.75 else
> 8.8 compute i = 2 * i.
> 8.85
> 8.9 *** display "BEFORE FWRITE " i word-in (i)
> 8.95 *** display "OUT-FNUM " out-fnum
> 9 call intrinsic "FWRITE" using out-fnum, text-line, i, %0
> 9.05 if c-c not = 0 display "FWRITE"
> 9.1 move out-fnum to fnum perform 100-file-error end-if
> 9.15 go to 100-loop.
> 9.2 **************************************************************
> 9.7 100-close.
> 9.8 ***display "RECORDS COPIED: " kount
> 9.9 *%0 no change (remain temporary)
> 10 *** display "IN-FNUM " in-fnum
> 10.1 call intrinsic "FCLOSE" using in-fnum, %0, %0
> 10.2 if c-c not = 0 display "FCLOSE INPUT"
> 10.3 move in-fnum to fnum perform 100-file-error end-if
> 10.4 *%1 permanent
> 10.5 *** display "OUT-FNUM " out-fnum
> 10.6 call intrinsic "FCLOSE" using out-fnum, %1, %0
> 10.7 if c-c not = 0 display "FCLOSE OUTPUT"
> 10.8 move out-fnum to fnum perform 100-file-error end-if
> 10.9 stop run.
> 11 **************************************************************
> 11.1 100-file-error.
> 11.2 call intrinsic "PRINTFILEINFO" using fnum
> 11.3 stop run.
> /
>
|
