Chris at DwarfSoft posted a very interesting chunk of code that defines a class for handling INI data structures. His rationale for doing this, in lieu of using the Word.Application PrivateProfileString object is good. It’s not a finished class, but it’s very good and I’ve added a few small tweaks to use on a project I’ve been working on.
' Adapted from post by Chris at DwarfSoft (link below)...
' http://www.dwarfsoft.com/blog/2009/02/27/ini-file-handler-for-vbscript/
'
' changes:
' added a GetKeys function to the class
' added a GetSections function to the class
Class IniFile
Private mIniFile
'
'----------------------- Sub Load ----------------------------
Public Sub Load(Filename)
LoadIni FileName,False
End Sub
'-------------------- Sub LoadIni ----------------------------
Public Sub LoadIni(Filename,JustDefaults)
Dim objFSO, objDictionary, objSubDictionary, file
Dim ini, arr, line, splitline, tmpsplit
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = mIniFile
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objSubDictionary = Nothing
Set mIniFile = objDictionary
If JustDefaults Then
Read = False
Else
Read = True
End If
If objFSO.FileExists(Filename) Then
Set file = objFSO.OpenTextFile(Filename)
ini = file.ReadAll()
file.Close
arr = Split(ini,vbCrLf)
For Each line in arr
If line = "##STARTDEFAULT" Then
Read = True
End If
If Read Then
If Left(Trim(Line),1) = "[" And Right(Trim(Line),1) = "]" Then
line = replace(replace(line,"[",""),"]","")
If Not IsEmpty(objDictionary.Item(line)) Then
Set objSubDictionary = objDictionary.Item(line)
Else
Set objSubDictionary = CreateObject("Scripting.Dictionary")
'objDictionary.Add line, objSubDictionary
Set objDictionary.Item(line) = objSubDictionary
End If
Else
If TypeName(objSubDictionary) = "Nothing" or _
IsEmpty(objSubDictionary) Then
Set objSubDictionary = CreateObject("Scripting.Dictionary")
objDictionary.Add "[]",objSubDictionary
Set objDictionary.Item("[]") = objSubDictionary
End If
If Left(Trim(line),1) = "#" Then
objSubDictionary.Item( "[" & _
objSubDictionary.Count & "]") = Trim(line)
Else
splitline = split(Trim(line),"=")
If TypeName(splitline) <> "Nothing" Then
If UBound(splitline) = 1 Then
tmpsplit = split(splitline(1), "#")
' Resolve a= error
If UBound(tmpsplit) >= 0 Then
objSubDictionary.Item(Trim(splitline(0))) = Trim(tmpsplit(0))
Else
objSubDictionary.Item(Trim(splitline(0))) = ""
End If
Else
'Error
End If
End If
End If
End If
If line = "##ENDDEFAULT" And JustDefaults Then
MsgBox "End Default"
Read = False
Exit Sub
End If
End If
Next
Else
Exit Sub
End If
End Sub
'----------------------- Function GetValue ----------------------------
Public Function GetValue(Section, Value)
Set objDictionary = mIniFile
If IsSection(Section) Then
Set objSubDictionary = objDictionary.Item(Section)
If IsEmpty(objSubDictionary.Item(Value)) Then
objSubDictionary.Remove(Value)
Else
GetValue = objSubDictionary.Item(Value)
End If
End If
End Function
'----------------------- Function IsSection ---------------------------
Public Function IsSection(Section)
Set objDictionary = mIniFile
If IsEmpty(objDictionary.Item(Section)) Then
objDictionary.Remove(Section)
IsSection = False
Else
IsSection = True
End If
End Function
'----------------------- Function GetSections ------------------------
Public Function GetSections()
Dim retval, item
Set objDictionary = mIniFile
If TypeName(objDictionary) <> "Nothing" Then
If Not IsEmpty(objDictionary.Keys) Then
For Each Key in objDictionary.Keys
If Key = "[]" Then
ElseIf Key = "" Then
Else
If retval <> "" Then
retval = retval & vbTab & Key
Else
retval = Key
End If
End If
Next
End If
End If
GetSections = retval
End Function
'---------------------- Function GetKeys -----------------------------
Public Function GetKeys(Section)
Dim retval : retval = ""
Set objDictionary = mIniFile
If IsSection(Section) Then
Set objSubDictionary = objDictionary.Item(Section)
For each Key in objSubDictionary.Keys
If retval <> "" Then
retval = retval & vbTab & Key
Else
retval = Key
End If
Next
End If
GetKeys = retval
End Function
'----------------------- Function IsSection ---------------------------
Public Function Save(FileName)
Set objDictionary = mIniFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set Outfile = objFSO.CreateTextFile(FileName)
If TypeName(objDictionary) <> "Nothing" Then
If Not IsEmpty(objDictionary.Keys) Then
For Each Key in objDictionary.Keys
If Key = "[]" Then
ElseIf Key = "" Then
Else
Outfile.WriteLine("[" & Key & "]")
End If
Set objSubDictionary = Nothing
If Not IsEmpty(objDictionary.Item(Key)) Then
Set objSubDictionary = objDictionary.Item(Key)
End If
If TypeName(objSubDictionary) <> "Nothing" Then
If Not IsEmpty(objSubDictionary.Keys) Then
For Each subKey in objSubDictionary.Keys
If Left(subKey,1) = "[" Then
OutFile.WriteLine(objSubDictionary.Item(subKey))
Else
OutFile.WriteLine(subKey & "=" & _
objSubDictionary.Item(subKey))
End If
Next
End If
End If
OutFile.WriteLine
Next
End If
End If
End Function
'--------------------- Function AddNextNumeric ------------------------
Public Function AddNextNumeric(Section,Value)
Set objDictionary = mIniFile
If IsEmpty(objDictionary.Item(Section)) Then
Set objSubDictionary = CreateObject("Scripting.Dictionary")
Set objDictionary.Item(Section) = objSubDictionary
objSubDictionary.Item("1") = Value
AddNextNumeric = 1
Else
Set objSubDictionary = objDictionary.Item(Section)
Number = 1
Do While IsEmpty(objSubDictionary.Item("" & Number))
Number = Number + 1
Loop
objSubDictionary.Item("" & Number) = Value
AddNextNumeric = Number
End If
End Function
'--------------------------- CONSTRUCTOR ------------------------------
Private Sub Class_Initialize
' Class Constructor
' Initialization goes here
Set mIniFile = Nothing
End Sub
'---------------------------- DESTRUCTOR ------------------------------
Private Sub Class_Terminate
' Class Destructor
Set mIniFile = Nothing
End Sub
End Class
That defines the class and class members. Now let's put it to work. Use use any standard INI file with sections identified within square brackets [ ] and keys with associated values beneath each section (KEYNAME=VALUE). Here's a basic example...
[SECTION_A]
Key1=ABC
Key2=DEF
[SECTION_B]
1=Red
2=Yellow
3=Green
And to put this contraption to work, here's a few tests to run it with...
Set ifile = New IniFile
ifile.Load("ini_file_test.ini")
v = ifile.GetValue("SECTION_A","CellMake")
Wscript.Echo "Value: " & v & vbCRLF
section = "SECTION_B"
keys = ifile.GetKeys(section)
For each key in Split(keys, vbTab)
v = ifile.GetValue(section, key)
Wscript.Echo section & "," & key & " = " & v
Next
Wscript.Echo
section = "SECTION_C"
keys = ifile.GetKeys(section)
Wscript.Echo section & " --> " & Replace(keys, vbTab, ",")
Wscript.Echo
Wscript.Echo "Sections..."
For each s in Split(ifile.GetSections(), vbTab)
Wscript.Echo s
Next
The rest of the class functions that need to be added are pretty common. Things like updating section names, key names, values, and saving back to the file (which is there already). This has actually renewed my interest in working with classes (I hate saying "Object Oriented" for some reason). If I drink enough coffee I might even get motivated to do something.
No comments:
Post a Comment