MW211 EXIT

devlog
VBScript/ファイルを一行ずつ読むⅡ
2022年06月10日
改行コードを認識して(LFにまるめて)ファイルを一行ずつ読む方法。
(全行を一旦配列に読み込む方式となってしまう)
UTF-8も対応(先頭のBOMで認識)。
┌──────────────────────────────────────┐
│Const adTypeBinary = 1        ' バイナリとして読込                          │
│Const adTypeText = 2          ' テキストとして読込                          │
│Const adReadAll = -1          ' 全行読込                                    │
│Const adReadLine = -2         ' 一行読込                                    │
│Const adCR = 13               ' 改行CR                                      │
│Const adCRLF = -1             ' 改行CRLF                                    │
│Const adLF = 10               ' 改行LF                                      │
│'***************************************************************************│
│'  メイン処理                                                               │
│'***************************************************************************│
│Dim objFile, theLine                                                        │
│Set objFile = New ClassFile                                                 │
│objFile.Init("ファイルパス")      ' ★ファイルパスを指定                    │
│Set theLine = objFile.Fetch()     ' 明細行一件目読込                        │
│Do While Not theLine Is Nothing                                             │
│    ' ★処理を実装                                                          │
│    Set theLine = objFile.Fetch() ' 明細行二件目以降読込                    │
│Loop                                                                        │
│Set objFile = Nothing                                                       │
│WScript.Quit(0)                                                             │
│'***************************************************************************│
│'  クラス:データベース                                                     │
│'***************************************************************************│
│Class ClassFile                                                             │
│    Private mIsOk, mLines, mIndex, mPath                                    │
│    '=======================================================================│
│    '  コンストラクタ                                                       │
│    '=======================================================================│
│    Private Sub Class_Initialize                                            │
│        mIsOk = False                                                       │
│        Set mObjStream = WScript.CreateObject("ADODB.Stream")               │
│        ' ★改行コード(以下のいずれかを指定)                                │
│        mObjStream.LineSeparator = adCR     ' 改行CR                        │
│        mObjStream.LineSeparator = adCRLF   ' 改行CRLF(既定)                │
│        mObjStream.LineSeparator = adLF     ' 改行LF                        │
│    End Sub                                                                 │
│    '=======================================================================│
│    '  準コンストラクタ                                                     │
│    '=======================================================================│
│    Public Sub Init(inPath)                                                 │
│        mPath = inPath                                                      │
│        '-------------------------------------------------------------------│
│        Dim allText                                                         │
│        Dim objStream:  Set objStream = WScript.CreateObject("ADODB.Stream")│
│        '-------------------------------------------------------------------│
│        '  文字コード識別(先頭BOMでUTF-8を)                                 │
│        '-------------------------------------------------------------------│
│        If IsExistBom(inPath) Then                                          │
│            objStream.Charset = "UTF-8"                                     │
│        Else                                                                │
│            objStream.Charset = "SHIFT_JIS"                                 │
│        End If                                                              │
│        '-------------------------------------------------------------------│
│        '  全件読込                                                         │
│        '-------------------------------------------------------------------│
│        With objStream                                                      │
│            .Type = adTypeText                                              │
│            .Open                                                           │
│            .LoadFromFile inPath                                            │
│            .Position = 0                                                   │
│            allText = .ReadText(adReadAll)                                  │
│            .Close                                                          │
│        End With                                                            │
│        '-------------------------------------------------------------------│
│        '  改行コードをLFに統一し配列化                                     │
│        '-------------------------------------------------------------------│
│        allText = Replace(allText, vbCrLf, vbLf, 1, -1, vbBinaryCompare)'CRLF→LF
│        allText = Replace(allText, vbCr, vbLf, 1, -1, vbBinaryCompare)  'CR  →LF
│        mLines = Split(allText, vbLf, -1, vbBinaryCompare)                  │
│        mIndex = 0                                                          │
│        '-------------------------------------------------------------------│
│        '  ヘッダ読込                                                       │
│        '-------------------------------------------------------------------│
│        mIsOk = True                                                        │
│        If Not ReadHeader() Then                                            │
│            mIsOk = False                                                   │
│        End If                                                              │
│    End Sub                                                                 │
│    '=======================================================================│
│    '  内部メソッド:ヘッダの読込                                           │
│    '=======================================================================│
│    Private Function ReadHeader()                                           │
│        If mIndex >= UBound(mLines) Then                                    │
│            MsgBox "空っぽです" & vbCrLf & mPath, vbCritical, "エラー"      │
│            ReadHeader = False                                              │
│            Exit Function                                                   │
│        End If                                                              │
│        Do Until mIndex >= UBound(mLines)                                   │
│            If mLines(mIndex) = "ID,…" Then  ' ★想定する見出と照合        │
│                ReadHeader = True                                           │
│                mIndex = mIndex + 1 ' 次へ                                  │
│                Exit Function                                               │
│            End If                                                          │
│            mIndex = mIndex + 1 ' 次へ                                      │
│        Loop                                                                │
│        MsgBox "これは対象ファイルではありません。" & vbCrLf _              │
│             & vbCrLf _                                                     │
│             & mPath, vbCritical, "処理スキップ"                            │
│        ReadHeader = False                                                  │
│    End Function                                                            │
│    '=======================================================================│
│    '  デストラクタ                                                         │
│    '=======================================================================│
│    Private Sub Class_Terminate                                             │
│    End Sub                                                                 │
│    '=======================================================================│
│    '  メソッド:実行                                                       │
│    '=======================================================================│
│    Public Function Fetch()                                                 │
│        If Not mIsOk Then                                                   │
│            Set Fetch = Nothing                                             │
│            Exit Function                                                   │
│        End If                                                              │
│        '-------------------------------------------------------------------│
│        ' EOF                                                               │
│        If mIndex >= UBound(mLines) Then                                    │
│            Set Fetch = Nothing                                             │
│            Exit Function                                                   │
│        End If                                                              │
│        '-------------------------------------------------------------------│
│        Set Fetch = mLines(mIndex)                                          │
│        mIndex = mIndex + 1 ' 次へ                                          │
│    End Function                                                            │
│    '=======================================================================│
│    '  内部メソッド:BOMの存在チェック                                      │
│    '=======================================================================│
│    Private Function IsExistBom(inPath)                                     │
│        Dim objStream:  Set objStream = WScript.CreateObject("ADODB.Stream")│
│        Dim bin, data                                                       │
│        bin = vbNullString                                                  │
│        With objStream                                                      │
│            .Type = adTypeBinary                                            │
│            .Open                                                           │
│            .LoadFromFile inPath                                            │
│            .Position = 0                                                   │
│            If .Size >= 3 Then                                              │
│                data = .Read(3)                                             │
│                bin = Hex(AscB(MidB(data, 1, 1))) _                         │
│                    & Hex(AscB(MidB(data, 2, 1))) _                         │
│                    & Hex(AscB(MidB(data, 3, 1)))                           │
│            End If                                                          │
│            .Close                                                          │
│        End With                                                            │
│        IsExistBom = (bin = "EFBBBF")                                       │
│    End Function                                                            │
│    '=======================================================================│
│End Class                                                                   │
└──────────────────────────────────────┘
分類:WSH・VBS