INITool

INITool Object allows an ASP programmer to work with INI files on the server.
You must call the Load() method before calling any other methods of the class.

Usage:
> 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
%>

fPath
Or
header, key, defaultvalue
OR
header, key, newvalue
Or
header, key
Or
header
Or

Views 183 Downloads 101

'Settings', 'Ini', 'IniFile', 'File', 'keyvalue pair', 'key-value', 'NotMyWork', 'NotTested', 'NeedsTesting'

ANmarAmdeen
313
File System Classic ASP
Revisions

v1.0