<% 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("

")
        For Each Item In dHeaders.Keys
            Response.Write( Item & vbCrLf )
            Response.Write( dHeaders.Item(Item) & vbCrLf & vbCrLf )
        Next
        Response.Write("

") 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 %>