UTF-8のテキストファイルを操作するクラス

UTF-8のテキストファイルを操作するクラス

作った。

何のために？

foobar2000のプレイリストファイルのドライブレター部分を一括して書き換えるために。

決して仕事のためではない。

だから、全然「働き方改革」とは関係ない。許せ。

UTF8TextFileクラスのコード

めんどくさいので、コードを一気に公開。

使ってみたい、という酔狂な方がいらっしゃいましたら、クラスモジュールを挿入して、オブジェクト名をUTF8TextFileにした上で、次のコードをコピペしてくださいまし。長いよ。

クラスモジュール UTF8TextFile

Option Explicit

'### Microsoft Active X Data Objects Library X.Xを参照設定 ###'
'### Microsoft Scripting Runtimeを参照設定                 ###'
'Module Level Variables'
Private adoObj As New ADODB.Stream
Private fsObj As New FileSystemObject

'Constants'
Private Const ERR_NUMBER_BASE As Long = 45000
Private Enum ErrorCode
  ecIndexOutOfBound = 1
  ecFileNotExists
  ecUnknown = 10
End Enum

'Field Variables'
Private lines_() As String
Private fullName_ As String

'Constructor'
Private Sub Class_Initialize()
  '行番号に合わせるため、配列は1始まり'
  ReDim lines_(1 To 1)
  lines_(1) = ""
End Sub

'Properties'
Public Property Let FullName(ByVal argValue As String)
  Const ERR_SRC As String = _
        "UTF8TextFile Class, Property Let FullName"
  If Not fsObj.FileExists(argValue) Then _
    Call raiseError(ecFileNotExists, ERR_SRC)
  fullName_ = argValue
End Property
Public Property Get FullName() As String
  FullName = fullName_
End Property

Public Property Get Path() As String
  Const ERR_SRC As String = _
        "UTF8TextFile Class, Property Get Path"
  Dim ret As String
  ret = ""
  If Not fsObj.FileExists(fullName_) Then GoTo Finalizer
  Dim arr() As String
  arr = Split(fullName_, "\")         '"
  Dim i As Long
  For i = LBound(arr) To UBound(arr) - 1
    ret = ret & arr(i) & "\"         '"
  Next
  ret = Left(ret, Len(ret) - 1)
Finalizer:
  Path = ret
End Property

Public Property Let Lines(ByVal lineNum As Long, _
                          ByVal lineText As String)
  Const ERR_SRC As String = _
        "UTF8TextFile Class, Property Get Lines"
  '引数チェック'
  If lineNum < LBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  If lineNum > UBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  'ファイル存否確認'
  If Not fsObj.FileExists(fullName_) Then _
    Call raiseError(ecFileNotExists, ERR_SRC)
  '行の書き換え'
  lines_(lineNum) = lineText
  'ファイルに書き込む'
  Call setLines(fullName_)
End Property
Public Property Get Lines(ByVal lineNum As Long) As String
  Const ERR_SRC As String = _
        "UTF8TextFile Class, Property Get Lines"
  Dim ret As String
  ret = ""
  '引数チェック'
  If lineNum < LBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  If lineNum > UBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  ret = lines_(lineNum)
Finalizer:
  Lines = ret
  Exit Property
ErrorHandler:
  Call raiseError(ecUnknown, ERR_SRC)
End Property

Public Property Get LinesCount() As Long
  Const ERR_SRC As String = _
        "UTF8TextFile Class, Property Get LinesCount"
  On Error GoTo ErrorHandler
  LinesCount = UBound(lines_)
  Exit Property
ErrorHandler:
  Call raiseError(ecUnknown, ERR_SRC)
End Property

'Methods'
'テキストファイルの各行のデータを配列にセット'
Public Sub getLines(Optional ByVal targetFilePath As String)
  Const ERR_SRC As String = _
        "UTF8TextFile Class, getLines Method"
  If targetFilePath <> "" Then fullName_ = targetFilePath
  If Not fsObj.FileExists(fullName_) Then _
    Call raiseError(ecFileNotExists, ERR_SRC)
  On Error GoTo ErrorHandler
  With adoObj
    .Charset = "UTF-8"
    Call .Open
    Call .LoadFromFile(fullName_)
    Dim n As Long
    n = 1
    Do Until .EOS
      ReDim Preserve lines_(1 To n)
      lines_(n) = .ReadText(adReadLine)
      n = n + 1
    Loop
    Call .Close
  End With
  Exit Sub
ErrorHandler:
  Call adoObj.Close
  Call raiseError(ecUnknown, ERR_SRC)
End Sub

'配列に格納したデータをUTF-8テキストファイルに書き込んで保存'
Private Sub setLines(Optional ByVal targetFilePath As String)
  Const ERR_SRC As String = _
        "UTF8TextFile Class, setLines Method"
  On Error GoTo ErrorHandler
  If targetFilePath <> "" Then fullName_ = targetFilePath
  With adoObj
    .Charset = "UTF-8"
    Call .Open
    Dim i As Long
    For i = LBound(lines_) To UBound(lines_)
      Call .WriteText(lines_(i), adWriteLine)
    Next
    Call .SaveToFile(fullName_, adSaveCreateOverWrite)
    Call .Close
  End With
  Exit Sub
ErrorHandler:
  Call adoObj.Close
  Call raiseError(ecUnknown, ERR_SRC)
End Sub

'行を追加'
Public Sub appendLine(ByVal targetText As String, _
             Optional ByVal targetFilePath As String)
  Const ERR_SRC As String = _
        "UTF8TextFile Class, appendLine Method"
  If targetFilePath <> "" Then fullName_ = targetFilePath
  Dim n As Long
  n = UBound(lines_) + 1
  ReDim Preserve lines_(1 To n)
  lines_(n) = targetText
  'ファイルに書き込む'
  Call setLines(fullName_)
End Sub

'テキストを追加'
Public Sub appendText(ByVal targetText As String, _
             Optional ByVal targetFilePath As String)
  Const ERR_SRC As String = _
        "UTF8TextFile Class, appendText Method"
  If targetFilePath <> "" Then fullName_ = targetFilePath
  Dim n As Long
  n = UBound(lines_)
  lines_(n) = lines_(n) & targetText
  'ファイルに書き込む'
  Call setLines(fullName_)
End Sub

'行を書き換え'
Public Sub replaceLine(ByVal targetLine As Long, _
                       ByVal replaceText As String, _
              Optional ByVal targetFilePath As String)
  Const ERR_SRC As String = _
        "UTF8TextFile Class, replaceLine Method"
  '存在しない行ならエラー'
  If targetLine < LBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  If targetLine > UBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  'ファイル名が指定されていたらセット'
  If targetFilePath <> "" Then fullName_ = targetFilePath
  '行の書き換え'
  lines_(targetLine) = replaceText
  'ファイルに書き込む'
  Call setLines(fullName_)
End Sub

'行の挿入'
Public Sub insertLine(ByVal targetLine As Long, _
                      ByVal targetText As String, _
             Optional ByVal targetFilePath As String)
  Const ERR_SRC As String = _
        "UTF8TextFile Class, insertLine Method"
  '存在しない行ならエラー'
  If targetLine < LBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  If targetLine > UBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  'ファイル名が指定されていたらセット'
  If targetFilePath <> "" Then fullName_ = targetFilePath
  '行の挿入'
  '配列の拡張'
  Dim n As Long
  n = UBound(lines_) + 1
  ReDim Preserve lines_(1 To n)
  '配列の要素を挿入地点まで一つづつ後ろへずらす'
  Dim i As Long
  For i = UBound(lines_) To targetLine + 1 Step -1
    lines_(i) = lines_(i - 1)
  Next
  '挿入する地点に新しいテキストを追加'
  lines_(targetLine) = targetText
  'ファイルに書き込む'
  Call setLines(fullName_)
End Sub

'行の削除'
Public Sub deleteLine(ByVal targetLine As Long, _
             Optional ByVal targetFilePath As String)
  Const ERR_SRC As String = _
        "UTF8TextFile Class, deleteLine Method"
  '存在しない行ならエラー'
  If targetLine < LBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  If targetLine > UBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  'ファイル名が指定されていたらセット'
  If targetFilePath <> "" Then fullName_ = targetFilePath
  '行の削除'
  '配列の要素を一つづつ詰めていく'
  Dim i As Long
  Dim n As Long
  n = UBound(lines_) - 1
  For i = targetLine To n
    lines_(i) = lines_(i + 1)
  Next
  '配列の縮小'
  ReDim Preserve lines_(1 To n)
  'ファイルに書き込む'
  Call setLines(fullName_)
End Sub

'行のテキストの置換'
Public Sub replaceText(ByVal targetLine As Long, _
                       ByVal FindString As String, _
                       ByVal ReplaceString As String, _
              Optional ByVal targetFilePath As String)
  Const ERR_SRC As String = _
        "UTF8TextFile Class, replaceText Method"
  '存在しない行ならエラー'
  If targetLine < LBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  If targetLine > UBound(lines_) Then _
    Call raiseError(ecIndexOutOfBound, ERR_SRC)
  'ファイル名が指定されていたらセット'
  If targetFilePath <> "" Then fullName_ = targetFilePath
  '行のテキストの置換'
  lines_(targetLine) = Replace(lines_(targetLine), _
                               FindString, _
                               ReplaceString)
  'ファイルに書き込む'
  Call setLines(fullName_)
End Sub

Public Sub replaceLines(ByVal findStr As String, _
                       ByVal replaceStr As String, _
              Optional ByVal targetFilePath As String)
  'ファイル名が指定されていたらセット'
  If targetFilePath <> "" Then fullName_ = targetFilePath
  '全ての行について置換を実行'
  Dim i As Long
  For i = LBound(lines_) To UBound(lines_)
    lines_(i) = Replace(lines_(i), findStr, replaceStr)
  Next
  'ファイルに書き込む'
  Call setLines(fullName_)
End Sub

'エラー発生用'
Private Sub raiseError(ByVal errCode As ErrorCode, _
                       ByVal errSource As String)
  Dim msg As String
  Select Case errCode
    Case ecIndexOutOfBound
      msg = "Index is out of bound..."
    Case ecFileNotExists
      msg = "File is not found..."
    Case ecUnknown
      msg = "Some error has occurred..."
  End Select
  msg = msg & vbCrLf & errSource
  Call Err.Raise(Number:=ERR_NUMBER_BASE + errCode, _
                 Source:=errSource, _
                 Description:=msg)
End Sub

長いなーーー。

まあ、エラー対応とかも作り込んでしまったから、しょうがない。許してちょんまげ。

メソッドとかプロパティを列挙するのはめんどくさいので、

オブジェクト ブラウザーの画像でどうぞ。

何か、プロが作ったクラスっぽくないっすか？

使ってみる

さて、本来の目的は、そう、

Foobar2000のプレイリストファイルのドライブレター書き換え

であった。

初期状態が

コチラ。楽曲ファイルのあるドライブがOドライブになっている。

これを、Fドライブに変えてみせようホトトギス。

リスト１　標準モジュール

Private Sub testUTF8TextFileClass()
  Const SAMPLE_FILE As String = _
        "X:\個人用\はてなブログ用\PlayListEditor\NowPlaying"
  Dim txtFile As UTF8TextFile    '……(1)'
  Set txtFile = New UTF8TextFile
  Call txtFile.getLines(SAMPLE_FILE & ".m3u8")  '……(2)'
  Call txtFile.replaceLines("O:\Music", _
                            "F:\Music", _
                            SAMPLE_FILE & "_.m3u8")  '……(3)'
End Sub

(1)の

Dim txtFile As UTF8TextFile
Set txtFile = New UTF8TextFile

で、わがUTF8TextFileクラスのインスタンスを作る。

(2)の

Call txtFile.getLines(SAMPLE_FILE & ".m3u8")

で、getLinesメソッドを実行し、PlayListEditorフォルダにあるNowPlaying.m3u8というファイルを読み込む。

あとは、(3)の

Call txtFile.replaceLines("O:\Music", _
                          "F:\Music", _
                          SAMPLE_FILE & "_.m3u8")

でreplaceLinesメソッドを実行。第１引数に"O:\Music"、第２引数に"F:\Music"を渡しているので、ファイル内のOドライブの記述をFドライブに改めることになる。

また、第３引数で渡すファイルパスでは、拡張子の前に「_」（アンダースコア）を追加しているので、置換後、別のファイル名（すなわち、NowPlaying_.m3u8）で保存されることになる。

実行結果

リスト１を実行すると、

新しいファイルNowPlaying_.m3u8が出来ていて、中身は

このとおり。文字化けもなく、無事に置換できている。

おわりに

さて、このUTF8TextFileクラス、他に使いどころはあるかのう……？