Logo Foltyn Presentation
Table of Contents Previous Page Next Page
Content-Symbol-Img
Ein Programm in der Programmiersprache A program in the programming language
vbScript
zum Lesen und Schreiben von Daten in INI-Dateien for reading and writing of data in INI-files


the content of an INI-file is this, for example:

   [GroupName1]
   Parameter1=3
   Parameter2=77
   Parameter3=asdf
   [GroupName2]
   Parameter1=17

 Parameter1=3
Parameter2=77
Parameter3=asdf
Parameter4=17

In INI-Dateien sind alle programm-relevanten Daten und Einstellungen in Form von Klartext gespeichert. Das Programm besorgt das Laden und Sichern dieser Daten, das Suchen benötigter Daten aus dem INI-Datei-Text und das Hineinschreiben an der richtigen Stelle, wobei die Reihenfolge keine Rolle spielen soll. Bei der Verwendung benötigter Parameter stellt das Programm automatisch fest, ob es schon von der Festplatte in das RAM geladen wurde, erzeugt im Speicher eine Kopie, welche benützt wird und am Ende dann auf die Festplatte zurück gespeichert wird.

Wenn noch keine INI-Datei vorhanden ist, erzeugt das Programm eine INI-Datei mit Anfangswerten. Da der Nutzer die INI-Datei von ausserhalb des Programms verändern kann, ist eine Fehlerkorrektur eingebaut, die die INI-Datei von unnötigen Leerzeichen usw säubert und fehlerhafte Eintragungen entfernt. Dann wird festgestellt, ob die INI-Datei alle nötigen Kriterien erfüllt, die ein richtiges Funktionieren erlauben, ansonsten wird eine neue INI-Datei erzeugt mit Defaultwerten als Eintragungen.

Weiters soll die INI-Datei im selben Verzeichnis sein wie die Programm-Datei und den gleichen Namen haben wie die Programm-Datei. Dazu ist eine automatische Erkennung eingebaut, sodaß man den Programm-Namen beliebig verändern kann und das Programm in ein beliebig anderes verschieben kann.

Die Darstellung zeigt u.a., wieviel Programm notwendig ist und welche komplizierten Algorithmen, allein für die Behandlung einer INI-Datei, ungeachtet des Umstandes, dass ein wesentlicher Teil des Programms ist nur für die Demonstration, wie es funktioniert.

In INI-files there are stored all program-relevant data and settlings in form of clear-text. The program cares for loading and saving of this data, the search of needy data out of the INI-file-text and the writing-in at the right place, whereby the sequence shall not play any role. By the use of the needed parameters the program determines automaticly, wether it is already loaded from hard-disk into the memory, generates in the memory a copy, which is hence used and at the end all is stored back on hard-disk.

If there is no INI-file extant yet, the program generates an INI-file with start-values. Because the user can change the INI-file from outside of the program, there is built-in an error-correction, which cleans the INI-file from unneeded empty-characters etc. and faulty enrollments. Then it is determined, wether the INI-file fulfils all criteria, which allow a correct functioning, otherwise a new INI-File is created with default-values as enrollments.

Furthermore the INI-File should be in the same folder as the program-file und have the same name as the program. For this there is built-in an automatic recognition, so that one can change the program-name arbitrarily und move the program in another, arbitrary folder.

The depiction shows, among others, how much program is necessary and which complicated algorithms, alone for the treatment of an INI-file, let alone the circumstance, that an essential part of the program is only for demonstration how it works.

Das Programm ist getestet vor der Publikation, aber es kann keine Garantie gegeben werden, dass es fehlerfrei ist
The program ist tested before publication, but there can be given no guarantee, that it is free of errors
22. Aug. 2012 Aug 22nd 2012

' Exchange Data with INI-Files

Option Explicit

' Declaration of Constant, Variables and Objects

' necessary for demonstration-program only
Public Title ' Strings
Dim Version ' numeric

' necessary for INI-procedures-package
Const ForReading = 1, ForWriting = 2 ' Constants
Public INIArray, INIdefaultArray ' Arrays
ReDim INIArray(-1), INIdefaultArray(-1) ' Arrays
Public INIFileSpec, TmpText ' Strings
Dim CurrentDirectory, FulName, FileName, IniText, ErrMsg ' Strings
Dim Value, INIfileOnDisk ' numeric
Dim fso, f, WshShell ' Objects
Dim INI, GUM ' Classes

' Instantiations of Objects and Classes
Set fso = CreateObject("Scripting.FileSystemObject") ' Objects
Set WshShell = CreateObject("WScript.Shell")
Set INI = New INIfileProcedurePackage ' Classes
Set GUM = New GenerallyUsedModules

' Assignments of program parameters

' necessary for demonstration-program only
Title = Split("After Reading from INI-Array,Result after Writing",",")

' necessary for INI-procedures-package
CurrentDirectory = WshShell.CurrentDirectory & "\"
FulName = WScript.ScriptName
FileName = Left(FulName,InStrRev(FulName,".")-1)
INIFileSpec = CurrentDirectory & FileName & ".INI"

' Program for demonstration of the functions

' the groupname must be right or if no groupname it must be "",
' otherwise an error is indicated or it should create a new INI-file

With INI
    For Version = 0 To 1
        If Version = 0 Then ' without Groupnames
            For INIfileOnDisk = 0 To 1
                If INIfileOnDisk = 0 Then
                    If fso.FileExists(INIFileSpec) Then fso.DeleteFile(INIFileSpec)
                    ReDim INIArray(-1)
                End If

                ReadOut ' INIdefaultArray
                ReadIn "Parameter1=3,Parameter2=4,Parameter3=asdf"
                ReadIn "Parameter4=17"
                INIdefaultArray = ReadOut

                ErrMsg = .PutGetValueInINIArray(ForReading, "", "Parameter1", Value)
                MsgBox Msg(ErrMsg,Version,INIfileOnDisk,"","Parameter1",Value),,Title(0)
                ErrMsg = .PutGetValueInINIArray(ForWriting, "", "Parameter1", "55")
                ErrMsg = .PutGetValueInINIArray(ForReading, "", "Parameter1", Value)
                MsgBox Msg(ErrMsg,Version,INIfileOnDisk,"","Parameter1",Value),,Title(0)
                GUM.ReadWriteListFile ForWriting, INIArray, INIFileSpec

                GUM.ReadWriteListFile ForReading, INIArray, INIFileSpec
                MsgBox Msg(ErrMsg,Version,INIfileOnDisk,"[GroupName1]","Parameter1",Value) & _
                vbCrLf & vbCrLf & Replace("GroupList-Content:" & vbCrLf & _
                Join(INIArray,vbCrLf),vbTab,","),,Title(0)
            Next
        Else ' with Groupnames
            For INIfileOnDisk = 0 To 1
                If INIfileOnDisk = 0 Then
                    If fso.FileExists(INIFileSpec) Then fso.DeleteFile(INIFileSpec)
                    ReDim INIArray(-1)
                End If

                ReadOut ' INIdefaultArray
                ReadIn "[GroupName1],Parameter1=3,Parameter2=4,Parameter3=asdf"
                ReadIn "[GroupName2],Parameter1=17,Parameter1=11"
                INIdefaultArray = ReadOut

                ErrMsg = .PutGetValueInINIArray(ForReading, "[GroupName1]", "Parameter2", Value)
                MsgBox Msg(ErrMsg,Version,INIfileOnDisk,"[GroupName1]","Parameter2",Value),,Title(0)
                ErrMsg = .PutGetValueInINIArray(ForWriting, "[GroupName1]", "Parameter2", "77")
                ErrMsg = .PutGetValueInINIArray(ForReading, "[GroupName1]", "Parameter2", Value)
                MsgBox Msg(ErrMsg,Version,INIfileOnDisk,"[GroupName1]","Parameter2",Value),,Title(0)
                GUM.ReadWriteListFile ForWriting, INIArray, INIFileSpec

                GUM.ReadWriteListFile ForReading, INIArray, INIFileSpec
                MsgBox Msg(ErrMsg,Version,INIfileOnDisk,"[GroupName1]","Parameter2",Value) & _
                vbCrLf & vbCrLf & Replace("GroupList-Content:" & vbCrLf & _
                Join(INIArray,vbCrLf),vbTab,","),,Title(1)
            Next
        End If
    Next
End With: MsgBox "Procedure done"

' End of Program

' Procedures for demonstration-program

' Input-Output-Routines

'       For in script assigned values

Function ReadIn(ByVal AnyText)
    If TmpText <> "" Then TmpText = TmpText & ","
    TmpText = TmpText & AnyText
End Function

Function ReadOut
    ReadOut = Split(TmpText,","): TmpText = ""
End Function

'       For Display on screen

Function Msg(ErrMsg,Version,INIfileOnDisk,GroupName,Parameter,Value)
    Msg = "Version: " & CStr(Version) & vbCrLf _
    & "INIfileOnDisk: " & CStr(INIfileOnDisk) & vbCrLf & _
    vbCrLf & "in Group: """ & GroupName & """,    Parameter: """ & Parameter & ""
    If ErrMsg = "" Then
        Msg = Msg & """,    Value: """ & Value & """"
    ElseIf ErrMsg = "wrong direction" Then
        Msg = ""
    Else
    End If: Msg = ErrMsg & vbCrLf & Msg
End Function

' End of Procedures

Class INIfileProcedurePackage
    Function PutGetValueInINIarray(Direction, AnyGroupName, AnyParameter, ByRef AnyValue)
        Dim ErrMsg: ErrMsg = ""
        If UBound(INIArray) = -1 Then
            If fso.FileExists (INIFileSpec) Then
                GUM.ReadWriteListFile ForReading, INIArray, INIFileSpec
            Else
                GUM.ReadWriteListFile ForWriting, INIdefaultArray, INIFileSpec
                INIArray = GUM.CopyArray(INIdefaultArray)
                MsgBox "New INI-File created"
            End If
            If CheckContent(INIdefaultArray, INIArray) = False Then
                GUM.ReadWriteListFile ForWriting, ConvertToNormalFormat(INIdefaultArray), INIFileSpec
            End If
        End If
        If ErrMsg = "" Then
            ErrMsg = PutGetValueInAnyArray(Direction, INIArray, AnyGroupName, AnyParameter, AnyValue)
        End If: PutGetValueInINIarray = ErrMsg
    End Function

    Function PutGetValueInAnyArray(Direction, ByRef AnyGroupArray, _
        AnyGroupName, AnyParameter, ByRef AnyValue)
        Dim i, j, OneGroupList, aTmp, ParameterName, Value, ErrorMsg
        ErrorMsg = "Wrong code for direction"
        If Direction = ForReading Or Direction = ForWriting Then
            ErrorMsg = "no item found"
            If UBound (AnyGroupArray) > -1 Then
                For i = 0 To UBound(AnyGroupArray)
                    OneGroupList = Split(AnyGroupArray(i),vbTab)
                    If UCase(OneGroupList(0)) = UCase(AnyGroupName) Then
                        For j = 1 To UBound(OneGroupList)
                            aTmp = Split(OneGroupList(j),"=")
                            ParameterName = aTmp(0): Value = aTmp(1)
                            If UCase(ParameterName) = UCase(AnyParameter) Then
                                ErrorMsg = ""
                                If Direction = ForReading Then
                                    AnyValue = Value
                                ElseIf Direction = ForWriting Then
                                    OneGroupList(j) = ParameterName & "=" & AnyValue
                                End If
                            End If: If ErrorMsg = "" Then Exit For
                        Next: AnyGroupArray(i) = Join(OneGroupList,vbTab)
                        If ErrorMsg = "" Then Exit For
                    End If
                Next
            End If
        End If: PutGetValueInAnyArray = ErrorMsg
    End Function

    Function CheckContent(ByRef AnyArray1, ByRef AnyArray2)
        ' Input in Normal-Format, Output in GroupList-Format
        Dim AnyList, ListNr, OK : OK = False
        Dim GroupList ' GroupList is another format of INIArray
        If IsArray(AnyArray1) And IsArray(AnyArray2) Then
            If UBound(AnyArray1) > -1 And UBound(AnyArray2) > -1 Then
                AnyList = GUM.CopyArray(AnyArray1)
                For ListNr = 1 To 2 ' Check AnyArray1 and AnyArray2
                    If UBound(AnyList) > -1 Then
                        AnyList = CleanArray(AnyList)
                        GroupList = ConvertToGroupListFormat(AnyList)
                        GroupList = RemoveEmptyGroups(GroupList)
                        GroupList = UniteSameNameGroups(GroupList)
                        GroupList = RemoveEqualParametersInSameGroup(GroupList)
                    End If: If ListNr = 2 Then Exit For
                    AnyArray1 = GUM.CopyArray(GroupList)
                    AnyList = GUM.CopyArray(AnyArray2)
                Next: AnyArray2 = GUM.CopyArray(GroupList)
            End If: If UBound(AnyArray1) > -1 And UBound(AnyArray2) > -1 Then OK = True
            If OK Then OK = CompareGroupLists(AnyArray1, AnyArray2)
        End If: CheckContent = OK
    End Function

    Function CleanArray(AnyList)
        ' Input and Output in Normal-Format
        Dim ListPos
        For ListPos = 0 To UBound(AnyList) ' eliminate faulty enrollments
            LINETYPE AnyList(ListPos) ' GROUP- and Parameter- Detect and Clean
        Next
        CleanArray = GUM.RemoveEmptyLines(AnyList)
    End Function

    Function RemoveEmptyGroups(AnyGroupList)
        ' If GroupName and nothing consecutive
        Dim ListPos
        If UBound(AnyGroupList) > -1 Then
            For ListPos = 0 To UBound(AnyGroupList)
                If UBound(Split(AnyGroupList(ListPos),vbTab)) = 0 Then
                    AnyGroupList(ListPos) = ""
                End If
            Next
        End If: RemoveEmptyGroups = GUM.RemoveEmptyLines(AnyGroupList)
    End Function

    Function UniteSameNameGroups(AnyGroupList)
        Dim i, j, k, aTmp1, aTmp2, Line1, Line2
        If UBound(AnyGroupList) > -1 Then
            For i = 0 To UBound(AnyGroupList) - 1: Line1 = AnyGroupList(i)
                If Line1 <> "" And InStr(Line1,vbTab) > 0 Then
                    For j = i + 1 To UBound(AnyGroupList): Line2 = AnyGroupList(j)
                        If Line2 <> "" And InStr(Line2,vbTab) > 0 Then
                            aTmp1 = Split(Line1,vbTab): aTmp2 = Split(Line2,vbTab)
                            If aTmp1(0) = aTmp2(0) Then
                                For k = 1 To UBound(aTmp2)
                                    Line1 = Line1 & vbTab & aTmp2(k)
                                Next: AnyGroupList(j) = ""
                                AnyGroupList(i) = Line1
                            End If
                        End If
                    Next
                End If
            Next
        End If: UniteSameNameGroups = GUM.RemoveEmptyLines(AnyGroupList)
    End Function

    Function RemoveEqualParametersInSameGroup(AnyGroupList)
        Dim i, j, k, Line, OneGroupList, ParamName1, ParamName2
        For i = 0 To UBound(AnyGroupList) ' Eliminate equal Parameters in same group
            Line = AnyGroupList(i): OneGroupList = Split(Line,vbTab)
            For j = 1 To UBound(OneGroupList) - 1 ' Eliminate multiple equal Parameters
                If OneGroupList(j) <> "" Then
                    ParamName1 = UCase(Split(OneGroupList(j),"=")(0))
                    For k = j + 1 To UBound(OneGroupList)
                        If OneGroupList(k) <> "" Then
                            ParamName2 = UCase(Split(OneGroupList(k),"=")(0))
                            If ParamName1 = ParamName2 Then OneGroupList(k) = ""
                        End If
                    Next
                End If
            Next: Line = Join(OneGroupList,vbTab)
            While InStr(Line, vbTab & vbTab)
                Line = Replace(Line, vbTab & vbTab, vbTab)
            Wend: If Right(Line,1) = vbTab Then Line = Left(Line,Len(Line) - 1)
            AnyGroupList(i) = Line: OneGroupList = GUM.RemoveEmptyLines(OneGroupList)
        Next: RemoveEqualParametersInSameGroup = GUM.RemoveEmptyLines(AnyGroupList)
    End Function

    Function CompareGroupLists(AnyGroupList1, AnyGroupList2)
        Dim GroupList1, GroupList2, Passage, OneGroupList, GroupName, ParamName
        Dim i, j, ErrMsg, OK: OK = False
        If UBound(AnyGroupList1) > -1 And UBound(AnyGroupList2) > -1 Then
            GroupList1 = GUM.CopyArray(AnyGroupList1)
            GroupList2 = GUM.CopyArray(AnyGroupList2)
            For Passage = 1 To 2
                For i = 0 To UBound(GroupList1)
                    OneGroupList = Split(GroupList1(i),",")
                    GroupName = OneGroupList(0)
                    For j = 1 To UBound(OneGroupList): OK = False
                        ParamName = Split(OneGroupList(j),"=")(0)
                        ErrMsg = PutGetValueInAnyArray(ForReading, _
                        GroupList2, GroupName, ParamName, "")
                        If ErrMsg = "" Then OK = True
                    Next: If Not(OK) Then Exit For
                Next: If Not(OK) Or Passage = 2 Then Exit For
                GroupList1 = GUM.CopyArray(AnyGroupList2)
                GroupList2 = GUM.CopyArray(AnyGroupList1)
            Next
        End If: CompareGroupLists = OK
    End Function

    ' Line-Type-Detect

    Function LINETYPE(ByRef AnyString)
        Dim GroupDetected, ParamDetected, sTmp: sTmp = AnyString
        GroupDetected = GROUP(sTmp): ParamDetected = PARAM(sTmp)
        If Not(GroupDetected) And Not(ParamDetected) Then
            LINETYPE = "": AnyString = ""
        ElseIf GroupDetected Then
            LINETYPE = "GROUP": AnyString = sTmp
        ElseIf ParamDetected Then
            LINETYPE = "PARAM": AnyString = sTmp
        End If
    End Function

    Function GROUP(ByRef AnyString) ' Detect if line is a group
        ' needs module GUM.CharInSubset
        Dim sTmp: sTmp = Trim(AnyString): GROUP = False
        If Len(sTmp) >= 2 Then
            If Left(sTmp,1) = "[" And Right(sTmp,1) <> "]" Then
                sTmp = sTmp & "]"
            ElseIf Right(sTmp,1) = "]" And Left(sTmp,1) <> "[" Then
                sTmp =  "[" & sTmp
            End If
            If Left(sTmp,1) = "[" And Right(sTmp,1) = "]" Then
                sTmp = Trim(Mid(sTmp,2,Len(sTmp)-2)) ' within square brackets
                If sTmp <> "" Then GROUP = GUM.CharInSubset("A-Z,0-9, _",sTmp)
                If GROUP Then
                    If GUM.CharInSubset("0-9,_",Left(sTmp,1)) Then GROUP = False
                    If Right(sTmp,1) = "_" Then GROUP = False
                End If
            End If
        End If: If GROUP Then AnyString = "[" & sTmp & "]"
    End Function

    Function PARAM(ByRef AnyString) ' Detect if line is a parameter
        ' needs module GUM.CharInSubset
        Dim i, L, R, M, sTmp, aTmp : ReDim aTmp(-1): PARAM = False
        If GUM.CharInSubset("Chr(32-127),ßäöüÄÖÜ€|", AnyString) Then
            sTmp = Trim(AnyString): L = "": R = ""
            If InStr(sTmp,"=") > 0 Then
                If Len(sTmp) = 2 Then
                    If Right(sTmp,1) = "=" Then PARAM = True
                    If Not(GUM.CharInSubset("A-Z",Left(sTmp,1))) Then PARAM = False
                ElseIf Len(sTmp) > 2 Then
                    aTmp = Split(Replace(sTmp,"==","="),"=")
                    PARAM = True: If UBound(aTmp) > 1 Then PARAM = False
                    If PARAM Then
                        L = Trim(aTmp(0)): R = Trim(aTmp(1))
                        If Len(L) = 0 Then PARAM = False
                        If PARAM Then
                            M = "": If Len(L) > 2 Then M = Mid(L,2,Len(L)-2)
                            aTmp = Array(Left(L,1),"A-Z",M,"A-Z,0-9, _",Right(L,1),"A-Z,0-9")
                            For i = 0 To 4 Step 2
                                If Not(GUM.CharInSubset(aTmp(i+1),aTmp(i))) Then
                                    PARAM = False: Exit For
                                End If
                            Next
                        End If
                    End If
                End If
            End If
        End If: If PARAM Then AnyString = L & "=" & R
    End Function

    ' Individually adapted service-routines

    Function ConvertToGroupListFormat(AnyList)
        Dim sTmp, GroupList: ReDim GroupList(-1)
        If UBound(AnyList) > -1 Then
            AnyList = GUM.RemoveEmptyLines(AnyList)
            sTmp = Join(AnyList, vbTab)
            sTmp = Replace(sTmp, vbTab & "[", vbLf & "[")
            GroupList = Split(sTmp, vbLf)
            If Left(GroupList(0),1) <> "[" Then GroupList(0) = vbTab & GroupList(0)
        End If: ConvertToGroupListFormat = GroupList
    End Function

    Function ConvertToNormalFormat(AnyGroupList)
        AnyGroupList = GUM.RemoveEmptyLines(AnyGroupList)
        If Left(AnyGroupList(0),1) = vbTab Then AnyGroupList(0) = Mid(AnyGroupList(0),2)
        ConvertToNormalFormat = Split(Replace(Join(AnyGroupList,vbLf),vbTab,vbLf),vbLf)
    End Function
End Class

Class GenerallyUsedModules

    Function RemoveEmptyLines(AnyArray)
        Dim item, sTmp: sTmp = ""
        For Each item In AnyArray
            If Len(Trim(item)) Then
                If Len(sTmp) Then sTmp = sTmp & vbLf
                sTmp = sTmp & item
            End If
        Next: RemoveEmptyLines = Split(sTmp,vbLf)
    End Function

    Function CharInSubset(CharTypes, AnyString)
        ' CharInSubset("Chr(32-127),A-Z,0-9, _[]ßäöüÄÖÜ€|", AnyString)
        Dim i, j, Char, aTmp, OK, strOK
        aTmp = Split(CharTypes,","): strOK = True
        For i = 1 To Len(AnyString)
            Char = Mid(AnyString,i,1): OK = False
            For j = 0 To UBound(aTmp)
                Select Case UCase(aTmp(j))
                    Case ""
                    Case "CHR(32-127)":If Char >= Chr(32) And Char <= Chr(127) Then OK = True
                    Case "A-Z": If UCase(Char) >= "A" And UCase(Char) <= "Z" Then OK = True
                    Case "0-9": If InStr("0123456789",Char) <> 0 Then OK = True
                    Case Else: If InStr(aTmp(j),Char) <> 0 Then OK = True
                End Select
            Next: If Not(OK) Then strOK = False
            If Not(strOK) Then Exit For
        Next: CharInSubset    = strOK
    End Function

    Function CopyArray(AnyArray)
        CopyArray = AnyArray
    End Function

    '      Harddisk-In-Out

    Sub ReadWriteListFile(ByVal Direction, ByRef AnyList, ByVal AnyFileSpec)
        Dim MyFile, Line, LastLine
        If Direction = ForReading Then 'returns lines in an array
            ReDim AnyList(-1)
            If fso.FileExists(AnyFileSpec) Then
                Set MyFile = fso.OpenTextFile(AnyFileSpec, ForReading)
                While Not MyFile.AtEndOfStream
                    ReDim Preserve AnyList(UBound(AnyList)+1)
                    AnyList(UBound(AnyList)) = MyFile.ReadLine
                Wend: MyFile.Close
            End If
        ElseIf Direction = ForWriting Then
            ' If AnyList ist not defined (DIM AnyList(-1)),
            ' then it stores no file with lenght 0 and
            ' if a previous such is extant, then delete.
            ' Writes lines without quotation marks
            ' True overwrites the already extant file
            ' WriteLine makes a CrLf behind
            If UBound(AnyList) > -1 Then
                If fso.FileExists(AnyFileSpec) Then fso.DeleteFile(AnyFileSpec)
                Set f = fso.OpenTextFile(AnyFileSpec, ForWriting, True)
                f.Write Join(AnyList,vbCrLf): f.Close
            ElseIf fso.FileExists(AnyFileSpec) Then
                fso.DeleteFile(AnyFileSpec)
            End If
        End If
    End Sub
End Class