オフコン練習帳

KEISコードからJIPSの変換

投稿者：江須扇投稿日時： 2004-9-25 10:27:00

こんにちは江須扇と申します。

大変失礼ですが、販売店にご相談されましたか？
昔、メーカー（ＮＥＣ）は他社オフコンのリプレース対応としてコード変換のプロ
グラムを販売店に提供していたような気もします。
また、その後、似たような有償ソフトも提供していると思います。
（ＩＢＭ、富士通だけかも日立は？？？？）
ただ、有償ソフトは販売停止になっているかもしれません。
リプレース用のプログラムもユーザーには公開はしてないかもしれません。

以前、コード変換の本も持っていたのですが、誰かに貸したままか、何処かになく
してしまいました。

ＫＥＩＳのコード体系も有った様な記憶です。
基本的にはＪＩＳコード又は区点コードに対して日本語ＯＮ、ＯＦＦコードを付け
て１バイト目と２バイト目を何らかの規則でシフトしていたのではと思います。
あくまでも記憶です。（私はアバウトＳＥ＆兜蟹ＳＥ（シーラカンスＳＥ）です。）

日立側でＪＩＳコードに変換できれば、＃ＫＦＣＮＶを利用できると思います。

下記は昔々作ったＧＯＴＯ有り有りの内部コードとＳＩＦＩＴＪＩＳの変換サブルー
チンです。

参考になればと添付しました。

---------------------------------------------------------------------------

　これは、S3100A モデルの #PCCNV で MSDOS　テキストファイルを変換したとき当
時の #PCCNV のバージョンでは 1 バイト、2 バイトの混在のフィールドは変換出来
ないので COBOL85 で作成したものです。

　方法はちょっと変ですが #PCCNV で全て 1 バイトの ANK　変換をしたファイルを
入力ファイルとし再度　1 バイトで EBCDIC から JIS8 に変換し、1 バイト系か、2
バイト系かをチェックし 2 バイト系は内部漢字コード (J) に変換します。最後に
また全て、 1 バイトとして、JIS8 から、EBCDIC に変換して、終了します。変換部
分はサブルーチンになっているので、フィールド単位の変換も可能です。

　また、NEC 内部から、SIFTJIS もサブルーチンは作ってあります。


000010 IDENTIFICATION　DIVISION.
000020*******************************************************************
000030*　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 *
000040*　　SJIS TO NEC(INTERNAL(E))　　　　　　　　　　<< SJ2NEC >>　　 *
000050*　　　　　　　　　　　　　　　　　　　　　UPDATE : 93/11/25　　　*
000060*******************************************************************
000070 PROGRAM-ID.　　　　 SJ2NEC.
000080 ENVIRONMENT　　　　 DIVISION.
000090 CONFIGURATION　　　 SECTION.
000100 SOURCE-COMPUTER.　　NEC.
000110 OBJECT-COMPUTER.　　NEC.
000120 INPUT-OUTPUT　　　　SECTION.
000130 FILE-CONTROL.
000140　　 SELECT　CIFNEC　ASSIGN　TO　　　CIFNEC-MSD.
000150　　 SELECT　CIFSJIS ASSIGN　TO　　　CIFSJIS-MSD.
000160*
000170 DATA　　DIVISION.
000180 FILE　　SECTION.
000190*
000200 FD　CIFNEC　　　LABEL　RECORD　　 IS　 STANDARD
000210　　　　　　　　 BLOCK　CONTAINS　 16　 RECORDS
000220　　　　　　　　 VALUE　OF　IDENTIFICATION　　　"CIFNEC".
000230 01　CIFNEC-REC　　 PIC　　X(80).
000240*
000250 FD　CIFSJIS　　 LABEL　RECORD　　 IS　 STANDARD
000260　　　　　　　　 BLOCK　CONTAINS　 16　 RECORDS
000270　　　　　　　　 VALUE　OF　IDENTIFICATION　　　"CIFSJIS".
000280 01　CIFSJIS-REC　　 PIC　　X(80).
000290*
000300*
000310**************************************************************
000320 WORKING-STORAGE SECTION.
000330**************************************************************
000340 01　WORK-AREA.
000350　　 03　END-FLG　　 PIC X(03)　VALUE SPACE.
000360 01　KASAN　　　　　 PIC 9(5).
000370 01　KASAN2　　　　　PIC 9(5).
000380 01　EVEN　　　　　　PIC 9(5).
000390 01　DAI　　　　　　 PIC 9(5).
000400 01　CNV-AREA.
000410　　 03　C1　　　　　PIC X(1) OCCURS 256 INDEXED BY C1-IDX.
000420 01　CHKK-AREA.
000430　　 03　FILLER　　　PIC X(1) VALUE LOW-VALUE.
000440　　 03　CHKK　　　　PIC X(1).
000450 01　CHKK2-AREA REDEFINES CHKK-AREA.
000460　　 03　CHKK2　　　 USAGE COMP-1.
000470 01　CHKT-AREA.
000480　　 03　FILLER　　　PIC X(1) VALUE LOW-VALUE.
000490　　 03　CHKT　　　　PIC X(1).
000500 01　CHKT2-AREA REDEFINES CHKT-AREA.
000510　　 03　CHKT2　　　 USAGE COMP-1.
000520 01　CNV-NUMB　　　　PIC 9(4).
000530 01　EJ-TBL.
000540　　 03 FILLER PIC X(16)
000550　　　　　　　　　 VALUE ""000102039C09867F978D8E0B0C0D0E0F"".
000560　　 03 FILLER PIC X(16)
000570　　　　　　　　　 VALUE ""101112139D0A08871819928F1C1D1E1F"".
000580　　 03 FILLER PIC X(16)
000590　　　　　　　　　 VALUE ""808182838485171B88898A8B8C050607"".
000600　　 03 FILLER PIC X(16)
000610　　　　　　　　　 VALUE ""909116939495960498999A9B14159E1A"".
000620　　 03 FILLER PIC X(16)
000630　　　　　　　　　 VALUE ""20A1A2A3A4A5A6A7A8A95B2E3C282B21"".
000640　　 03 FILLER PIC X(16)
000650　　　　　　　　　 VALUE ""26AAABACADAEAF61B0625D5C2A293B5E"".
000660　　 03 FILLER PIC X(16)
000670　　　　　　　　　 VALUE ""2D2F636465666768696A7C2C255F3E3F"".
000680　　 03 FILLER PIC X(16)
000690　　　　　　　　　 VALUE ""6B6C6D6E6F70717273603A2340273D22"".
000700　　 03 FILLER PIC X(16)
000710　　　　　　　　　 VALUE ""74B1B2B3B4B5B6B7B8B9BA75BBBCBDBE"".
000720　　 03 FILLER PIC X(16)
000730　　　　　　　　　 VALUE ""BFC0C1C2C3C4C5C6C7C8C97677CACBCC"".
000740　　 03 FILLER PIC X(16)
000750　　　　　　　　　 VALUE ""787ECDCECFD0D1D2D3D4D579D6D7D8D9"".
000760　　 03 FILLER PIC X(16)
000770　　　　　　　　　 VALUE ""7AA0E0E1E2E3E4E5E6E7DADBDCDDDEDF"".
000780　　 03 FILLER PIC X(16)
000790　　　　　　　　　 VALUE ""7B414243444546474849E8E9EAEBECED"".
000800　　 03 FILLER PIC X(16)
000810　　　　　　　　　 VALUE ""7D4A4B4C4D4E4F505152EEEFF0F1F2F3"".
000820　　 03 FILLER PIC X(16)
000830　　　　　　　　　 VALUE ""249F535455565758595AF4F5F6F7F8F9"".
000840　　 03 FILLER PIC X(16)
000850　　　　　　　　　 VALUE ""30313233343536373839FAFBFCFDFEFF"".
000860 01　JE-TBL.
000870　　 03 FILLER PIC X(16)
000880　　　　　　　　　 VALUE ""00010203372D2E2F1605150B0C0D0E0F"".
000890　　 03 FILLER PIC X(16)
000900　　　　　　　　　 VALUE ""101112133C3D322618193F271C1D1E1F"".
000910　　 03 FILLER PIC X(16)
000920　　　　　　　　　 VALUE ""404F7F7BE06C507D4D5D5C4E6B604B61"".
000930　　 03 FILLER PIC X(16)
000940　　　　　　　　　 VALUE ""F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F"".
000950　　 03 FILLER PIC X(16)
000960　　　　　　　　　 VALUE ""7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6"".
000970　　 03 FILLER PIC X(16)
000980　　　　　　　　　 VALUE ""D7D8D9E2E3E4E5E6E7E8E94A5B5A5F6D"".
000990　　 03 FILLER PIC X(16)
001000　　　　　　　　　 VALUE ""79575962636465666768697071727374"".
001010　　 03 FILLER PIC X(16)
001020　　　　　　　　　 VALUE ""75767778808B9B9CA0ABB0C06AD0A107"".
001030　　 03 FILLER PIC X(16)
001040　　　　　　　　　 VALUE ""202122232425061728292A2B2C090A1B"".
001050　　 03 FILLER PIC X(16)
001060　　　　　　　　　 VALUE ""30311A333435360838393A3B04143EE1"".
001070　　 03 FILLER PIC X(16)
001080　　　　　　　　　 VALUE ""B1414243444546474849515253545556"".
001090　　 03 FILLER PIC X(16)
001100　　　　　　　　　 VALUE ""588182838485868788898A8C8D8E8F90"".
001110　　 03 FILLER PIC X(16)
001120　　　　　　　　　 VALUE ""9192939495969798999A9D9E9FA2A3A4"".
001130　　 03 FILLER PIC X(16)
001140　　　　　　　　　 VALUE ""A5A6A7A8A9AAACADAEAFBABBBCBDBEBF"".
001150　　 03 FILLER PIC X(16)
001160　　　　　　　　　 VALUE ""B2B3B4B5B6B7B8B9CACBCCCDCECFDADB"".
001170　　 03 FILLER PIC X(16)
001180　　　　　　　　　 VALUE ""DCDDDEDFEAEBECEDEEEFFAFBFCFDFEFF"".
001190**************************************************************
001200 PROCEDURE　 DIVISION.
001210**************************************************************
001220 HAJIME.
001230　　 PERFORM　　INIT-RTN　　 THRU　　 INIT-EXT.
001240　　 PERFORM　　MAIN-RTN　　 THRU　　 MAIN-EXT
001250　　　　　　　　UNTIL　　　　END-FLG　=　　"END".
001260　　 PERFORM　　END-RTN　　　THRU　　 END-EXT.
001270**************************************************************
001280*　　初期処理
001290**************************************************************
001300 INIT-RTN.
001310　　 OPEN　　INPUT　 CIFSJIS.
001320　　 OPEN　　OUTPUT　CIFNEC.
001330　　 INITIALIZE　　　WORK-AREA.
001340 INIT-EXT.
001350　　 EXIT.
001360**************************************************************
001370*　　主　処理
001380**************************************************************
001390 MAIN-RTN.
001400　　 READ CIFSJIS AT END MOVE "END" TO END-FLG
001410　　　　　　　　　　　　 GO TO MAIN-EXT.
001420　　 MOVE 80 TO CNV-NUMB.
001430　　 MOVE CIFSJIS-REC TO CNV-AREA.
001440　　 PERFORM JE-RTN THRU JE-EXT.
001450　　 MOVE CNV-AREA TO CIFNEC-REC.
001460　　 WRITE CIFNEC-REC.
001470 MAIN-EXT.
001480　　 EXIT.
001490**************************************************************
001500*　　終了処理
001510**************************************************************
001520 END-RTN.
001530　　 CLOSE　　　　　 CIFNEC　CIFSJIS.
001540　　 STOP RUN.
001550 END-EXT.
001560　　 EXIT.
001570**************************************************************
001580*　　NEC-INTERNAL(E) TO SIFT-JIS
001590**************************************************************
001600 EJ-RTN.
001610　　 CALL "CBLCODE" USING CNV-AREA CNV-NUMB EJ-TBL.
001620　　 SET C1-IDX TO 1.
001630 EJ1-RTN.
001640　　 MOVE ZERO　TO CHKK2
001650　　　　　　　　　 CHKT2
001660　　　　　　　　　 KASAN
001670　　　　　　　　　 KASAN2
001680　　　　　　　　　 EVEN
001690　　　　　　　　　 DAI.
001700　　 MOVE C1(C1-IDX)　　 TO CHKK.
001710　　 IF　　　　　 CHKK2 <　96 GO　　　 TO EJ3-RTN
001720　　　ELSE IF　　 CHKK2 < 125 MOVE　81 TO KASAN
001730　　　 ELSE IF　　CHKK2 > 223 MOVE 112 TO KASAN
001740　　　　ELSE IF　 CHKK2 > 159 GO　　　 TO EJ3-RTN
001750　　　　 ELSE IF　CHKK2 > 127 MOVE　80 TO KASAN
001760　　　　　ELSE IF CHKK2 = 126 MOVE 143 TO CHKK2
001770　　　　　　　　　　　　　　　MOVE　 1 TO EVEN
001780　　　　　　　　　　　　　　　GO　　　 TO EJ2-RTN
001790　　　　　 ELSE　　　　　　　 GO　　　 TO EJ3-RTN.
001800　　 DIVIDE 2 INTO CHKK2 GIVING CHKK2 REMAINDER EVEN.
001810　　 COMPUTE CHKK2 = CHKK2 + KASAN.
001820 EJ2-RTN.
001830　　 MOVE C1(C1-IDX + 1) TO CHKT.
001840　　 IF CHKT2 > 95 MOVE 1 TO DAI
001850　　　　　　　ELSE MOVE 0 TO DAI.
001860　　 COMPUTE CHKT2 = CHKT2 + 31 + DAI - DAI * EVEN + 95 * EVEN.
001870　　 MOVE CHKK TO C1(C1-IDX).
001880　　 MOVE CHKT TO C1(C1-IDX + 1).
001890　　 SET C1-IDX UP BY 2.
001900　　 IF C1-IDX < CNV-NUMB GO TO EJ1-RTN.
001910　　 GO TO EJ4-RTN.
001920 EJ3-RTN.
001930　　 SET C1-IDX UP BY 1.
001940　　 IF C1-IDX < CNV-NUMB GO TO EJ1-RTN.
001950 EJ4-RTN.
001960　　 CALL "CBLCODE" USING CNV-AREA CNV-NUMB JE-TBL.
001970 EJ-EXT.
001980　　 EXIT.
001990**************************************************************
002000*　　SIFT-JIS TO NEC-INTERNAL(E)
002010**************************************************************
002020 JE-RTN.
002030　　 CALL "CBLCODE" USING CNV-AREA CNV-NUMB EJ-TBL.
002040　　 SET C1-IDX TO 1.
002050 JE1-RTN.
002060　　 MOVE ZERO　TO CHKK2
002070　　　　　　　　　 CHKT2
002080　　　　　　　　　 KASAN
002090　　　　　　　　　 KASAN2
002100　　　　　　　　　 EVEN
002110　　　　　　　　　 DAI.
002120　　 MOVE C1(C1-IDX)　　 TO CHKK.
002130　　 IF　　　　　　 CHKK2 <　96 GO　　　 TO JE4-RTN
002140　　　ELSE IF　　　 CHKK2 < 127 GO　　　 TO JE3-RTN
002150　　　 ELSE IF　　　CHKK2 < 129 GO　　　 TO JE4-RTN
002160　　　　 ELSE IF　　CHKK2 > 239 GO　　　 TO JE4-RTN
002170　　　　　ELSE IF　 CHKK2 > 223 MOVE 112 TO KASAN
002180　　　　　 ELSE IF　CHKK2 > 159 GO　　　 TO JE4-RTN
002190　　　　　　ELSE IF CHKK2 > 143 MOVE　80 TO KASAN
002200　　　　　　 ELSE　　　　　　　 MOVE　81 TO KASAN
002210　　　　　　　　 IF CHKK2 = 143 MOVE　 1 TO DAI.
002220　　 MOVE C1(C1-IDX + 1) TO CHKT.
002230　　 IF　　　 CHKT2 < 127 MOVE　31 TO KASAN2
002240　　　　　　　　　　　　　MOVE　 0 TO EVEN
002250　　　ELSE IF CHKT2 < 159 MOVE　32 TO KASAN2
002260　　　　　　　　　　　　　MOVE　 0 TO EVEN
002270　　　 ELSE　　　　　　　 MOVE 126 TO KASAN2
002280　　　　　　　　　　　　　MOVE　 1 TO EVEN.
002290 JE2-RTN.
002300　　 COMPUTE CHKK2 = (CHKK2 - KASAN) * 2 + EVEN + EVEN * DAI.
002310　　 COMPUTE CHKT2 = CHKT2 - KASAN2.
002320　　 MOVE CHKK TO C1(C1-IDX).
002330　　 MOVE CHKT TO C1(C1-IDX + 1).
002340　　 SET C1-IDX UP BY 2.
002350　　 IF C1-IDX < CNV-NUMB GO TO JE1-RTN.
002360　　 GO TO JE5-RTN.
002370 JE3-RTN.
002380　　 COMPUTE CHKK2 = CHKK2 - 32.
002390　　 MOVE CHKK TO C1(C1-IDX).
002400 JE4-RTN.
002410　　 SET C1-IDX UP BY 1.
002420　　 IF C1-IDX < CNV-NUMB GO TO JE1-RTN.
002430 JE5-RTN.
002440　　 CALL "CBLCODE" USING CNV-AREA CNV-NUMB JE-TBL.
002450 JE-EXT.
002460　　 EXIT.

---------------------------------------------------------------------------

注）掲示板対応でスペースを２バイトスペースに変更しております。
　　このリストをそのまま利用する場合は２バイトスペースを１バイトスペース２文
　　字に戻してしてください。

名前※
題名
メッセージ	サンプル [もっと...]
パスワード※
オプション	※印の項目をクッキーに保存