たまに「じゃんぬねっと」が生存確認をする日記 役員より労働者の方が楽だと思う

'/** CsvReader クラス */
Option Explicit

Class CsvReader

    ' プロパティ変数
    Private m_FilePath    'As String
    Private m_HasHeader   'As Boolean
    Private m_IgnoreError 'As Boolean

    ' Private フィールド
    Private mTextStream   'As TextStream
    Private mState        'As EnumState
    Private mHeaders      'As Dictionary

    ' 列挙体の代わり
    Private EnumState     'As EnumStateConstants

    ' コンストラクタ
    Private Sub Class_Initialize()
        Set EnumState = New EnumStateConstants
        mState = EnumState.None
    End Sub

    ' デストラクタ
    Private Sub Class_Terminate()
        Call Me.CloseStream()
    End Sub

    ' FilePath プロパティ - Getter
    Public Property Get FilePath() 'As String
        FilePath = m_FilePath
    End Property

    ' HasHeader プロパティ - Getter
    Public Property Get HasHeader() 'As Boolean
        HasHeader = m_HasHeader
    End Property

    ' IgnoreError プロパティ - Getter
    Public Property Get IgnoreError() 'As Boolean
        IgnoreError = m_IgnoreError
    End Property

    ' IgnoreError プロパティ - Setter
    Public Property Let IgnoreError(ByVal Value) 'As Boolean
        m_IgnoreError = Value
    End Property

    ' EndOfStream プロパティ
    Public Property Get EndOfStream() 'As Boolean
        EndOfStream = mTextStream.AtEndOfStream
    End Property

    ' OpenStream メソッド
    Public Function OpenStream(ByVal stFilePath) 'As Boolean
        On Error Resume Next
        m_FilePath = stFilePath

        Dim cFso 'As FileSystemObject
        Set cFso = WScript.CreateObject("Scripting.FileSystemObject")
        Set mTextStream = cFso.OpenTextFile(Me.FilePath)

        If Err.Number = 0 Then
            OpenStream = True
            Exit Function
        End If

        Call Me.CloseStream()
    End Function

    ' CloseStream メソッド
    Public Sub CloseStream()
        If Not mTextStream Is Nothing Then
            On Error Resume Next
            Call mTextStream.Close()
            On Error GoTo 0
        End If
    End Sub

    ' ReadHeader メソッド
    Public Function ReadHeader() 'As Dictionary
        Set mHeaders = Me.ReadLine()
        m_HasHeader = True
        Set ReadHeader = mHeaders
    End Function

    ' ReadLine メソッド
    Public Function ReadLine() 'As Dictionary
        Do While (True)
            Dim stReadLine 'As String
            stReadLine = stReadLine & mTextStream.ReadLine()

            Dim cRow 'As Dictionary
            Set cRow = ReadLineInternal(stReadLine)

            Select Case mState
                Case EnumState.FindQuote, EnumState.InQuote
                    stReadLine = stReadLine & vbNewLine
                Case Else
                    Exit Do
            End Select
        Loop

        Set ReadLine = cRow
    End Function

    ' ReadToEnd メソッド
    Public Function ReadToEnd() 'As Dictionary
        Dim cTable 'As Dictionary
        Set cTable = WScript.CreateObject("Scripting.Dictionary")

        Dim stReadAll 'As String
        stReadAll = mTextStream.ReadAll()

        Dim stReadLines 'As String
        stReadLines = Split(stReadAll, vbNewLine)

        Dim stReadLine 'As String
        Dim i          'As Integer
        Dim iIndex     'As Integer

        For i = LBound(stReadLines) To UBound(stReadLines)
            stReadLine = stReadLine & stReadLines(i)

            Dim cRow 'As Dictionary
            Set cRow = ReadLineInternal(stReadLine)

            Select Case mState
                Case EnumState.FindQuote, EnumState.InQuote
                    stReadLine = stReadLine & vbNewLine
                Case Else
                    stReadLine = ""
                    iIndex = iIndex + 1
                    Call cTable.Add(iIndex, cRow)
            End Select
        Next

        Set ReadToEnd = cTable
    End Function

    ' 1 行読み込み
    Private Function ReadLineInternal(ByVal stBuffer) 'As Dictionary
        Dim cRow 'As Dictionary
        Set cRow = WScript.CreateObject("Scripting.Dictionary")

        mState = EnumState.Beginning

        Dim stItem 'As String
        Dim iIndex 'As Integer
        Dim iSeek  'As Integer

        For iSeek = 1 To Len(stBuffer)
            Dim chNext 'As String
            chNext = Mid(stBuffer, iSeek, 1)

            Select Case mState
                Case EnumState.Beginning
                    stItem = ReadForStateBeginning(stItem, chNext)
                Case EnumState.WaitInput
                    stItem = ReadForStateWaitInput(stItem, chNext)
                Case EnumState.FindQuote
                    stItem = ReadForStateFindQuote(stItem, chNext)
                Case EnumState.FindQuoteDouble
                    stItem = ReadForStateFindQuoteDouble(stItem, chNext)
                Case EnumState.InQuote
                    stItem = ReadForStateInQuote(stItem, chNext)
                Case EnumState.FindQuoteInQuote
                    stItem = ReadForStateFindQuoteInQuote(stItem, chNext)
            End Select

            Select Case mState
                Case EnumState.FindCrLf
                    mState = EnumState.Beginning
                    Exit For
                Case EnumState.FindComma
                    Call AddRowItem(stItem, cRow, iIndex)

                    mState = EnumState.Beginning
                    stItem = ""
                    iIndex = iIndex + 1
                Case EnumState.Error
                    If Not Me.IgnoreError Then
                        Call Err.Raise(5, "ReadLineInternal", "書式が不正です。")
                    End If

                    mState = EnumState.WaitInput
            End Select
        Next

        If mState = EnumState.FindQuoteDouble Then
            stItem = stItem & """"
        End If

        Call AddRowItem(stItem, cRow, iIndex)
        Set ReadLineInternal = cRow
    End Function

    ' 初回入力待ち状態での Read
    Private Function ReadForStateBeginning(ByVal stItem, ByVal chNext) 'As String
        Select Case chNext
            Case vbCr
                mState = EnumState.FindCr
            Case ","
                mState = EnumState.FindComma
            Case """"
                mState = EnumState.FindQuote
            Case Else
                mState = EnumState.WaitInput
                stItem = stItem & chNext
        End Select

        ReadForStateBeginning = stItem
    End Function

    ' 入力待ち状態での Read
    Private Function ReadForStateWaitInput(ByVal stItem, ByVal chNext) 'As String
        Select Case chNext
            Case vbCr
                mState = EnumState.FindCr
            Case ","
                mState = EnumState.FindComma
            Case """"
                mState = EnumState.FindQuote
            Case Else
                stItem = stItem & chNext
        End Select

        ReadForStateWaitInput = stItem
    End Function

    ' 引用符を発見した状態での Read
    Private Function ReadForStateFindQuote(ByVal stItem, ByVal chNext) 'As String
        Select Case chNext
            Case """"
                mState = EnumState.FindQuoteDouble
            Case Else
                mState = EnumState.InQuote
                stItem = stItem & chNext
        End Select

        ReadForStateFindQuote = stItem
    End Function

    ' 引用符の連続を発見した状態での Read
    Private Function ReadForStateFindQuoteDouble(ByVal stItem, ByVal chNext) 'As String
        Select Case chNext
            Case vbCr
                mState = EnumState.FindCr
                stItem = stItem & """"
            Case ","
                mState = EnumState.FindComma
                stItem = stItem & """"
            Case """"
                mState = EnumState.FindQuote
                stItem = stItem & """"
            Case Else
                mState = EnumState.WaitInput
                stItem = stItem & """" & chNext
        End Select

        ReadForStateFindQuoteDouble = stItem
    End Function

    ' 引用符の中で入力待ち状態での Read
    Private Function ReadForStateInQuote(ByVal stItem, ByVal chNext) 'As String
        Select Case chNext
            Case """"
                mState = EnumState.FindQuoteInQuote
            Case Else
                stItem = stItem & chNext
        End Select

        ReadForStateInQuote = stItem
    End Function

    ' 引用符の中で引用符を発見した状態での Read
    Private Function ReadForStateFindQuoteInQuote(ByVal stItem, ByVal chNext) 'As String
        Select Case chNext
            Case vbCr
                mState = EnumState.FindCr
            Case ","
                mState = EnumState.FindComma
            Case """"
                mState = EnumState.InQuote
                stItem = stItem & """"
            Case Else
                mState = EnumState.Error
        End Select

        ReadForStateFindQuoteInQuote = stItem
    End Function

    ' Row にアイテムを入れる
    Private Sub AddRowItem(ByVal stItem, ByVal cRow, ByVal iIndex)
        If Me.HasHeader Then
            Call cRow.Add(mHeaders(iIndex), stItem)
        Else
            Call cRow.Add(iIndex, stItem)
        End If
    End Sub

End Class

'/** EnumState 列挙体 */
Option Explicit

Class EnumStateConstants
    Private m_None             '読み込み開始前
    Private m_Beginning        '初期状態の入力待ち
    Private m_WaitInput        '入力待ち
    Private m_FindQuote        '引用符を発見
    Private m_FindQuoteDouble  '引用符の連続を発見
    Private m_InQuote          '引用符の中で入力待ち
    Private m_FindQuoteInQuote '引用符の中で引用符を発見
    Private m_FindComma        'カンマを発見
    Private m_FindCr           'Cr を発見
    Private m_FindCrLf         'CrLf を発見
    Private m_Error            'エラー発生

    Private Sub Class_Initialize()
        m_None             = 0
        m_Beginning        = 1
        m_WaitInput        = 2
        m_FindQuote        = 3
        m_FindQuoteDouble  = 4
        m_InQuote          = 5
        m_FindQuoteInQuote = 6
        m_FindComma        = 7
        m_FindCr           = 8
        m_FindCrLf         = 9
        m_Error            = 255
    End Sub

    ' None プロパティ - Getter
    Public Property Get None()
        None = m_None
    End Property

    ' Beginning プロパティ - Getter
    Public Property Get Beginning()
        Beginning = m_Beginning
    End Property

    ' WaitInput プロパティ - Getter
    Public Property Get WaitInput()
        WaitInput = m_WaitInput
    End Property

    ' FindQuote プロパティ - Getter
    Public Property Get FindQuote()
        FindQuote = m_FindQuote
    End Property

    ' FindQuote プロパティ - Getter
    Public Property Get FindQuoteDouble()
        FindQuoteDouble = m_FindQuoteDouble
    End Property

    ' InQuote プロパティ - Getter
    Public Property Get InQuote()
        InQuote = m_InQuote
    End Property

    ' FindQuoteInQuote プロパティ - Getter
    Public Property Get FindQuoteInQuote()
        FindQuoteInQuote = m_FindQuoteInQuote
    End Property

    ' FindComma プロパティ - Getter
    Public Property Get FindComma()
        FindComma = m_FindComma
    End Property

    ' FindCr プロパティ - Getter
    Public Property Get FindCr()
        FindCr = m_FindCr
    End Property

    ' FindCrLf プロパティ - Getter
    Public Property Get FindCrLf()
        FindCrLf = m_FindCrLf
    End Property

    ' Error プロパティ - Getter
    Public Property Get Error()
        Error = m_Error
    End Property

End Class

Private Sub MosaMosaAA()
    Dim cCsvReader 'As CsvReader
    Set cCsvReader = New CsvReader

    ' 指定した CSV ファイルを開く
    Call cCsvReader.OpenStream("C:\MakiMaki.csv")

    ' CSV ファイルの中身をすべて取得する
    Dim cTable 'As Dictionary
    Set cTable = cCsvReader.ReadToEnd()

    Dim stPrompt 'As String
    stPrompt = ""

    ' すべての中身 (Table) から 行 (Row) を列挙して取り出す
    Dim cRow 'As Dictionary
    For Each cRow In cTable.Items()
        Dim i 'As Integer

        ' 行から添え字を使って各 Item を文字列として結合する
        For i = 1 To cRow.Count
            stPrompt = stPrompt & CStr(cRow(i)) & vbTab
        Next

        stPrompt = stPrompt & vbNewLine
    Next

    ' 結合結果を出力する
    Call MsgBox(stPrompt)
End Sub

Private Sub MosaMosaAA()
    Dim cCsvReader 'As CsvReader
    Set cCsvReader = New CsvReader

    ' 指定した CSV ファイルを開く
    Call cCsvReader.OpenStream("C:\MakiMaki.csv")

    ' 最初の行をヘッダとして読み込む
    Call cCsvReader.ReadHeader()

    ' CSV ファイルの中身をすべて取得する
    Dim cTable 'As Dictionary
    Set cTable = cCsvReader.ReadToEnd()

    Dim stPrompt 'As String
    stPrompt = ""

    ' すべての中身 (Table) から 行 (Row) を列挙して取り出す
    Dim cRow 'As Dictionary
    For Each cRow In cTable.Items()
        ' 行からカラム名を使って各 Item を文字列として結合する
        stPrompt = stPrompt & CStr(cRow("社員番号")) & vbTab
        stPrompt = stPrompt & CStr(cRow("社員名")) & vbTab
        stPrompt = stPrompt & CStr(cRow("住所")) & vbTab
        stPrompt = stPrompt & CStr(cRow("電話番号")) & vbNewLine
    Next

    ' 結合結果を出力する
    Call MsgBox(stPrompt)
End Sub

コメント