はじめまして。Naruseと申します。

早速ですが、データのほとんどがパック形式のシーケンシャルファイルから
SQL-Serverに一括登録するプログラムを作っています。
内部十進を外部十進に変換するにあたり、いろいろな情報からデータの変換が
可能になりましたが、0x80以降のデータで正しく変換できたりできなかったり
しています。
下記の変換方法以外も試しましたが解決に至らず、投稿させていただくことに
しました。

開発はVB6.0、OSはWindowsServer2008です。
VB素人のプログラムですが、下記に抜粋します。
変換結果も書いておきます。
どうかよろしくお願いします。

Private Sub DataSet1()
    MOTO = GT.W_200
    'StrToBin (MOTO)
    MOTO = StrConv(GT.W_200, vbFromUnicode) ' システムコードに変換
    COMP3_CNV_RTN MOTO, 5
    W21_200 = Val(W_SIGN & Result)
End Sub

Private Sub COMP3_CNV_RTN(C3 As String, CNT As Integer)
    Dim W_ASC As String
    Dim W_HEX As String
    Result = ""
    W_SIGN = ""
    For X = 1 To CNT
        W_VAL = MidB(C3, X, 1)
        W_ASC = CStr(AscB(W_VAL))
        W_HEX = (Hex(AscB(W_VAL)))
        If Len(CStr(Hex(AscB(W_VAL)))) = 1 Then
            Result = Result & "0" & CStr(Hex(AscB(W_VAL)))
        Else
        Select Case CStr(Hex(AscB(W_VAL)))
            Case "0c", "0C", "0d", "0D", "c", "C", "d", "D"
                Result = Result & "0"
                Exit For
            Case "1c", "1C", "1d", "1D"
                Result = Result & "1"
                Exit For
            Case "2c", "2C", "2d", "2D"
                Result = Result & "2"
                Exit For
            Case "3c", "3C", "3d", "3D"
                Result = Result & "3"
                Exit For
            Case "4c", "4C", "4d", "4D"
                Result = Result & "4"
                Exit For
            Case "5c", "5C", "5d", "5D"
                Result = Result & "5"
                Exit For
            Case "6c", "6C", "6d", "6D"
                Result = Result & "6"
                Exit For
            Case "7c", "7C", "7d", "7D"
                Result = Result & "7"
                Exit For
            Case "8c", "8C", "8d", "8D"
                Result = Result & "8"
                Exit For
            Case "9c", "9C", "9d", "9D"
                Result = Result & "9"
                Exit For
            Case Else
                Result = Result & CStr(Hex(AscB(W_VAL)))
        End Select
        End If
    Next X
    'Select Case CStr(Hex(AscB(W_VAL)))
    Select Case W_HEX
        Case "c", "C", "0c", "1c", "2c", "3c", "4c", "5c", "6c", "7c", "8c", "9c", "0C", "1C", "2C", "3C", "4C", "5C", "6C", "7C", "8C", "9C"
            W_SIGN = "+"
        Case Else
            W_SIGN = "-"
    End Select
End Sub

正常値例
0x00 04 89 94 4c --> +000489944
0x00 00 09 83 4c --> +000009834
異常値例
0x00 00 15 04 8c --> -0000150481
0x00 00 07 98 2c --> -0000078145
0x00 00 11 43 9c --> -0000114381

ここから分かることは
0x83、0x89、0x94は正しく変換
0x98、0x8c、0x9cは81に変換
間違った変換の後の値も異常値になる（0x2cが45）

ループカウンタすらローカル変数になっていないなど、
モジュールレベル変数(フィールド変数)を使いすぎな点が気にかかります。

また、COMP3_CNV_RTN の引数を ByVal にしていないのは何故でしょうか?


> MOTO = GT.W_200
> MOTO = StrConv(GT.W_200, vbFromUnicode) ' システムコードに変換
最初の代入は無意味に見えますし、同じ変数に使いまわして
Unicode 文字列と ANSI バイナリの両方を格納するのにも違和感があります。


> 正常値例
> 異常値例

正常に変換される例と、失敗する例の提示はありがたいですが、
失敗する方については「本来期待する結果」も併記してもらわないと
状況を理解しにくいです。

パック10進なので、末尾4bit が 0111 (&HC) なら "+"、1000 (&HD) なら "-" になるはずが、
末尾 c なのに負数判定されてしまうのが問題ということでしょうかね。
その他、データ部も差異があるようですが。


今回のケースは、そもそも変換元のデータを「文字列」として処理しようとしているのが間違いです。
渡すべきデータさえ破損していなければ、現状の COMP3_CNV_RTN の実装でも正しく変換されるようですし。

以下実験コード

=== Command1(Byte型の一次元配列) ===
000489944c --> +000489944
000009834c --> +000009834
000015048c --> +000015048
000007982c --> +000007982
000011439c --> +000011439
'=== Command2(String型) ===
000489944c --> +000489944
000009834c --> +000009834
000015048c --> -0000150481
000007982c --> -0000078145
000011439c --> -0000114381

Private Sub Command1_Click()
    Dim source() As String, src As Variant
    source = Split("000489944c 000009834c 000015048c 000007982c 000011439c")

    Debug.Print "'=== Command1(Byte型の一次元配列) ==="
    For Each src In source
        Dim bin5() As Byte
        bin5 = HexStringToBinary(src)
        Call COMP3_CNV_RTN((bin5), 5)  '
        Debug.Print src; " --> "; W_SIGN; Result
    Next
End Sub

Private Sub Command2_Click()
    Const japanese As Integer = &H411
    Dim source() As String, src As Variant
    source = Split("000489944c 000009834c 000015048c 000007982c 000011439c")

    Debug.Print "'=== Command2(String型) ==="
    For Each src In source
        Dim bin5() As Byte
        bin5 = HexStringToBinary(src)
        Dim GT_W_200 As String
        GT_W_200 = StrConv(bin5, vbUnicode, japanese)

        MOTO = StrConv(GT_W_200, vbFromUnicode, japanese)
        COMP3_CNV_RTN MOTO, 5
      
        Debug.Print src; " --> "; W_SIGN; Result
    Next
End Sub

Public Function HexStringToBinary(ByVal Text As String) As Byte()
    With CreateObject("Microsoft.XMLDOM").createElement("e")
        .DataType = "bin.hex"
        .Text = Text
        HexStringToBinary = .NodeTypedValue
    End With
End Function
'Public Function BinaryToHexString(ByRef Binary() As Byte) As String
'    With CreateObject("Microsoft.XMLDOM").createElement("e")
'        .DataType = "bin.hex"
'        .NodeTypedValue = Binary
'        BinaryToHexString = .Text
'    End With
'End Function


> 0x80以降のデータで正しく変換できたりできなかったり

単独バイナリでの 0x8c は、文字の割り当てが無いためです。

注意深く扱えば String 型に詰めて扱うことは可能ですが、B 系以外の関数を使ったり、
vbUnicode / vbFromUnicode 等で変換させてしまうと、データを破損させてしまうことになります。


下記に、文字集合ごとの定義範囲を示します。

【Windows コードページ 932 のバイナリ定義】
　0x00〜0x1F　「制御文字」
　0x20〜0x3F　「ASCII文字」
　0x40〜0x7E　「ASCII文字」「2 バイト文字の後続バイト」
　0x80〜0x80　「1 バイト文字の予約領域（未使用）」「2 バイト文字の後続バイト」
　0x81〜0x9F　「2 バイト文字の先導バイト」「2 バイト文字の後続バイト」
　0xA0〜0xA0　「1 バイト文字の予約領域（未使用）」「2 バイト文字の後続バイト」
　0xA1〜0xDF　「半角カタカナ」「2 バイト文字の後続バイト」
　0xE0〜0xFC　「2 バイト文字の先導バイト」「2 バイト文字の後続バイト」
　0xFD〜0xFF　「予約領域（未使用）」


【Shift_JIS のバイナリ定義】
　0x00〜0x1F　「制御文字」
　0x20〜0x3F　「ASCII文字」
　0x40〜0x7E　「ASCII文字」「2 バイト文字の後続バイト」
　0x80〜0x80　「1 バイト文字の予約領域（未使用）」「2 バイト文字の後続バイト」
　0x81〜0x9F　「2 バイト文字の先導バイト」「2 バイト文字の後続バイト」
　0xA0〜0xA0　「1 バイト文字の予約領域（未使用）」「2 バイト文字の後続バイト」
　0xA1〜0xDF　「半角カタカナ」「2 バイト文字の後続バイト」
　0xE0〜0xEF　「2 バイト文字の先導バイト」「2 バイト文字の後続バイト」
　0xF0〜0xFC　「未定義領域」
　0xFD〜0xFF　「予約領域（未使用）」



次に、データが破損していた仕組みを解説します。


> 異常値例
> 0x00 00 15 04 8c --> -0000150481
00 は「制御文字 Null」1文字目
00 は「制御文字 Null」2文字目
15 は「制御文字 Shift In」3文字目
04 は「制御文字 End of Transmission」4文字目
8c は「2 バイト文字の先導バイト」5文字目の前半

→ 後続バイトが欠落しているとみなされ、5 文字目は代替文字 "・" に置き換わります。
　"・" は 0x8145 （Unicode だと U+30FB）相当の文字なので、
　最初の 4 バイトまでは 00,00,15,04 と期待通りに変換されたものの、
　末尾の 5 バイト目が 81 と判断されたのでしょう。
→ちなみに Len(StrConv(HexStringToBinary("000015048C"), vbUnicode)) は「5」文字です。


> 異常値例
> 0x00 00 07 98 2c --> -0000078145
00 は「制御文字 Null」1文字目
00 は「制御文字 Null」2文字目
07 は「制御文字 Bell」3文字目
98 は「2 バイト文字の先導バイト」4文字目の前半
2c は「ASCII 文字 ","」破損データ

→ 98 の後に 2c が来ることは想定されていないため、4 文字目が代替文字 "・" に置き換わります。
　これは 0x8145 （Unicode だと U+30FB）相当の文字なので、
　最初の 3 バイトまでは 00,00,07 と期待通りに変換されたものの、
　末尾に 8145 が付与されているのでしょう。
→ ちなみに Len(StrConv(HexStringToBinary("000007982C"), vbUnicode)) は「4」文字です。


> 異常値例
> 0x00 00 11 43 9c --> -0000114381
00 は「制御文字 Null」1文字目
00 は「制御文字 Null」2文字目
11 は「制御文字 Vertical Tabulation」3文字目
43 は「ASCII文字 "C"」4文字目
9c は「2 バイト文字の先導バイト」5文字目の前半

→ 後続バイトが欠落しているとみなされ、5 文字目が代替文字 "・" に置き換わります。
→ ちなみに Len(StrConv(HexStringToBinary("000011439C"), vbUnicode)) は「5」文字です。



> 正常値例
> 0x00 04 89 94 4c --> +000489944
00 は「制御文字 Null」1文字目
04 は「制御文字 End of Transmission」2文字目
89 は「2 バイト文字の先導バイト」3文字目の前半
94 は「2 バイト文字の後続バイト」3文字目の後半 … 3文字目は "鉛"
4c は「ASCII文字 "L"」4文字目

→ 文字列欠損なく、ANSI/Unicode 変換が可能です。
→ ちなみに Len(StrConv(HexStringToBinary("000489944C"), vbUnicode)) は「4」文字です。


> 正常値例
> 0x00 00 09 83 4c --> +000009834
00 は「制御文字 Null」1文字目
00 は「制御文字 Null」2文字目
09 は「制御文字 Horizontal Tabulation」3文字目
83 は「2 バイト文字の先導バイト」4文字目の前半
4c は「2 バイト文字の後続バイト」4文字目の後半 … 4文字目は "キ"

→ 文字列欠損なく、ANSI/Unicode 変換が可能です。
→ ちなみに Len(StrConv(HexStringToBinary("000009834C"), vbUnicode)) は「4」文字です。

魔界の仮面弁士さま

返信ありがとうございます。
実験までしていただき、お手を煩わせて申し訳ありません。

> ループカウンタすらローカル変数になっていないなど、
> モジュールレベル変数(フィールド変数)を使いすぎな点が気にかかります。

元々は汎用機やサーバのCobolerでして、ご指摘のようなことを気にして
おりませんでした。以後は気を付けます。

>
> また、COMP3_CNV_RTN の引数を ByVal にしていないのは何故でしょうか?
>
>
> > MOTO = GT.W_200
> > MOTO = StrConv(GT.W_200, vbFromUnicode) ' システムコードに変換
> 最初の代入は無意味に見えますし、同じ変数に使いまわして
> Unicode 文字列と ANSI バイナリの両方を格納するのにも違和感があります。
>
ByValに関しては理解できていないためです。
MOTOへの代入はテスト中でのコメント漏れです。すみません。


> 正常に変換される例と、失敗する例の提示はありがたいですが、
> 失敗する方については「本来期待する結果」も併記してもらわないと
> 状況を理解しにくいです。
>
自分勝手に理解していただけると思っていました。申し訳ありません。

実験結果の「Command1」が求める結果なのでそちらで実行できるように
修正したいと思いますが、ここでも知識不足が露呈しプログラムの理解
から始めなければなりません。
厚かましいとは思いますが、実験で作られたプログラムの解説をお願い
できないでしょうか。本当に申し訳ありません。

正しく変換できなかった解説もありがとうございました。


> 今回のケースは、そもそも変換元のデータを「文字列」として処理しようとしているのが間違いです。
> 渡すべきデータさえ破損していなければ、現状の COMP3_CNV_RTN の実装でも正しく変換されるようですし。
>
> 以下実験コード
>
> === Command1(Byte型の一次元配列) ===
> 000489944c --> +000489944
> 000009834c --> +000009834
> 000015048c --> +000015048
> 000007982c --> +000007982
> 000011439c --> +000011439

> 元々は汎用機やサーバのCobolerでして、
私は逆に、COBOL の読み書きができないんですよね…。orz

.NET Framework 対応の COBOL 言語を数時間触ったことがあって、
COMP-3 形式 とかもその時に概念として齧ったことがある程度で。


> パック形式のシーケンシャルファイルから
> SQL-Serverに一括登録するプログラムを作っています。
SQL Server への格納が目的なのであれば、SQL Server 側で
　dbo.fn_varbintohexstr(@pack)
で 16進数化して、符号だけ切り出して decimal 変換するのも手かと思います。


たとえば後述の Transact-SQL を実行すると、下記の変換結果が得られます。

実際に使うときは、VARBINARY（もしくは 16進数文字列な VARCHAR）を受け取って
戻り値として DECIMAL を返すような FUNCTION を SQL Server 側に作成しておくと便利かと。


ID 　HEX         　VALUE
---　------------　-------
例1　0x000489944c　 489944
例2　0x000009834c　   9834
例3　0x000015048c　  15048
例4　0x000007982c　   7982
例5　0x000011439c　  11439
例6　0x01234d    　  -1234


-----------------------------
DECLARE @pack1 VARBINARY(255);
DECLARE @pack2 VARBINARY(255);
DECLARE @pack3 VARBINARY(255);
DECLARE @pack4 VARBINARY(255);
DECLARE @pack5 VARBINARY(255);
DECLARE @pack6 VARBINARY(255);

SET @pack1 = 0x000489944c;
SET @pack2 = 0x000009834c;
SET @pack3 = 0x000015048c;
SET @pack4 = 0x000007982c;
SET @pack5 = 0x000011439c;
SET @pack6 = 0x01234d;

WITH CTE1 (ID, VALUE) AS (
  SELECT '例1', @pack1 UNION ALL
  SELECT '例2', @pack2 UNION ALL
  SELECT '例3', @pack3 UNION ALL
  SELECT '例4', @pack4 UNION ALL
  SELECT '例5', @pack5 UNION ALL
  SELECT '例6', @pack6
), CTE2 (ID, HEX) AS (
  SELECT ID, dbo.fn_varbintohexstr(VALUE) FROM CTE1
), CTE3 (ID, HEX, VALUE) AS (
  SELECT ID, HEX, CASE
    WHEN HEX LIKE '0x%[a-f]_%' THEN NULL
    WHEN HEX LIKE '0x%c' THEN +1
    WHEN HEX LIKE '0x%d' THEN -1
    END * CONVERT(DECIMAL,
    REPLACE(REPLACE(REPLACE(HEX, 'd', ''), 'c', ''), '0x', ''))
  FROM CTE2
) SELECT * FROM CTE3 ORDER BY ID



> 厚かましいとは思いますが、実験で作られたプログラムの解説をお願い
> できないでしょうか。本当に申し訳ありません。

実験コード自体の解説をしても、あまり意味は無いと思いますよ。

今回の問題は、COMP3_CNV_RTN に渡すべき「データ」を
どこからどうやって取得しているのかが問題だからです。

渡すべきデータが間違っている（というか破損している）ために生じた問題ですので、
最初に御提示頂いたコードだけを見ても、原因は特定できません。

『パック形式のシーケンシャルファイル』を読み取っているコードを見せてください。
ついでに、変換元ファイルの具体的な内容も分かると説明しやすいです。



>> ループカウンタすらローカル変数になっていないなど、
>> モジュールレベル変数(フィールド変数)を使いすぎな点が気にかかります。
> 元々は汎用機やサーバのCobolerでして、ご指摘のようなことを気にして
> おりませんでした。以後は気を付けます。

ほとんどの変数は、ローカル変数として宣言されるべきです。
（ローカル変数とは、Sub〜End Sub / Function〜End Function の中で宣言される Dim のことです）

また、処理結果を返却するためには、Function の戻り値を使うのが望ましいです。
たとえば今回のケースなら、COMP3_CNV_RTN の実装は、
　Function COMP3_CNV_RTN(ByRef C3() As Byte) As String
もしくは
　Function COMP3_CNV_RTN(ByVal C3 As String) As String
などとするのが良いと思います。CNT 引数をつけるかどうかはお好みで。



> ByValに関しては理解できていないためです。
今回の『Sub COMP3_CNV_RTN(C3 As String, CNT As Integer)』の場合、
Sub COMP3_CNV_RTN(ByVal C3 As String, ByVal CNT As Integer)
にした方が良いということです。

引数に ByVal も ByRef もつけなかった場合、VB6 では ByRef 扱い、VB.NET では ByVal 扱いになります。


ByVal は「呼び出し元からデータを受け取る」ためのものですが、
ByRef は「呼び出し元にデータを返却する」ための出力引数です。
（ただし VB6 では、配列やユーザー定義型を渡す場合は、ByVal 扱いにできません）


今回の COMP3_CNV_RTN の中では「C3 の内容を読み取る」ことはあっても、
「呼び出し元に返却するために C3 の内容を書き換える」ことはないので、
ByVal をつけるべきである、ということです。


また先の例においては、Command1 のコードにて
　Dim bin5() As Byte
　bin5 = HexStringToBinary(src)
　Call COMP3_CNV_RTN((bin5), 5)
と書いておりますが、もしもこれを
　Dim bin5() As Byte
　bin5 = HexStringToBinary(src)
　Call COMP3_CNV_RTN(bin5, 5)
にしてしまうと、コンパイルエラー『ByRef 引数の型が一致しません。』が表示されることになります。

Command2 の方についても、変数 MOTO のデータ型が String では無かった場合
（たとえば、Dim MOTO As Variant や Dim MOTO() As Byte だった場合）において
同様にコンパイルエラー『ByRef 引数の型が一致しません。』が表示されます。

しかし引数が、ByVal で宣言されていれば、上記のコンパイルエラーになることなく
動作させることができます。その分、利用する際にも使いやすくなると思いますよ。

魔界の仮面弁士様

さらなる助言ありがとうございます。
しかし、やはり己の無知さ加減が情けないです。

今、コンバートしようとしているシステムとは別のシステムで
SQL-Serverを使っており、無知な私でも使うことができるので
好きなデータベースなんです。
しかし、魔界の仮面弁士様の示された内容を理解するには更なる
努力が必要と思われます。

今までもBCPでテーブルデータを一括で上げ下げしていたので、
同様にできないかと思い調べましたが情報がなくて、プログラムを
作ることにした次第です。

> > 元々は汎用機やサーバのCobolerでして、
> 私は逆に、COBOL の読み書きができないんですよね…。orz
>
COBOLほど数字を扱うのが楽な言語はないと思っています。
きっと魔界の仮面弁士様なら少しかじられただけでも納得して
頂けると思いますよ。


> SQL Server への格納が目的なのであれば、SQL Server 側で
> 　dbo.fn_varbintohexstr(@pack)
> で 16進数化して、符号だけ切り出して decimal 変換するのも手かと思います。
>
これができればいろいろなファイルがあるので一番使い勝手が
良いと思いますが、理解するためには一から勉強しなおす必要が
ありそうです。


> 今回の問題は、COMP3_CNV_RTN に渡すべき「データ」を
> どこからどうやって取得しているのかが問題だからです。
>
> 渡すべきデータが間違っている（というか破損している）ために生じた問題ですので、
> 最初に御提示頂いたコードだけを見ても、原因は特定できません。
>
> 『パック形式のシーケンシャルファイル』を読み取っているコードを見せてください。
> ついでに、変換元ファイルの具体的な内容も分かると説明しやすいです。
>
長くなりますが、下記に示させていただきます。

ところで、前回にご教示いただいた HexStringToBinary ですが、
.NodeTypedValue で止まってしまいました。
Project内で何かを選択しなければならないんでしょうか？

いろいろと本当に申し訳ありません。

Option Explicit
Private DbCon As ADODB.Connection
Dim GR20tbl  As ADODB.Recordset
Dim DCNT    As Long
Dim MOTO As String
Dim KAMI As Integer
Dim SIMO As Integer
Dim W_VAL As String
Dim Result As String
Dim W_SIGN As String
Dim W21_010 As String
Dim W21_060 As Integer
Dim W21_080 As Integer
Dim W21_100 As Integer
Dim W21_110 As Integer
Dim W21_130 As Integer
Dim W21_150 As Integer
Dim W21_170 As Integer
Dim W21_190 As Integer
Dim W21_200 As Currency
Dim W21_210 As Integer
Dim W21_220 As Currency
Dim W21_230 As Integer
Dim W21_240 As Integer
Dim W21_250 As Integer
Dim W21_270 As Integer
Dim W21_290 As Integer
Dim W21_580 As Integer
Dim W21_590 As Integer
Dim W21_610 As Integer
Dim W21_620 As Integer
Dim W21_630 As Integer
Dim InData  As String
Private Type SEQ_DATA
    W_010 As String * 6
    W_040 As String * 4
    W_020 As String * 1
    W_050 As String * 8
    W_060 As String * 3
    W_080 As String * 4
    W_100 As String * 3
    W_110 As String * 3
    W_130 As String * 3
    W_150 As String * 3
    W_170 As String * 3
    W_190 As String * 3
    W_200 As String * 5
    W_210 As String * 3
    W_220 As String * 5
    W_230 As String * 4
    W_240 As String * 3
    W_250 As String * 3
    W_270 As String * 3
    W_290 As String * 3
    W_580 As String * 3
    W_590 As String * 3
    W_610 As String * 3
    W_620 As String * 3
    W_630 As String * 1
    W_FIL As String * 3
    W_800 As String * 1
    W_810 As String * 4
    W_990 As String * 6
    'W_CRLF As String * 2
End Type
Private GT As SEQ_DATA

Private Sub Command1_Click()
    Dim strConn As String
    Dim strServerName   As String
    Dim strUserName     As String
    Dim strPassword     As String
    Dim strDatabase     As String
    Youbi = Format$(Date, "w", vbMonday)
    KyouD = Format(Date, "mmdd")
    List1.Clear
    LIST_DSP_RTN "** Start of DGRS20 Loading ! **"
    strServerName = Trim(GET_INIFILE("CONNECT", "ServerName"))
    strUserName = Trim(GET_INIFILE("CONNECT", "UserName"))
    strPassword = Trim(GET_INIFILE("CONNECT", "Password"))
    strDatabase = Trim(GET_INIFILE("CONNECT", "Database"))
    Err.Number = 0
    On Error Resume Next
    Set DbCon = New ADODB.Connection
    DbCon.Provider = "SQLOLEDB"
    DbCon.Properties("Data Source") = strServerName
    DbCon.Properties("User ID").Value = strUserName
    DbCon.Properties("Password").Value = strPassword
    DbCon.ConnectionString = ""
    DbCon.Open
    ' デフォルトDB設定
    DbCon.DefaultDatabase = strDatabase
    If Err.Number <> 0 Then
        LIST_DSP_RTN "******  FILE  I-O  ERROR  *******"
        LIST_DSP_RTN "1) PROGRAM-ID  =  C3CNVT2"
        LIST_DSP_RTN "2) Database    =  MKDB"
        LIST_DSP_RTN "3) ERROR CODE  =  " & Format(Err.Number)
        LIST_DSP_RTN "4) ERROR MSG   =  " & Error
        LIST_DSP_RTN "*********************************"
        DbCon.Close
        End
    Else
        LIST_DSP_RTN "MGSDB Databace OPEN SUCCESFUL!"
    End If
    On Error GoTo 0
    LIST_DSP_RTN "DGRS20 DELETE START"
    On Error Resume Next
    'strSQL = "DELETE FROM dbo.DGRS20"
    ' ADODBレコードセット生成
    Set GR20tbl = New ADODB.Recordset
    ' トランザクション開始
    DbCon.BeginTrans
    ' レコード削除SQL
    GR20tbl.Open "DELETE FROM dbo.DGRS20", DbCon
    ' トランザクションコミット
    DbCon.CommitTrans
    If Err.Number <> 0 Then
        LIST_DSP_RTN "******  FILE  I-O  ERROR  *******"
        LIST_DSP_RTN "1) PROGRAM-ID  =  DGRS20 DELETE"
        LIST_DSP_RTN "2) ERROR CODE  =  " & Format(Err.Number)
        LIST_DSP_RTN "3) ERROR MSG   =  " & Error
        LIST_DSP_RTN "*********************************"
    End If
    On Error GoTo 0
    Set GR20tbl = Nothing
    LIST_DSP_RTN "DGRS20 DELETE END"
    LIST_DSP_RTN "DGRS20 CONVERT START !"
    DCNT = 0
    Open "e:\mcl\dat\DGRS20" For Binary Access Read As #1 Len = 100
    If Err.Number <> 0 Then
        LIST_DSP_RTN "******  FILE  I-O  ERROR  *******"
        LIST_DSP_RTN "1) PROGRAM-ID  =  C3CNVT2"
        LIST_DSP_RTN "2) FILE NAME   =  DGRS20"
        LIST_DSP_RTN "3) ERROR CODE  =  " & Format(Err.Number)
        LIST_DSP_RTN "4) ERROR MSG   =  " & Error
        LIST_DSP_RTN "*********************************"
        DbCon.Close
        Stop
        End
    Else
        LIST_DSP_RTN "DGRS20(SEQ) OPEN SUCCESFUL!"
    End If
    Dim ret     As Boolean
    ret = False
    Set GR20tbl = New ADODB.Recordset
    GR20tbl.Open "select * from dbo.dgrs20", DbCon, adOpenDynamic, adLockOptimistic
    DbCon.BeginTrans
    '読み込み
    Seek #1, 1
    Do Until EOF(1)
        'Line Input #1, indata
        Get #1, , GT
        DataSet1
        ret = MGRS20_ENTRY_RTN
        If ret Then Exit Do
        DCNT = DCNT + 1
        If DCNT Mod 100 = 0 Then
            LIST_DSP_RTN "* DATA-CNT : " & Format(DCNT)
        End If
        If DCNT = 300 Then Exit Do
    Loop
    Close #1
    If Not ret Then
        DbCon.CommitTrans
        LIST_DSP_RTN "DATA-CNT : " & Format(DCNT)
        LIST_DSP_RTN "DGRS20  Loading  END !"
    Else
        DbCon.Rollback
        LIST_DSP_RTN "C3CNVT2 ABNORMAL END"
        Stop
    End If
    DbCon.Close
    LIST_DSP_RTN "** C3CNVT2 NORMAL END **"
End Sub

Private Sub DataSet1()
    LogWrt GT.W_010 & GT.W_040 & GT.W_020 & GT.W_050
    'Z21_060
    MOTO = GT.W_060
    COMP3_CNV_RTN MOTO, 3
    W21_060 = Val(W_SIGN & Result)
    'Z21_080
    MOTO = GT.W_080
    COMP3_CNV_RTN MOTO, 4
    W21_080 = Val(W_SIGN & Result)
    'Z21_100
    MOTO = GT.W_100
    COMP3_CNV_RTN MOTO, 3
    W21_100 = Val(W_SIGN & Result)
    'Z21_110
    MOTO = GT.W_110
    COMP3_CNV_RTN MOTO, 3
    W21_110 = Val(W_SIGN & Result)
    'Z21_130
    MOTO = GT.W_130
    COMP3_CNV_RTN MOTO, 3
    W21_130 = Val(W_SIGN & Result)
    'Z21_150
    MOTO = GT.W_150
    COMP3_CNV_RTN MOTO, 3
    W21_150 = Val(W_SIGN & Result)
    'Z21_170
    MOTO = GT.W_170
    COMP3_CNV_RTN MOTO, 3
    W21_170 = Val(W_SIGN & Result)
    'Z21_190
    MOTO = GT.W_190
    COMP3_CNV_RTN MOTO, 3
    W21_190 = Val(W_SIGN & Result)
    'Z21_200
    MOTO = GT.W_200
    COMP3_CNV_RTN MOTO, 5
    W21_200 = Val(W_SIGN & Result)
    'Z21_210
    MOTO = GT.W_210
    COMP3_CNV_RTN MOTO, 3
    W21_210 = Val(W_SIGN & Result)
    'Z21_220
    MOTO = GT.W_220
    COMP3_CNV_RTN MOTO, 5
    W21_220 = Val(W_SIGN & Result)
    'Z21_230
    MOTO = GT.W_230
    COMP3_CNV_RTN MOTO, 4
    W21_230 = Val(W_SIGN & Result)
    'Z21_240
    MOTO = GT.W_240
    COMP3_CNV_RTN MOTO, 3
    W21_240 = Val(W_SIGN & Result)
    'Z21_250
    MOTO = GT.W_250
    COMP3_CNV_RTN MOTO, 3
    W21_250 = Val(W_SIGN & Result)
    'Z21_270
    MOTO = GT.W_270
    COMP3_CNV_RTN MOTO, 3
    W21_270 = Val(W_SIGN & Result)
    'Z21_290
    MOTO = GT.W_290
    COMP3_CNV_RTN MOTO, 3
    W21_290 = Val(W_SIGN & Result)
    'Z21_580
    MOTO = GT.W_580
    COMP3_CNV_RTN MOTO, 3
    W21_580 = Val(W_SIGN & Result)
    'Z21_590
    MOTO = GT.W_590
    COMP3_CNV_RTN MOTO, 3
    W21_590 = Val(W_SIGN & Result)
    'Z21_610
    MOTO = GT.W_610
    COMP3_CNV_RTN MOTO, 3
    W21_610 = Val(W_SIGN & Result)
    'Z21_620
    MOTO = GT.W_620
    COMP3_CNV_RTN MOTO, 3
    W21_620 = Val(W_SIGN & Result)
End Sub

Private Sub COMP3_CNV_RTN(ByVal C3 As String, CNT As Integer)
    Dim W_ASC As String
    Dim W_HEX As String
    Dim X As Integer
    Result = ""
    W_SIGN = ""
    C3 = StrConv(C3, vbFromUnicode)
    For X = 1 To CNT
        W_VAL = MidB(C3, X, 1)
        W_ASC = CStr(AscB(W_VAL))
        W_HEX = (Hex(AscB(W_VAL)))
        If Len(CStr(Hex(AscB(W_VAL)))) = 1 Then
            Result = Result & "0" & CStr(Hex(AscB(W_VAL)))
        Else
        Select Case CStr(Hex(AscB(W_VAL)))
            Case "0c", "0C", "0d", "0D", "c", "C", "d", "D"
                Result = Result & "0"
                Exit For
            Case "1c", "1C", "1d", "1D"
                Result = Result & "1"
                Exit For
            Case "2c", "2C", "2d", "2D"
                Result = Result & "2"
                Exit For
            Case "3c", "3C", "3d", "3D"
                Result = Result & "3"
                Exit For
            Case "4c", "4C", "4d", "4D"
                Result = Result & "4"
                Exit For
            Case "5c", "5C", "5d", "5D"
                Result = Result & "5"
                Exit For
            Case "6c", "6C", "6d", "6D"
                Result = Result & "6"
                Exit For
            Case "7c", "7C", "7d", "7D"
                Result = Result & "7"
                Exit For
            Case "8c", "8C", "8d", "8D"
                Result = Result & "8"
                Exit For
            Case "9c", "9C", "9d", "9D"
                Result = Result & "9"
                Exit For
            Case Else
                Result = Result & CStr(Hex(AscB(W_VAL)))
        End Select
        End If
    Next X
    Select Case W_HEX
        Case "c", "C", "0c", "1c", "2c", "3c", "4c", "5c", "6c", "7c", "8c", "9c", "0C", "1C", "2C", "3C", "4C", "5C", "6C", "7C", "8C", "9C"
            W_SIGN = "+"
        Case Else
            W_SIGN = "-"
    End Select
    LogWrt W_SIGN & Result
End Sub

> Private Type SEQ_DATA
>    W_010 As String * 6
>    W_040 As String * 4
(中略)
>    'W_CRLF As String * 2
> End Type
> Private GT As SEQ_DATA
(中略)
> Open "e:\mcl\dat\DGRS20" For Binary Access Read As #1 Len = 100
> Get #1, , GT

原因はこのあたりですね。ランダムアクセスの処理に問題があります。

バイナリデータを取り込みたいのであれば、ユーザー定義型には
As String や As String * n を一切含めないでください。

代わりに、Byte 型の一次元配列を使うようにします。


まず大前提として、COMP-3 は「バイナリデータ」です。
文字列ではありません。

それなのに、「As String * n」なデータ型で読み取ろうとしたため、
下記のような手順で処理されてしまい、データが破損することになります。


(1) 本来はバイナリデータでしたが、String 型へのファイル入出力が行われたため、
　VB6 はそれを Shift_JIS テキストなデータ(正確には CP932) とみなしてロードします。

→ Shift_JIS の文字集合でありえないバイト列が含まれた場合、それは代替文字 "・" に変わります。


(2) 破損しつつも読み取った文字列が、ANSI→Unicode 変換を伴って、VB の String 型に格納されます。
　Shift_JIS では区別できていた文字が、Unicode になると区別できなくなるケースがあるため、
　この時点でもデータ破損が発生することがあります。

→たとえば：
　Shift_JIS の 81,E3 を Unicode 変換した場合には 22,1A (√) になりますが、
　Shift_JIS の 87,95 を Unicode 変換した場合にも 22,1A (√) という同じ文字になります。


(3) 最初に御提示頂いたコードでは、
> MOTO = StrConv(GT.W_200, vbFromUnicode) ' システムコードに変換
などとして、Unicode → ANSI 変換で復元しようとしていたようですが、
既に破損してしまったデータは、もはや復元することは不可能です。

魔界の仮面弁士様

いろいろお手数をおかけして申し訳ありません。

> バイナリデータを取り込みたいのであれば、ユーザー定義型には
> As String や As String * n を一切含めないでください。
>
> 代わりに、Byte 型の一次元配列を使うようにします。
>
>
> まず大前提として、COMP-3 は「バイナリデータ」です。
> 文字列ではありません。
>
> それなのに、「As String * n」なデータ型で読み取ろうとしたため、
> 下記のような手順で処理されてしまい、データが破損することになります。
>

本当に無知とは恐ろしいものです。
最終的に魔界の仮面弁士様が書かれているようにByte型でデータを
扱うことで無事登録することができました。
今回の件でいろいろ勉強することができましたが、どのようにすれば
魔界の仮面弁士様のようになれるんでしょう？
まぁ、リタイア間近なのですでに頭がついていきませんが・・・
今後も何かありましたら、またよろしくお願いします。
ありがとうございました。

魔界の仮面弁士様

> ついでに、変換元ファイルの具体的な内容も分かると説明しやすいです。
>
先にソースは開示しましたが、データに関して詳しい内容を
お知らせしていなかったので本日対象データを抽出するよう
プログラムを変更して実行しました。

データをGETした直後に下記を実行してHexエディターで確認
すると、その時点ですでに違う数値になっていました。
これは読み方に問題があるんでしょうか？
それとも書き方でしょうか？

    If GT.W_010 & GT.W_040 & GT.W_020 & GT.W_050 = "2010040002102691502" Or _
        GT.W_010 & GT.W_040 & GT.W_020 & GT.W_050 = "2010040002103740921" Or _
        GT.W_010 & GT.W_040 & GT.W_020 & GT.W_050 = "2010040002104289633" Or _
        GT.W_010 & GT.W_040 & GT.W_020 & GT.W_050 = "2010040002104922431" Or _
        GT.W_010 & GT.W_040 & GT.W_020 & GT.W_050 = "2010040002105249742" Then
        WC = WC + 1
        Open "e:\mcl\dat\DGRS20SAMPLE" For Random Access Write As #2
        Put #2, WC, GT
        Close #2
    End If

元ファイル　　　　　抽出ファイル
0x00 00 89 94 4c    0x00 00 89 94 4c
0x00 00 09 83 4c    0x00 00 09 83 4c
0x00 00 15 04 8c    0x00 00 15 04 39
0x00 00 07 98 2c    0x00 00 07 81 45
0x00 00 11 43 9c    0x00 00 11 43 39

抽出したデータもお見せしたいんですがハードコピーを
張り付ければよろしいでしょうか？

魔界の仮面弁士様

今日もいろいろもがいてみました。
その結果、100バイトずつバイナリーで読んだ後、全体を
HEX変換をすることで何とかなりそうな感触を得ました。
ちょっと泥臭い気もしますが、それで作り直してみます。
（もっとスマートな変換方法があれば良いんですが・・）
また、ご相談させていただくことになるかもしれませんが、
とりあえずもうひと頑張りしてみます。
ありがとうございました。

> その結果、100バイトずつバイナリーで読んだ後、

ちなみに ADODB は、バイナリーファイルの読み込みにも使えます。

Dim stm As ADODB.Stream
Dim bin() As Byte

'ファイルを読み込む
Set stm = New ADODB.Stream
stm.Open
stm.LoadFromFile "C:\TEMP\TEST1.TXT"

'バイナリモードでアクセスする
stm.Type = adTypeBinary

'現在の位置から 100 バイト分を読み込む
bin = stm.Read(100)

'先頭から 300 バイト目の位置に移動し、そこから 8 バイトを読み込む
stm.Position = 300
bin = stm.Read(8)

'閉じる
stm.Close
Set stm = Nothing

魔界の仮面弁士様

勉強させていただきました。
感謝しております。ありがとうございました。

> > その結果、100バイトずつバイナリーで読んだ後、
>
> ちなみに ADODB は、バイナリーファイルの読み込みにも使えます。
>
> Dim stm As ADODB.Stream
> Dim bin() As Byte
>
> 'ファイルを読み込む
> Set stm = New ADODB.Stream
> stm.Open
> stm.LoadFromFile "C:\TEMP\TEST1.TXT"
>
> 'バイナリモードでアクセスする
> stm.Type = adTypeBinary
>
> '現在の位置から 100 バイト分を読み込む
> bin = stm.Read(100)
>
> '先頭から 300 バイト目の位置に移動し、そこから 8 バイトを読み込む
> stm.Position = 300
> bin = stm.Read(8)
>
> '閉じる
> stm.Close
> Set stm = Nothing