＜その４＞
＜その１＞の別法
C'11110000'(８バイト) を X'F0'(1バイト)
C'00110001'(８バイト) を X'31'(1バイト)
にします。
000010*BIT形式のキャラクタ８バイトを１バイトにする。
000020 IDENTIFICATION DIVISION.
000030 PROGRAM-ID. TEST10.
000040 ENVIRONMENT DIVISION.
000050 INPUT-OUTPUT SECTION.
000060 FILE-CONTROL.
000070 SELECT IN-FILE ASSIGN TO 'TEST10.IN.DAT'.
000080 SELECT OUT-FILE ?ASSIGN TO 'TEST10.OUT.DAT'.
000090 DATA DIVISION.
000100 FILE SECTION.
000110 FD IN-FILE.
000120 01 IN-REC.
000130 05 IN-DATA.
000131 10 IN-DATA-64 PIC X(002).
000132 10 IN-DATA-16 PIC X(002).
000133 10 IN-DATA-04 PIC X(002).
000134 10 IN-DATA-01 PIC X(002).
000140 05 IN-CRLF PIC X(002).
000150*
000160 FD OUT-FILE.
000170 01 OUT-REC.
000180 05 OUT-DATA PIC X(001).
000190*
000200 WORKING-STORAGE SECTION.
000210*
000220 01 WORK-AREA.
000230 05 WORK-CHAR8.
000240 10 W-CHAR PIC X(001) OCCURS 8.
000250*
000260 05 WORK-HEX PIC 9(004) COMP.
000270*
000280 01 HEX-CHANGE-BEFORE PIC 9(004) COMP.
000290 01 HEX-CHG-AFT REDEFINES HEX-CHANGE-BEFORE.
000300 05 FILLER PIC X(001).
000310 05 HEX-CHANGE-AFTER PIC X(001).
000320*
000330 01 END-FLG PIC X(001) VALUE '0'.
000340*
000350 01 WK-CURRENT-STA PIC X(021).
000351 01 WK-CURRENT-END PIC X(021).
000352*
000353 PROCEDURE DIVISION.
000360 MAIN-CONTROL.
000370*
000380 MOVE FUNCTION CURRENT-DATE TO WK-CURRENT-STA.
000381 PERFORM INIT-RTN.
000390*
000400 PERFORM UNTIL END-FLG = "1"
000410 PERFORM MAIN-RTN
000420 END-PERFORM.
000430*
000440 PERFORM TERM-RTN.
000450*
000451 MOVE FUNCTION CURRENT-DATE TO WK-CURRENT-END.
000452*
000453 DISPLAY 'E N D=' WK-CURRENT-END UPON SYSOUT.
000454 DISPLAY 'START=' WK-CURRENT-STA UPON SYSOUT.
000455*
000460 STOP RUN.
000470*
000480******************************************************************
000490* *
000500******************************************************************
000510 INIT-RTN.
000520 OPEN INPUT IN-FILE.
000530 OPEN OUTPUT OUT-FILE.
000540*
000550 PERFORM READ-RTN.
000560*
000570******************************************************************
000580* *
000590******************************************************************
000600 MAIN-RTN.
000610*
000620 MOVE IN-DATA TO WORK-CHAR8.
000630 MOVE ZERO TO WORK-HEX.
000640*
000641*
000650 IF IN-DATA-64 = '00'
000660 ADD 0 TO WORK-HEX
000670 ELSE
000690 IF IN-DATA-64 = '01'
000691 ADD 64 TO WORK-HEX
000692 ELSE
000693 IF IN-DATA-64 = '10'
000700 ADD 128 TO WORK-HEX
000701 ELSE
000702 IF IN-DATA-64 = '11'
000703 ADD 192 TO WORK-HEX
000704 END-IF
000705 END-IF
000706 END-IF
000707 END-IF.
000710*
000711*
000712 IF IN-DATA-16 = '00'
000713 ADD 0 TO WORK-HEX
000714 ELSE
000715 IF IN-DATA-16 = '01'
000716 ADD 16 TO WORK-HEX
000717 ELSE
000718 IF IN-DATA-16 = '10'
000719 ADD 32 TO WORK-HEX
000720 ELSE
000721 IF IN-DATA-16 = '11'
000722 ADD 48 TO WORK-HEX
000723 END-IF
000724 END-IF
000725 END-IF
000726 END-IF.
000727*
000728*
000729 IF IN-DATA-04 = '00'
000730 ADD 0 TO WORK-HEX
000731 ELSE
000732 IF IN-DATA-04 = '01'
000733 ADD 4 TO WORK-HEX
000734 ELSE
000735 IF IN-DATA-04 = '10'
000736 ADD 8 TO WORK-HEX
000737 ELSE
000738 IF IN-DATA-04 = '11'
000739 ADD 12 TO WORK-HEX
000740 END-IF
000741 END-IF
000742 END-IF
000743 END-IF.
000744*
000745 IF IN-DATA-01 = '00'
000746 ADD 0 TO WORK-HEX
000747 ELSE
000748 IF IN-DATA-01 = '01'
000749 ADD 1 TO WORK-HEX
000750 ELSE
000751 IF IN-DATA-01 = '10'
000752 ADD 2 TO WORK-HEX
000753 ELSE
000754 IF IN-DATA-04 = '11'
000755 ADD 3 TO WORK-HEX
000756 END-IF
000757 END-IF
000758 END-IF
000759 END-IF.
000761*
001200*
001210 MOVE WORK-HEX TO HEX-CHANGE-BEFORE.
001220 WRITE OUT-REC FROM HEX-CHANGE-AFTER.
001230*
001240 PERFORM READ-RTN.
001250*
001260******************************************************************
001270* *
001280******************************************************************
001290 READ-RTN.
001300 READ IN-FILE AT END
001310 MOVE '1' TO END-FLG
001320 END-READ.
001330*
001340******************************************************************
001350* *
001360******************************************************************
001370 TERM-RTN.
001380 CLOSE IN-FILE
001390 OUT-FILE.
