INITool Object

INITool Object

--------------------------------------------------------------------------------

Description : The INITool Object allows an ASP programmer to work with INI files
on the server.

Properties
================
No exposed properties.

Methods
================
You must call the Load() method before calling any other methods of the
class.

object.Save()

saves any changes made to the INI file after the last call to the Load()
method. Overwrites an existing INI file or creates a new INI file if the
file doesn't exist.

object.Clear()

purges the internal hash table of header/key/value combinations. If the
Save() method is called, this will clear the ini file and replace it with
0 bytes of data (will not delete the file). The internal hash table contains
no valid data after the Clear() method is called. You must call Load() to
repopulate the hashtable after calling Clear() if you wish to continue
working with INI files...

object.Remove(header, key)

removes a key/value combination from a specified header in the internal
hash table. If save() is called, this key/value combination will be removed
from the specified header in the INI file.

object.Write(header, key, value)

creates a new header/key/value combination or updates the value of an
already existing header/key/value combination. If the header doesn't already
exist, it is added to the internal hash table along with an attached key and
value. If the header already exists but the key doesn't, the key is created
under the already existing header. If the header/key combination already
exists and has a value, the value is reset with the newly entered value.
Changes to the actual INI file do not take effect until you call the Save()
method.

variant = object.Read(header, key, defaultvalue)

reads the value of a specified key in the specified header. If the header
or key doesn't exist, defaultvalue is returned. Otherwise the value of key
is returned.

object.DumpHashTable()

remnants of debugging. prints the contents of the internal hashtable at
that particular moment. all existing and newly created header/key/value
pairs are stored in this hash table after the load() method is called.
Calling the Read(), Write(), Remove() and Clear() methods affects the
internal hash table only and not the actual INI file. The actual INI file
is not over-written until the save() method is called. The internal hash
table is cleared only when either the clear() or load() methods are called
or when the INITool class is created or set to nothing.

object.Load(absolutepath)

loads an INI file's header/key/value combinations into an internal hash table
so the data can be more easily worked with by the class. If the INI file
specified in absolutepath doesn't exist, the internal hash table representing
the INI file's contents will be empty. You can add to the loaded INI file with
the Write() method. You commit to changes or create a new INI file by calling
the Save() method. Load() must be called before any other methods of the class.

array = object.Headers()

returns an array containing all header names in the INI file specified
in the Load() argument. Use the VBScript inherent function IsArray to
test the return value to see if it contains any valid data.

array = object.Keys(header)

returns an array containing all key names under the header specified in the
header argument in the INI file specified in the Load Argument. Use the
VBScript inherent function IsArray to test the return value to see if it
contains any valid data.

<%
Class INITool
Private dHeaders 'Scripting.Dictionary
Private fso 'Scripting.FileSystemObject
Private gblPath

Private Sub Class_Initialize
Set dHeaders = CreateObject("Scripting.Dictionary")
dHeaders.RemoveAll
End Sub

Private Sub Class_Terminate
dHeaders.RemoveAll
Set dHeaders = Nothing
End Sub

Public Sub Load(ByVal fPath)
'load file into dictionary by header
Dim f, s, key, value, dKeysVals, lastHeader

dHeaders.RemoveAll
gblPath = fPath
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.fileexists(fPath) Then
Set f = fso.OpenTextFile(fPath, 1, False)
While Not f.atendofstream
s = Trim(f.readline)
If Not Left(s, 1) = ";" Then
If Left(s, 1) = "[" And Right(s, 1) = "]" Then
lastHeader = Mid(s, 2, Len(s) - 2)
If Not dHeaders.Exists(s) Then
dHeaders.Add UCase(lastHeader), lastHeader
End If
Else
If Len(Trim(s)) > 0 Then
key = Left(s, InStr(s, "=") - 1)
value = Right(s, Len(s) - InStr(s, "="))
If Not dHeaders.Exists(UCase(lastHeader) & _
"~" & UCase(key)) Then
dHeaders.Add UCase(lastHeader) & _
"~" & UCase(key), value
End If
End If
End If
End If
Wend
f.Close
Set f = Nothing
End If
Set fso = Nothing
End Sub

Public Sub DumpHashTable
Dim Item

Response.Write("<PRE>")
For Each Item In dHeaders.Keys
Response.Write( Item & vbCrLf )
Response.Write( dHeaders.Item(Item) & vbCrLf & vbCrLf )
Next
Response.Write("</PRE>")
End Sub

Public Function Read(ByVal header, ByVal key, ByVal defaultvalue)
Dim s

s = ""
If dHeaders.Exists(UCase(header) & "~" & UCase(key)) Then
s = dHeaders.Item(UCase(header) & "~" & UCase(key))
End If
If s = "" Then s = defaultvalue
Read = s
End Function

Public Function Write(ByVal header, ByVal key, ByVal newvalue)
If Not dHeaders.Exists(UCase(header)) Then
'create header
dHeaders.Add UCase(header), header
End If
If dHeaders.Exists(UCase(header) & "~" & UCase(key)) Then
'update value of key
dHeaders.Item(UCase(header) & "~" & UCase(key)) = newvalue
Else
'add key/value combo
dHeaders.Add UCase(header) & "~" & UCase(key), newvalue
End If
End Function

Public Sub Remove(ByVal header, ByVal key)
If dHeaders.Exists(UCase(header) & "~" & UCase(key)) Then
dHeaders.Remove UCase(header) & "~" & UCase(key)
End If
End Sub

Public Function Headers()
Dim Item, s

For Each Item In dHeaders.Keys
If UCase(Item) = UCase(dHeaders.Item(Item)) Then
s = s & dHeaders.Item(Item) & "~"
End If
Next
If Len(s) > 0 Then s = Left(s, Len(s) - 1)
If InStr(s, "~") Then
Headers = Split(s, "~")
Else
Headers = ""
End If
End Function

Public Function Keys(ByVal header)
Dim item, s, re, tmp

Set re = New RegExp
re.ignorecase = True
re.pattern = "^" & header & "~"
For Each Item In dHeaders.Keys
If re.test(Item) Then
tmp = Mid(Item, InStr(Item, "~") + 1)
If Trim(tmp) <> "" Then
s = s & tmp & "~"
End If
End If
Next
Set re = Nothing
If Len(s) > 0 Then s = Left(s, Len(s) - 1)
If InStr(s, "~") Then
Keys = Split(s, "~")
Else
Keys = ""
End If
End Function

Public Sub Clear
dHeaders.RemoveAll
End Sub

Public Sub Save()
Dim Item, oRs, header, key, value, last, f

Set oRs = CreateObject("ADODB.Recordset")
oRs.Fields.Append "Header", 200, 100 ' 100 char limit on headers
oRs.Fields.Append "Key", 200, 65 ' 65 char limit on keys
oRs.Fields.Append "Value", 200, 255 ' 255 char limit on value
oRs.Open
For Each Item In dHeaders.Keys
If Item <> dHeaders.Item(Item) Then
If InStr(Item, "~") > 0 Then
header = Left(Item, InStr(Item, "~") - 1)
key = Mid(Item, InStr(Item, "~") + 1)
value = dHeaders.Item(Item)
oRs.AddNew
oRs.Fields("Header").Value = header
oRs.Fields("Key").Value = key
oRs.Fields("Value").Value = value
oRs.Update
End If
End If
Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile(gblPath, 2, True)
If Not oRs.BOF Then
oRs.Sort = "Header asc, Key asc"
oRs.MoveFirst

While Not oRS.EOF
If last <> oRs.Fields("Header").Value Then
f.WriteLine "[" & oRs.Fields("Header").Value & "]"
last = oRs.Fields("Header").Value
End If
f.WriteLine oRs.Fields("Key").Value & "=" & _
oRs.Fields("Value").Value
oRs.MoveNext
Wend
Else
f.write ""
End If
f.Close
Set f = Nothing
Set fso = Nothing
oRs.Close
Set oRs = Nothing
End Sub
End Class
%>
--------------------------------------------------------------------------------