tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
[ツリー表示へ]  [ワード検索]  [Home]

タイトル Re^4: COMP-3の変換につて
投稿日: 2017/09/25(Mon) 11:50
投稿者Naruse
魔界の仮面弁士様

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

今、コンバートしようとしているシステムとは別のシステムで
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

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。