◆ [VBScript] Delphi TIniFile風のINIファイル処理クラス
こんにチワワ。どーもボキです。

以前紹介したTIniFileクラスを、前回紹介したTListクラスを利用して、改良した。
(TIniFileクラスのソースは、記事の左下)

実行ソース
Set ini = New TIniFile

ini.Load(fpth) ' 読み込むINIファイルのフルパス

r = ini.ReadSections(slst)
' Functionのため、戻り値を受け取らないと正しく処理されない
' 戻り値を受け取らないのなら、ini.ReadSections slst と書く

For i = 0 To slst.Count -1
dprintf(slst(i))
r = ini.ReadSectionValues(slst(i), tlst)
For j = 0 To tlst.Count -1
dprintf(vbTAB & tlst(j))
Next
Next
a0021757_1517960.gif
IrfanViewのINIファイルを読み込ませたところ




' -----------------------------------------------------------------------
' Delphi TIniFile風 INIファイル処理クラス
Class TIniFile
Dim FobjFS,FPath,Lines,SecName,SecIndex,SecCount

' コンストラクタ
Private Sub Class_Initialize()
Set FobjFS = CreateObject("Scripting.FileSystemObject")
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(FPath, 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(FPath)
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(Lines(i)), LCase(sKey & "=")) = 0 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 InStr(LCase(SecName(i)),LCase(sSec)) = 0 Then Exit Do
getSecIndex = SecIndex(i)
Exit Function
Loop Until 1: Next
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 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

' iniファイルを開く
Public Function Load(FilePath)
Dim file, i

FPath = FilePath
Load = FobjFS.FileExists(FPath)
If Not Load Then Exit Function

' ファイル読み込み
Set file = FobjFS.OpenTextFile(FPath ,1)
Lines = Split(File.ReadAll,vbCRLF,-1,vbTextCompare)
file.Close

' セクション情報を格納
SecCount = 0
Redim SecName(0)
Redim SecIndex(0)
For i = 0 To UBound(Lines)
If (Left(Lines(i),1)="[") And (Right(Lines(i),1)="]") Then
Redim Preserve SecName( SecCount)
Redim Preserve SecIndex(SecCount)
SecName( SecCount) = Mid(Lines(i), 2, Len(Lines(i))-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
Redim Preserve Lines(UBound(Lines) -i)
End Function

' 指定セクション&キーを読み込む
Public Function Read(sSec, sKey, DefValue)
Dim idx

Read = DefValue
idx = getKeyIndex(sSec, sKey)
If idx <> -1 Then Read = Right(Lines(idx), Len(Lines(idx))-InStrRev(Lines(idx),"="))
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 InStr(s, "=") = 0 Then Exit Do ' キーでないものは無視

List.Add(Left(s, InStr(s,"=")-1))
Loop Until 1: Next
ReadSection = List.Count
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 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)
Dim i,idx,s,cnt

ReadSectionValues = 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 InStr(s, "=") = 0 Then Exit Do ' キーでないものは無視

List.Add(s)
Loop Until 1: Next
ReadSectionValues = List.Count
End Function

' 書き込み
Public Sub Write(sSec,sKey,Value)
Dim i, idx, file

If getSecIndex(sSec) = -1 Then
idx = UBound(Lines) ' ファイル末尾に追記
Lines(idx) = Lines(idx) & vbCRLF _
& "[" & sSec & "]" & vbCRLF _
& sKey &"="& Value
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

' iniファイル更新
Set file = FobjFS.OpenTextFile(FPath, 2, True)
For i = 0 To UBound(Lines): file.WriteLine Lines(i): Next
file.Close

Load(FPath)
End Sub
End Class


[PR]
by yozda | 2012-06-23 15:25 | プログラミング | Trackback | Comments(0)
トラックバックURL : http://yozda.exblog.jp/tb/15623421
トラックバックする(会員専用) [ヘルプ]
<< [Youtube] バーサーカ... [ソフト] 複数の画像ファイル... >>