TextFileクラスは今……

f:id:akashi_keirin:20190910075348j:plain

akashi-keirin.hatenablog.com

テキストファイルを扱うことがあって、久しぶりに引っ張り出してみたら、いろいろと不具合が見えてきたので、修正した。

TextFileクラスの現在の姿

かつてのTextFileクラスは、空のテキストファイルを渡すとエラーが出る、という初歩的過ぎるバグがあったので、修正するとともに、末尾に新たな行を追加するappendLineメソッドと、末尾にテキストを追加するappendTextメソッドを追加した。

また、それに伴って実装済みのメソッドについても名称を見直した。

コードを全掲載する。

クラスモジュール　TextFile

Option Explicit

'Constants'
Private Enum ErrorTypes
  etFileNotFound = 1
  etLineNotExists
  etNotInitialized
  etErrorOccurred
End Enum

'Module Level Variables'
Private isInitialized As Boolean
Private fileFullName As String
Private line_() As String
Private fsObj As FileSystemObject

'Properties'
Public Property Get Line(ByVal numberOf As Long) As String
'///引数numberOf行目の文字列を返す'
  Const ERR_SOURCE As String = _
          "TextFile Class, Property Get Line"
  'initメソッド未実行ならエラー。'
  If Not isInitialized Then _
    Call raiseError(etNotInitialized, ERR_SOURCE)
  Dim ret As String
  '存在しない行番号を指定していたらエラー。'
  If UBound(line_) + 1 < numberOf Or _
     numberOf < 0 Then _
    Call raiseError(etLineNotExists, ERR_SOURCE)
  On Error GoTo ErrorHandler
  ret = line_(numberOf - 1)
  Line = ret
  Exit Property
ErrorHandler:
  '何かしらエラーが出たら、イミディエイトに情報を表示して中断。'
  Debug.Print "Number : " & Err.Number
  Debug.Print "Description : " & Err.Description
  Call raiseError(etErrorOccurred, ERR_SOURCE)
End Property

Public Property Get LineCount() As Long
'///テキストファイルの行数を返す'
  Const ERR_SOURCE As String = _
          "TextFile Class, Property Get LineCount"
  'initメソッド未実行ならエラー。'
  If Not isInitialized Then _
    Call raiseError(etNotInitialized, ERR_SOURCE)
  On Error GoTo ErrorHandler
  Dim ret As Long
  'line_()が空またはline_(0)が空ならば、0を返す。'
  If IsEmpty(line_) Or _
     line_(0) = "" Then ret = 0: GoTo Finalizer
  ret = UBound(line_) + 1
Finalizer:
  LineCount = ret
  Exit Property
ErrorHandler:
  Debug.Print "Number : " & Err.Number
  Debug.Print "Description : " & Err.Description
  Call raiseError(etErrorOccurred, ERR_SOURCE)
End Property

'Constructor'
Private Sub Class_Initialize()
  isInitialized = False
  Set fsObj = New FileSystemObject
End Sub

Public Sub init(ByVal targetFullName As String)
  Const ERR_SOURCE As String = _
          "TextFile class,init Method"
  '対象ファイルの存否確認。なければエラー。'
  If Not fsObj.FileExists(targetFullName) Then _
    Call raiseError(etFileNotFound, "TextFile Class, init Method")
  On Error GoTo ErrorHandler
  'モジュールレベル変数に対象ファイルのフルパスを保存'
  fileFullName = targetFullName
  'テキストファイルから各行のデータを取得して配列にぶち込む'
  line_ = getLines(targetFullName)
  isInitialized = True
  Exit Sub
ErrorHandler:
  Debug.Print "Number : " & Err.Number
  Debug.Print "Description : " & Err.Description
  Call raiseError(etErrorOccurred, ERR_SOURCE)
End Sub
'テキストファイル読み込み'
Private Function getLines( _
             ByVal targetFullName As String) As String()
  Const ERR_SOURCE As String = _
          "TextFile class, getLines Method"
  On Error GoTo ErrorHandler
  Dim ret() As String
  Dim n As Long
  n = 0
  ReDim ret(n)
  Dim txtStream As Scripting.TextStream
  Set txtStream = fsObj.OpenTextFile( _
                          Filename:=targetFullName, _
                          IOMode:=ForReading, _
                          Create:=False)
  '空のテキストファイルだったらループ突入しない'
  Do While Not txtStream.AtEndOfLine
    ret(n) = txtStream.ReadLine
    '最終行まで読み込んだらExit'
    If txtStream.AtEndOfLine Then Exit Do
    n = n + 1
    ReDim Preserve ret(n)
  Loop
  Call txtStream.Close
  Set txtStream = Nothing
  line_ = ret
  getLines = line_
  Exit Function
ErrorHandler:
  Debug.Print "Number : " & Err.Number
  Debug.Print "Description : " & Err.Description
  Call raiseError(etErrorOccurred, ERR_SOURCE)
End Function

'Destructor'
Private Sub Class_Terminate()
  Set fsObj = Nothing
End Sub

'Methods'
Public Sub regetLines(Optional ByVal targetFullName As String)
  Const ERR_SOURCE As String = _
          "TextFile Class, regetLines Method"
  'initメソッド未実行ならエラー。'
  If Not isInitialized Then _
    Call raiseError(etNotInitialized, ERR_SOURCE)
  If targetFullName = "" Then GoTo MainProcess
  If Not fsObj.FileExists(targetFullName) Then _
    Call raiseError(etFileNotFound, ERR_SOURCE)
  '新たにファイルフルパスが渡されたら、それを新しいファイルフルパスにする'
  fileFullName = targetFullName
MainProcess:
  On Error GoTo ErrorHandler
  Erase line_
  Call Me.init(fileFullName)
  Exit Sub
ErrorHandler:
  Debug.Print "Number : " & Err.Number
  Debug.Print "Description : " & Err.Description
  Call raiseError(etErrorOccurred, ERR_SOURCE)
End Sub

'データ書き換え'
Public Sub replaceLine(ByVal targetLine As Long, _
                       ByVal targetData As String)
  Const ERR_SOURCE As String = _
          "TextFile Class, replaceLine Method"
  'initメソッド未実行ならエラー。'
  If Not isInitialized Then _
    Call raiseError(etNotInitialized, ERR_SOURCE)
  Dim ret As String
  '存在しない行番号を指定していたらエラー。'
  If targetLine < 1 Or _
     UBound(line_) + 1 < targetLine Then _
    Call raiseError(etLineNotExists, ERR_SOURCE)
  On Error GoTo ErrorHandler
  'メインの処理'
  line_(targetLine - 1) = targetData
  Dim txtStream As Scripting.TextStream
  Set txtStream = fsObj.OpenTextFile( _
                          Filename:=fileFullName, _
                          IOMode:=ForWriting, _
                          Create:=False)
  Dim i As Long
  For i = 0 To UBound(line_)
    Call txtStream.WriteLine(line_(i))
  Next
  Call txtStream.Close
  Set txtStream = Nothing
  Exit Sub
ErrorHandler:
  Debug.Print "Number : " & Err.Number
  Debug.Print "Description : " & Err.Description
  Call raiseError(etErrorOccurred, ERR_SOURCE)
End Sub

Public Sub appendLine(ByVal targetText As String)
  Dim n As Long
  If IsEmpty(line_) Or _
     line_(0) = "" Then
    n = 0
  Else
    n = UBound(line_) + 1
  End If
  ReDim Preserve line_(n)
  line_(n) = targetText
  'テキストファイル書き込み'
  Dim txtStream As Scripting.TextStream
  Set txtStream = fsObj.OpenTextFile( _
                          Filename:=fileFullName, _
                          IOMode:=ForWriting)
  Dim i As Long
  For i = LBound(line_) To UBound(line_)
    With txtStream
      Call .WriteLine(line_(i))
    End With
  Next
  Call txtStream.Close
  Set txtStream = Nothing
End Sub

Public Sub appendText(ByVal targetText As String)
  Dim txtStream As TextStream
  Set txtStream = fsObj.OpenTextFile( _
                          Filename:=fileFullName, _
                          IOMode:=ForAppending)
  Call txtStream.Write(targetText)
  Call txtStream.Close
  Dim n As Long
  n = 0
  ReDim line_(n)
  Set txtStream = fsObj.OpenTextFile( _
                          Filename:=fileFullName, _
                          IOMode:=ForReading)
  Do While Not txtStream.AtEndOfLine
    line_(n) = txtStream.ReadLine
    If txtStream.AtEndOfLine Then Exit Do
    n = n + 1
    ReDim Preserve line_(n)
  Loop
  Call txtStream.Close
End Sub

'エラー発生用'
Private Sub raiseError(ByVal typeOfError As ErrorTypes, _
              Optional ByVal errorSource As String)
  Dim msg As String
  msg = getErrorMessage(typeOfError)
  Call Err.Raise(Number:=10000 + typeOfError, _
                 Source:=errorSource, _
                 Description:=msg)
End Sub

Private Function getErrorMessage( _
          ByVal typeOfError As ErrorTypes) As String
  Const ERR_SOURCE As String = _
          "TextFile class, getErrorMessage Method"
  On Error GoTo ErrorHandler
  Dim ret As String
  Select Case typeOfError
    Case etFileNotFound
      ret = "The file you specified isn't found."
    Case etLineNotExists
      ret = "This file doesn't have so many lines."
    Case etNotInitialized
      ret = "You must run ""init"" method!"
    Case etErrorOccurred
      ret = "Some Error has occurred"
  End Select
  getErrorMessage = ret
  Exit Function
ErrorHandler:
  Debug.Print "Number : " & Err.Number
  Debug.Print "Description : " & Err.Description
  Call raiseError(etErrorOccurred, ERR_SOURCE)
End Function

相変わらずのタテ長ですまぬ。