人気ブログランキング |

[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ファイルのセクションごとのループ処理もカンタン。
[VBScript] TIniFileクラス:iniファイルの処理をカンタンに_a0021757_10415197.png
    [VBScript] TIniFileクラス:iniファイルの処理をカンタンに_a0021757_10060117.png
    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掲載記事の更新
にほんブログ村 IT技術ブログへ
にほんブログ村



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

    ' -------------------------------------------------------------------------------
    ' 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

by yozda | 2021-01-05 09:43 | プログラミング | Comments(0)
<< [まとめ] 専用アプリ導入すら... [VBScript] TLis... >>