TextFileクラスは今……

TextFileクラスは今……

f:id:akashi_keirin:20190910075348j:plain

akashi-keirin.hatenablog.com

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

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

おわりに

動作確認が不十分でまだまだ意図どおりに動かないところがあると思う。

なんか、泥沼になってきたような予感……。