[VBScript] TIniFileクラス：iniファイルの処理をカンタンに

どーもボキです。

ini処理ができれば、設定ファイル処理の2/3はできたも当然。TIniFileクラスならその2/3がカンタンに！

Windows APIには、iniファイル読み書き関数（GetPrivateProfileString、WritePrivateProfileString）が用意されているものの、
VBSではこれらのAPIを利用できない（正確には、ひと手間かければWindows APIなどのDLLも利用できる、だが）。

そのため、VBSでもiniファイルをカンタンに処理できるようにとTIniFileクラスを用意した。
以前公開していたものを改良し、WriteValue/Write後のファイル保存にも対応させた。

ちなみに、残りの1/3はレジストリ。これは別途記載する。

サンプルプログラムのダウンロードと使い方

• ダウンロード
  
• 使い方は、実行する、だけ。

TIniFileクラスの使い方

以下のサンプルで、TIniFileクラスの基本的な使い方が分かると思う。
DelphiのTIniFileクラスに合わせて開発したので、Delphi経験者ならすんなりと理解できるハズ。
なお、DelphiにはDeleteSectionはない（DeleteKeyはあり）、この関数はVBS版オリジナル。

TListクラスを利用し、iniファイルのセクションごとのループ処理もカンタン。

Execute CreateObject("Scripting.FileSystemObject").OpenTextFile(Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\")) & "vbCommon.vbs").ReadAll()
'─────────────────────────────────────────────────────────────────────────────
SetScriptHost("cscript")

Dim fpth
fpth = ChangeFileExt(WScript.ScriptFullName, ".ini")

Dim ini
Set ini = New TIniFile

' iniファイルを読み込み
dprintf "Load" & vbTab & ini.Load(fpth)   ' 指定ファイルを読み込み

' Keyをループさせ、Sectionを作成
Dim i,j,s,sec,key
For i = 0 To 9
    For j = 0 To 9
        sec = "sec_" & j
        key = "key_" & i
        ini.WriteValue sec, key, j*10 +i
    Next
Next

' iniファイルを保存
dprintf "Save" & vbTab & ini.Save(fpth)   ' 指定ファイルに保存

Dim slst: Set slst = New TList
Dim tlst: Set tlst = New TList

' セクション名リストを取得
ini.ReadSections(slst)

For i = 0 To slst.Count -1
    ' セクション内の全キーを取得
    j = ini.ReadSection(slst(i), tlst)
    
    s = slst(i)
    sec = s
    For j = 0 To tlst.Count -1
        key = tlst(j)
        s = s & vbTAB & ini.ReadValue(sec, key, "-")    ' 指定セクション・キーを読み込む
    Next
    
    dprintf s
Next

' 指定セクションを削除する
For i = slst.Count -1 To slst.Count/2 Step -1
    dprintf "DeleteSection(sec_" & i & ")" & vbTab & ini.DeleteSection("sec_" & i)
Next

' 指定キーを削除する
For i = 0 To slst.Count -1: Do
    If Not ini.SectionExists("sec_" & i) Then Exit Do ' セクションの有無をチェックする
    
    ' セクション内の全キーを取得
    j = ini.ReadSection(slst(i), tlst)
    
    sec = slst(i)
    For j = tlst.Count -1 To tlst.Count/2 Step -1
        key = tlst(j)
        ini.DeleteKey sec, key  ' 指定キーを削除する
    Next
Loop Until 1: Next

For i = 0 To 9
    sec = "sec_" & i
    s = sec
    For j = 0 To 9
        key = "key_" & j
        s = s & vbTAB & ini.ReadValue(sec, key, "-")    ' 指定セクション・キーを読み込む
    Next
    
    dprintf s
Next

この記事での気付き

Microsoftは設定情報の記録は、INIファイルでなく、XMLやレジストリへの記載を推奨している。
しかし、ボキの手の届く範囲の業務インフラは、いまだにINIファイルが利用され続けている。


それは、設定情報をテキストエディタで確認・修正しやすい、からだろう。


実際にボキ自身、XMLを使ったことはない。
それは、上記のようにいまだINIファイル主体のため、XMLを含む他の新技術へ移行させるメリットがなかったからだ。


ただし、新技術を知らないままでいること、それは良いとは言えない。
外的要因、たとえばWindows更新により、いつレガシー技術が使えなくなる日がくるか分からないからだ。


あえてレガシー技術を使い続ける場合、新技術への移行に向けた準備を進めておくことが重要だ。
INIファイルならば、運用効率の良いセクションとキー構造定義技術を身に付ける・命名ルールを作成しておく。


そうしておけば、構造化記述に長けたXMLへはスンナリ移行できる。
これにより、レガシー技術を使いつづけつつ、いつでも新技術へ移行する準備ができている状態となる。

2020/5/10掲載記事の更新

にほんブログ村

今回開発したプログラムソース

' -------------------------------------------------------------------------------
' Delphi TIniFile風 iniファイル処理クラス
' -------------------------------------------------------------------------------
Class TIniFile
    Dim FobjFS,FFilePath,Lines,SecName,SecIndex,SecCount
    
    ' iniファイルを読み込む（※OpenはExcelマクロで定義できないため、Loadを用意する）
    Public Function Open(FilePath): Open=Load(FilePath): End Function
    Public Function Load(FilePath)
        Dim file, i, s
        
        FFilePath = FilePath
        Load = FobjFS.FileExists(FFilePath)
        If Load Then
            ' ファイル読み込み
            On Error Resume Next
            Set file = FobjFS.OpenTextFile(FFilePath ,1)
            Lines = Split(File.ReadAll,vbCRLF,-1,vbTextCompare)
            file.Close
            If Err.Number <> 0 Then Redim Lines(0)  ' 空ファイル対応
            On Error Goto 0
        Else
            Redim Lines(0)
        End If
        
        ' セクション情報を格納
        SecCount = 0
        Redim SecName(0)
        Redim SecIndex(0)
        For i = 0 To UBound(Lines)
            s = Lines(i)
            If (Left(s,1)="[") And (InStr(s,"]") > 3) Then
                Redim Preserve SecName( SecCount)
                Redim Preserve SecIndex(SecCount)
                SecName( SecCount) = Mid(s, 2, InStr(s,"]")-2)
                SecIndex(SecCount) = i
                SecCount = SecCount +1
            End If
        Next
        
        ' 末尾のムダ改行を削除
        For i = 0 To UBound(Lines)
            If Lines(UBound(Lines) -i) <> "" Then Exit For
        Next
        If UBound(Lines) > 0 Then Redim Preserve Lines(UBound(Lines) -i)
    End Function
    
    ' 指定セクション＆キーを読み込む（※WriteはExcelマクロで定義できないため、ReadValue/WriteValueとする）
    Public Function Read(sSec,sKey,DefValue): Read=ReadValue(sSec, sKey, DefValue): End Function
    Public Function ReadValue(sSec, sKey, DefValue)
        Dim r,idx
        
        idx = getKeyIndex(sSec, sKey)
        If idx = -1 Then
            r = DefValue
        Else
            r =  Right(Lines(idx), Len(Lines(idx))-InStr(Lines(idx),"="))
        End If
        ReadValue = r
    End Function
    
    ' 指定セクション＆キーを書き込む（※WriteはExcelマクロで定義できないため、ReadValue/WriteValueとする）
    Public Sub Write(sSec,sKey,Value): WriteValue sSec, sKey, Value: End Sub
    Public Sub WriteValue(sSec,sKey,Value)
        Dim s, idx
        
        If getSecIndex(sSec) = -1 Then
            s = "[" & sSec & "]"  & vbCRLF & sKey &"="& Value
            idx = UBound(Lines)            ' ファイル末尾に追記
            If idx <= 0 Then
                Redim Lines(0)  ' 空ファイル対応
                Lines(0) = s
            Else
                Lines(idx) = Lines(idx) & vbCRLF & s
            End If
        Else
            idx = getKeyIndex(sSec, sKey)
            If idx <> -1 Then
                Lines(idx) = sKey &"="& Value ' 書き換え
            Else
                idx = getNextIndex(sSec)
                If UBound(Lines) <> idx Then idx = idx -1
                If Lines(idx) = "" Then idx = idx -1
                Lines(idx) = Lines(idx) & vbCRLF _
                    & sKey &"="& Value    ' セクション末尾に追記
            End If
        End If
        
        ' ファイル更新
        updateFile
    End Sub
    
    ' 指定ファイルに保存する
    Public Function Save(FilePath)
        Dim i, file
        
        On Error Resume Next
        
        Set file = FobjFS.OpenTextFile(FilePath, 2, True)
        For i = 0 To UBound(Lines)
            file.WriteLine Lines(i)
        Next
        file.Close
        Save = (Err = 0)
        
        On Error Goto 0
    End Function
    
    ' 指定セクションを削除する
    Public Function DeleteSection(sSec)
        Dim i,idx,idx1
        
        DeleteSection = False
        idx = getSecIndex(sSec): If idx = -1 Then Exit Function
        
        idx1 = getNextIndex(sSec)
        If idx1 <> UBound(Lines) Then idx1 = idx1 -1
        DeleteSection = deleteIndex(idx, idx1)
    End Function
    
    ' 指定キーを削除する
    Public Function DeleteKey(sSec, sKey)
        Dim i,idx
        
        DeleteKey = False
        idx = getKeyIndex(sSec, sKey): If idx = -1 Then Exit Function
        
        DeleteKey = deleteIndex(idx, idx)
    End Function
    
    ' すべてのセクションを読み込む
    Public Function ReadSections(List)
        Dim i
        
        If VarType(List) <> vbObject Then Set List = New TList
        List.Clear
        For i = 0 To SecCount -1: List.Add(SecName(i)): Next
        ReadSections = List.Count
    End Function
    
    ' 指定セクションの全てのキーを読み込む
    Public Function ReadSection(sSec, List)
        Dim i,idx,s,cnt
        
        ReadSection = 0
        idx = getSecIndex(sSec): If idx < 0 Then Exit Function
        
        If VarType(List) <> vbObject Then Set List = New TList
        List.Clear
        For i = idx+1 To getNextIndex(sSec): Do
            s = Lines(i)
            If Left(s,1) = ";" Then Exit Do
            If InStr(s, "=") = 0 Then Exit Do ' キーでないものは無視
            
            List.Add(Left(s, InStr(s,"=")-1))
        Loop Until 1: Next
        ReadSection = List.Count
    End Function
    
    ' 指定セクションが存在するか調べる
    Public Function SectionExists(sSec)
        SectionExists = getSecIndex(sSec) <> -1
    End Function
    
    ' 指定キー毎 読み込む
    Public Function ReadLine(sSec,sKey)
        Dim idx, s
        
        idx = getKeyIndex(sSec, sKey)
        If idx = -1 Then s = sKey &"キーは存在しない" Else s = Lines(idx)
        ReadLine = s
    End Function
    
    ' 指定セクションのKey=Value形式をすべて込みこむ
    Public Function ReadSectionValues(sSec, List)
        ReadSectionValues = readSecItems(sSec, List, True)
    End Function
    
    ' 指定セクションのすべての値を込みこむ
    Public Function ReadSectionItems(sSec, List)
        ReadSectionItems = readSecItems(sSec, List, False)
    End Function
    ' -------------------------------------------------------------------
    ' コンストラクタ
    Private Sub Class_Initialize()
        Set FobjFS = CreateObject("Scripting.FileSystemObject")
        Redim Lines(0)
    End Sub
    
    ' デストラクタ
    Private Sub Class_Terminate()
        Set FobjFS = Nothing
    End Sub
    
    ' 指定インデックスの情報を削除する
    Private Function deleteIndex(Index0, Index1)
        Dim i, file
        
        deleteIndex = False
        If Index0 > Index1 Then Exit Function
        
        Set file = FobjFS.OpenTextFile(FFilePath, 2, True)
        For i = 0 To Index0 -1: file.WriteLine Lines(i): Next
        For i = Index1+1 To UBound(Lines): file.WriteLine Lines(i): Next
        file.Close
        
        deleteIndex = Load(FFilePath)
    End Function
    
    ' 指定セクション＆キーの行インデックスを取得する
    Private Function getKeyIndex(sSec, sKey)
        Dim i,idx
        
        getKeyIndex = -1
        idx = getSecIndex(sSec): If idx < 0 Then Exit Function
        
        For i = idx +1 To getNextIndex(sSec): Do
            If InStr(LCase(Replace(Lines(i),vbTab,"")), LCase(sKey & "=")) <> 1 Then Exit Do
            
            getKeyIndex = i
            Exit Function
        Loop Until 1: Next
    End Function
    
    ' 指定セクションの次のセクションの行インデックスを返す
    Private Function getNextIndex(sSec)
        Dim i
        
        getNextIndex = UBound(Lines)
        For i = 0 To SecCount -1: Do
            If LCase(sSec) <> LCase(SecName(i)) Then Exit Do
            
            If i < SecCount -1 Then getNextIndex = SecIndex(i+1)
            Exit Function
        Loop Until 1: Next
    End Function
    
    ' 指定セクションの行インデックスを取得する
    Private Function getSecIndex(sSec)
        Dim i
        
        getSecIndex = -1
        For i = 0 To SecCount -1: Do
            If LCase(SecName(i)) <> LCase(sSec) Then Exit Do
            
            getSecIndex = SecIndex(i)
            Exit Function
        Loop Until 1: Next
    End Function
    
    ' 指定セクションの値をすべて込みこむ（Key=Value形式)
    Private Function readSecItems(sSec, List, bKeyOnly)
        Dim i,idx0,idx1,s,cnt
        
        If VarType(List) <> vbObject Then Set List = New TList
        List.Clear
        
        readSecItems = 0
        idx0 = getSecIndex(sSec): If idx0 < 0 Then Exit Function
        
        idx0 = idx0 +1
        idx1 = getNextIndex(sSec)
        If idx1 < UBound(Lines) Then idx1 = idx1 -1   ' 次のセクションが存在する
        
        For i = idx0 To idx1: Do
            s = Lines(i)
            If bKeyOnly Then
                If InStr(s, "=") = 0 Then Exit Do ' キーでないものは無視
                If InStr(s, ";") = 1 Then Exit Do ' コメント行は無視
            End If
            
            List.Add(s)
        Loop Until 1: Next
        readSecItems = List.Count
    End Function
    
    ' ファイル更新
    Private Function updateFile
        Dim r, b_tmp, fpth
        
        fpth = FFilePath
        b_tmp = (fpth = "")
        If b_tmp Then fpth = FobjFS.GetTempName
        
        r = Save(fpth)
        If r Then r = Load(fpth)
        
        If b_tmp Then
            FobjFS.DeleteFile fpth
            FFilePath = ""
        End If
        
        updateFile = r
    End Function
End Class