programming-examples/asp/FilesMaths/INITool Object.asp

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