Logo Foltyn Presentation
Table of Contents Previous Page Next Page
Content-Symbol-Img
Ein Programm in der Programmiersprache A program in the programming language
Visual BASIC 2015
Code für das Laden einer INI in ein Dictionary-Object und Zurücksspeichern Code for Loading of an INI into a Dictionary-Object and Write-Back

Die INI verwendet ein Dictionary auf jeden Fall. Alle Dictionary Prozeduren sind in die Dictionary-Klasse verlegt, weil nicht alle Programme eine INI haben und die Klasse kann weg gelassen werden, während im Modul sind genug andere Prozeduren zum allgemeinen Zugriff. Aber die Dictionaries selbst befinden sich im Modul um Zugriff von überall zu gewährleisten.

WorkPath ist der Pfad, welcher auf das Verzeichnis zeigt, wo sich die INI-Datei und andere wesentliche Dateien befinden, solang die exe-Datei im Stadium der Entwicklung ist und sich in der Pfad-Struktur des Visual-Studio befindet. Wenn die fertige exe-Datei in einen anderen Pfad verschoben wird, wird für WorkPath der aktuelle Pfad genommen.

Dictionary Objekte können nicht einfach kopiert werden, indem man schreibt DIC2 = DIC1, weil wenn die Kopie verändert wird, verändert sich das Original mit. Daher wird für das Kopieren ein spezieller Code verwendet, zu sehen in der Sub CopyDIC für beide Richtungen.

The INI is using a dictionary anyway. All Dictionary Procedures are positioned in a Dictionary-Class because not all programs will have an INI and the class can be ommitted while in the module are enough other procedures for general access. But the dictionaries themselves are positioned in a module to give access from everwhere.

WorkPath is the Path, pointing to where the INI-file and other constituents are located for the period of development, if the exe-file is located in the Visual-Studio-Path-Structure. If the finished exe-file is moved to another path, for WorkPath is taken the current path.

Dictionary Objects cannot be copied by simply writing DIC2 = DIC1, because if the copy is changed, the original is changed too. Therefor is taken a special code for copying dictionaries, to see in the Sub CopyDIC for both directions.

Den Code für RDWRfile können Sie auf einer anderen Seite finden: ProcedureExamples

Das Programm ist getestet vor der Publikation, aber es kann keine Garantie gegeben werden, dass es fehlerfrei ist
The Code for RDWRfile you can find on another page: ProcedureExamples

The program ist tested before publication, but there can be given no guarantee, that it is free of errors
10. Mai 2016 May 10th 2016

The Form used for output of results when functions tested

Example for an INI-Text with Text-Format

[SYS]
Mainboards = "YourMainBoardNames"
Users = "YourNames"
OSs = "7,10"

[GUP]
fSpecHelp = "d:\yourFileSpec.rtf"
fSpecWord = "c:\ProgramFiles\MicrosoftOffice\Office14\WINWORD.EXE"
GraficFormats = "pcx.bmp.tif.tiff.gif.jpg.jpe.jpeg.png"

[[HTML]]
SpecChrs = " <>&""§äöüÄÖÜß;nbsp;lt;gt;amp;quot;sect;auml;ouml;uuml;Auml;Ouml;Uuml;szlig"
Languages = "hta,vbs,bas,inc,vb,gmb"
LgInfName = "bas,vb,* = PB,VB,*"
ExtFilterSource = "VBS HTA BAS INC VB, vbs hta bas inc vb"
ExtFilterDest = "HTM HTML, htm html"
NrOfBlksPerTAB = "4"

[Cols]
typ = " Txt  , Rem  , Qum  , Nrs  , Fms  , Att  , Tag   , Ops , Stm1 , Stm2 , Stm3 , Stm4 , Stm5 "
hta = "000000,008000,408080,A52A2A,------,FF0000,A52A2A,------,0000FF,------,------,------,------"
vbs = "000000,008000,808080,A52A2A,------,FF0000,A52A2A,------,0000FF,------,------,------,------"
bas = "000000,008000,C020C0,000000,C06400,------,------,8000FF,0000C0,------,------,------,------"
vba = "000000,008000,800000,000000,------,------,------,000000,0000FF,008888,6262FF,6E6E6E,431CFF"

[Markers]
Markers_Script = "<HTML>,<SCRIPT Language = ""VBScript"">,</SCRIPT>,</HTML>"
Markers = "<head>,</head>,<body,</body>,<styletype  =  ""text/css"">,</style>,<!--,-->"
Marker1 = "<!--StartofSource-Code-->"
Marker2 = "<!--EndofSource-Code-->"

[TAGs]
TAG_Table1 = "<table border = ""0"" cellpadding = ""0"" cellspacing = ""0""><tr><td width = """
TAG_Table2 = """ height = ""15"" bgcolor = ""#0000FF"">&nbsp;</td></tr></table>"
TAG_p1 = "<p align = ""center"">Progress "
TAG_p2 = " %</p>"
TAG_FontF1 = "<font face = ""Courier New"" SIZE = ""2"">"
TAG_FontC1 = "<font color = "
TAG_Fontx2 = "</font>"
TAGs_End = "</font>,</p>,</pre>,</span>"

[Classes]
txt = "<pre class = ""txt"">,pre.txt {font-size:10pt; color:#000000}"
bk = "<span class = ""bk"">,span.bk {color:#000000;}"
bl = "<span class = ""bl"">,span.bl {color:#0000FF;}"
mg = "<span class = ""mg"">,span.mg {color:#2B91AF;}"
br = "<span class = ""br"">,span.br {color:#A31515;}"
gn = "<span class = ""gn"">,span.gn {color:#008000;}"
rd = "<span class = ""rd"">,span.rd {color:#FF0000;}"
ga = "<span class = ""ga"">,span.ga {color:#808080;}"

[Infos]
Info1
Info2
Info3

Data-Format as stored in Dictionary-Object unambiguously findable

.SYS.Mainboards="YourMainBoardNames"
.SYS.Users="YourNames"
.SYS.OSs="7,10"
.GUP.fSpecHelp="d:\yourFileSpec.rtf"
.GUP.fSpecWord="c:\ProgramFiles\MicrosoftOffice\Office14\WINWORD.EXE"
.GUP.GraficFormats="pcx.bmp.tif.tiff.gif.jpg.jpe.jpeg.png"
HTML..fSpecNewDoc="HMTL-Code\NewDoc.html"
HTML..SpecChrs=" <>&""§äöüÄÖÜß;nbsp;lt;gt;amp;quot;sect;auml;ouml;uuml;Auml;Ouml;Uuml;szlig"
HTML..Languages="hta,vbs,bas,inc,vb,gmb"
HTML..LgInfName="bas,vb,*=PB,VB,*"
HTML..ExtFilterSource="VBS HTA BAS INC VB, vbs hta bas inc vb"
HTML..ExtFilterDest="HTM HTML, htm html"
HTML..NrOfBlksPerTAB="4"
HTML.Cols.typ=" Txt  , Rem  , Qum  , Nrs  , Fms  , Att  , Tag   , Ops , Stm1 , Stm2 , Stm3 , Stm4 , Stm5 "
HTML.Cols.hta="000000,008000,408080,A52A2A,------,FF0000,A52A2A,------,0000FF,------,------,------,------"
HTML.Cols.vbs="000000,008000,808080,A52A2A,------,FF0000,A52A2A,------,0000FF,------,------,------,------"
HTML.Cols.bas="000000,008000,C020C0,000000,C06400,------,------,8000FF,0000C0,------,------,------,------"
HTML.Cols.vba="000000,008000,800000,000000,------,------,------,000000,0000FF,008888,6262FF,6E6E6E,431CFF"
HTML.Markers.Markers_Script="<HTML>,<SCRIPT Language=""VBScript"">,</SCRIPT>,</HTML>"
HTML.Markers.Markers="<head>,</head>,<body,</body>,<styletype = ""text/css"">,</style>,<!--,-->"
HTML.Markers.Marker1="<!--StartofSource-Code-->"
HTML.Markers.Marker2="<!--EndofSource-Code-->"
HTML.TAGs.TAG_Table1="<table border=""0"" cellpadding=""0"" cellspacing=""0""><tr><td width="""
HTML.TAGs.TAG_Table2=""" height=""15"" bgcolor=""#0000FF"">&nbsp;</td></tr></table>"
HTML.TAGs.TAG_p1="<p align=""center"">Progress "
HTML.TAGs.TAG_p2=" %</p>"
HTML.TAGs.TAG_FontF1="<font face=""Courier New"" SIZE=""2"">"
HTML.TAGs.TAG_FontC1="<font color="
HTML.TAGs.TAG_Fontx2="</font>"
HTML.TAGs.TAGs_End="</font>,</p>,</pre>,</span>"
HTML.Classes.txt="<pre class=""txt"">,pre.txt {font-size:10pt; color:#000000}"
HTML.Classes.bk="<span class=""bk"">,span.bk {color:#000000;}"
HTML.Classes.bl="<span class=""bl"">,span.bl {color:#0000FF;}"
HTML.Classes.mg="<span class=""mg"">,span.mg {color:#2B91AF;}"
HTML.Classes.br="<span class=""br"">,span.br {color:#A31515;}"
HTML.Classes.gn="<span class=""gn"">,span.gn {color:#008000;}"
HTML.Classes.rd="<span class=""rd"">,span.rd {color:#FF0000;}"
HTML.Classes.ga="<span class=""ga"">,span.ga {color:#808080;}"
HTML.Infos.#1=Info1
HTML.Infos.#2=Info2
HTML.Infos.#3=Info3

Procedure-List


Program-Code

' Code in Visual BASIC 2015
Public Module GeneralUsedProcedures
    Private OWN As New OWNsysVars
    Private DRV As New DriveSpecs
    Public Path As New PathSpecs ' used for writing style by variables to get them ordered
    Public fSpec As New FileSpecs ' used for writing style by variables to get them ordered
    Public DIC As New DictionaryClass ' used for one more dictionary

    Public Const RD = 1, WR = 2
    Public Const allbracks = "()[]{}"

    Public XXX As New Dictionary(Of String, String)
    Public INI As New Dictionary(Of String, String)
    Public DIC1 As New Dictionary(Of String, String) ' used for one more dictionary

    Public Function DrE(xName) As Boolean ' xName = ":Name" or "letter:"
        Return DRV.Exists(xName)
    End Function

    Public Function BPth(xPath, xFile) As String
        Return IO.Path.Combine(xPath, xFile)
    End Function ' Path Procedures
End Module
' =========================================================================================
Imports System.IO
Public Class OWNsysVars
    Public Mainboards, ComputerName, Mainboard, ScreenWidth, ScreenHeight, OS, UserName
    Public Screen As Object = My.Computer.Screen.Bounds.Size

    ' Sub New() replaces Class_Initialise in older VB-Versions
    ' and is started automaticly everytime, if the Class is
    ' instantiated in another class
    Public Sub New()
        ' ----------- System Variables -----------
        Dim fSys As Object = My.Computer.FileSystem
        ' More than one Mainboard if you have running the program on other computers
        Mainboards = "YourMainBoardName1,YourMainBoardName2,YourMainBoardName3"
        ComputerName = Environment.MachineName
        ' ComputerName is extended versus MainboardName for versions of different installations
        Mainboard = GetMainBoard()
        OS = Split(My.Computer.Info.OSFullName, " ")(2) ' Operating System
        UserName = Environment.UserName
        ' ----------- Pathes -----------
        Path.MyDocs = fSys.SpecialDirectories.MyDocuments
        Path.Current = fSys.CurrentDirectory
        ' PreliminaryPath is used for test-phase before pgm finished
        ' and is made to WorkPath by GetWorkPath() for general use
        Path.Preliminary = "YourPath"
        Path.ProjectSub = "Visual Studio 2015\Projects\*\*\bin\Debug"
        fSpec.Base = IO.Path.GetFileNameWithoutExtension(Application.ExecutablePath)
        Path.ProjectSub = Replace(Path.ProjectSub, "*", fSpec.Base)
        Path.Project = BPth(Path.MyDocs, Path.ProjectSub)
        Path.Work = GetWorkPath()
        Path.Constituents = BPth(Path.Work, "Constituents") ' used if more files as INI extant
        ' ----------- File-Specs -----------
        fSpec.Name = IO.Path.GetFileName(Application.ExecutablePath) ' (FulName)
        fSpec.File = BPth(Path.Current, fSpec.Name) ' Path & FulName
        fSpec.INI = BPth(Path.Work, fSpec.Base & ".INI")
        ' ----------- Drive-Specs -----------
        DRV.Specs = DRV.GetAllInfo()
    End Sub
    ' ----------- Procedures -----------
     Private Function GetMainBoard() As String
        For Each MB In Split(Mainboards, ",")
            If StrComp(MB, Left(ComputerName, Len(MB)), CompareMethod.Text) Then Return MB
        Next : Return ""
    End Function

    Private Function GetWorkPath()
        If Path.Current = Path.Project Then Return Path.Preliminary
        Return Path.Current
    End Function
End Class
' =========================================================================================
Public Class PathSpecs
    Public Current, MyDocs, Preliminary, Project, ProjectSub, Work, Constituents
End Class
' =========================================================================================
Public Class FileSpecs
    Public Base, Name, File, INI
End Class
' =========================================================================================
Imports System.IO ' needed for DriveInfo
Public Class DriveSpecs
    Public Specs As New List(Of String)

    ' Procedures
    Public Function GetAllInfo() As List(Of String) ' F:POSTMAN
        If Specs.Count > 0 Then Return Specs
        Dim DrvInf As New List(Of String)
        For Each d As DriveInfo In DriveInfo.GetDrives()
            If d.IsReady Then DrvInf.Add(Left(d.Name, 2) & d.VolumeLabel)
        Next : Return DrvInf
    End Function
    Public Function Exists(xName) As Boolean ' xName = ":Name" or "letter:"
        If Len(xName) < 2 Then Return False
        Dim Typ = -1, A As String() = Split(xName, ":") : If Ubd(A) <> 1 Then Return False
        For i = 0 To 1 : If A(i) = "" Then Typ = 1 - i
        Next : If Not (Typ = 0 Or Typ = 1) Then Return False
        For Each d In GetAllInfo()
            If StrComp(Split(d, ":")(Typ), A(Typ), CompareMethod.Text) Then Return True
        Next : Return False
    End Function
    Public Function GetLetterFromName(xName As String) As String
        Dim a : If Not Exists(":" & xName) Then Return ""
        For Each d In GetAllInfo() : a = Split(d, ":")
            If StrComp(a(1), xName, CompareMethod.Text) Then Return UCase(a(0))
        Next : Return ""
    End Function
End Class
' =========================================================================================
Public Class DictionaryClass
    ' DICobject Procedures
    Public Function LoadSaveINI(Dir) As Boolean ' file <--> INI-DIC
        If Not DetectINIFiles() Then Return False
        Dim fSpec = OWN.fSpec.INI
        If Not LoadSaveXDIC(INI, Dir, fSpec) Then Return False
        Return True
    End Function  ' INI-Procedure

    Public Function LoadSaveXDIC(ByRef xDIC, Dir, xfSpec) As Boolean ' file <--> DIC
        Dim fSpec = xfSpec : If Not DetectFile(fSpec) Then Return False
        Dim LofS As New List(Of String)
        If Dir = RD Then
            RDWRfile(Dir, LofS, fSpec)
            CleanList(Dir, LofS)
            SectionList(Dir, LofS)
            Report.AddRange(enTitleMsg(LofS, "Sectioned List"))
            If Not RdWrDICsectioned(xDIC, Dir, LofS) Then Return False
            Return True
        ElseIf Dir = WR Then
            If Not RdWrDICsectioned(xDIC, Dir, LofS) Then Return False
            SectionList(Dir, LofS)
            CleanList(Dir, LofS)
            fSpec = "yourPath\Result.INI"
            RDWRfile(Dir, LofS, fSpec)
            Report.AddRange(enTitleMsg(LofS, "INI written back cleaned"))
            Return True
        End If : Return False
    End Function ' DIC-Procedures

    Public Function RdWrDICsectioned(ByRef xDIC, Dir, ByRef xLofS)
        Dim LofS As New List(Of String)
        Dim i : Dim OK = False
        If Dir = RD Then
            For Each Line As String In xLofS
                i = InStr(Line, "=") : If i < 2 Then Continue For
                xDIC.Add(Left(Line, i - 1), Mid(Line, i + 1))
            Next : OK = True
        ElseIf Dir = WR Then
            For Each pair As KeyValuePair(Of String, String) In xDIC
                LofS.Add(pair.Key & "=" & pair.Value)
            Next : xLofS = LofS : OK = True
        End If : Return OK
    End Function

    Public Sub CleanList(Dir, ByRef xLofS)
        If Dir = RD Then
            If Not RemoveTrailingBracks(xLofS) Then Exit Sub
            If Not RemoveEmptyLinesAndTrim(xLofS) Then Exit Sub
            If Not RemoveIllicitConsecutiveBracks(xLofS) Then Exit Sub
            If Not RemoveBlanksAroundEqualSigns(xLofS) Then Exit Sub
        ElseIf Dir = WR Then
            If Not RestoreOriginalDICfile(xLofS) Then Exit Sub
        End If
    End Sub

    Private Function RemoveTrailingBracks(ByRef xLofS As List(Of String)) As Boolean
        If xLofS.Count < 1 Then Return False
        Dim A As String() = xLofS.ToArray, x = "", Pos = -1
        For i = Ubd(A) To 0 Step -1 : A(i) = Trim(A(i))
            If A(i) <> "" Then If GetBrackNr(x, A(i)) = 0 Then Pos = i : Exit For
        Next : If Pos > -1 Then ReDim Preserve A(Pos) : xLofS = LofA(A)
        Return Pos > -1
    End Function

    Private Function RemoveEmptyLinesAndTrim(ByRef xLofs As List(Of String)) As Boolean
        If xLofs.Count < 1 Then Return False
        Dim A As String() = xLofs.ToArray : xLofs.Clear()
        For Each Line In A : Line = Trim(Line) : If Line <> "" Then xLofs.Add(Line)
        Next : Return xLofs.Count > 0
    End Function

    Private Function RemoveIllicitConsecutiveBracks(ByRef xLofS As List(Of String)) As Boolean
        If xLofS.Count < 1 Then Return False
        Dim A As String() = xLofS.ToArray
        Dim brnr1 = 0, brnr2 = 0, x = "" : xLofS.Clear()
        For i = 0 To Ubd(A) - 1 : brnr1 = GetBrackNr(x, A(i)) : brnr2 = GetBrackNr(x, A(i + 1))
            If brnr1 = 0 Then xLofS.Add(A(i)) : Continue For
            If brnr1 > brnr2 Then xLofS.Add(A(i))
        Next : xLofS.Add(A(Ubd(A))) : Return xLofS.Count > 0
    End Function

    Private Function RemoveBlanksAroundEqualSigns(ByRef xLofS As List(Of String)) As Boolean
        If xLofS.Count < 1 Then Return False
        Dim A As String() = xLofS.ToArray
        Dim P = {"", ""}, i = 0 : xLofS.Clear()
        For Each Line In A
            i = InStr(Line, "=") : If i < 2 Then xLofS.Add(Line) : Continue For
            P(0) = Trim(Left(Line, i - 1)) : P(1) = Trim(Mid(Line, i + 1))
            xLofS.Add(String.Join("=", P))
        Next : Return xLofS.Count > 0
    End Function

    Private Function RestoreOriginalDICfile(ByRef xLofS As List(Of String)) As Boolean
        If xLofS.Count < 1 Then Return False
        Dim A As String() = xLofS.ToArray
        Dim dblBr As Boolean : xLofS.Clear()
        Dim Content = "", FL = True ' FL = FirstLine
        For Each Line In A
            Select Case GetBrackNr(Content, Line)
                Case 0 : xLofS.Add(Replace(Line, "=", " = ")) : dblBr = False
                Case 1 : If Not FL And Not dblBr Then xLofS.Add("")
                    xLofS.Add(Line) : dblBr = False
                Case 2 : If Not FL Then xLofS.Add("")
                    xLofS.Add(Line) : dblBr = True
            End Select : FL = False
        Next : Return xLofS.Count > 0
    End Function

    Public Sub SectionList(Dir, ByRef xList)
        Dim LofS As New List(Of String)
        If Dir = RD Then
            Dim A = {"", "", ""}, s = ""
            PrecedeNumbers(xList)
            For Each Line As String In xList
                Select Case GetBrackNr(s, Line)
                    Case 2 : If A(0) <> s Then A(0) = s : A(1) = "" : Continue For
                    Case 1 : If A(1) <> s Then A(1) = s : Continue For
                    Case 0 : A(2) = s : LofS.Add(String.Join(".", A))
                End Select
            Next
        ElseIf Dir = WR Then
            Dim G As String(), X = {"", "", ""}, i, A
            For Each Line As String In xList
                i = InStr(Line, "=") : If i < 2 Then Continue For
                A = {Left(Line, i - 1), Mid(Line, i + 1)} : G = Split(A(0), ".")
                If X(0) <> G(0) Then X(0) = G(0) : X(1) = "" : LofS.Add(enBr(enBr(G(0))))
                If X(1) <> G(1) Then X(1) = G(1) : LofS.Add(enBr(G(1)))
                If Left(G(2), 1) = "#" Then G(2) = "" Else G(2) &= "="
                LofS.Add(G(2) & A(1))
            Next
        End If : xList = LofS
    End Sub

    Private Sub PrecedeNumbers(ByRef xLofS As List(Of String)) ' so that always there is an =
        Dim zeros = "", L = 0, i = 0, n = 0, x = "" : Dim LofS As New List(Of String)
        GetSectionVars(zeros, L, xLofS)
        For Each Line As String In xLofS
            If GetBrackNr(x, Line) = 0 Then
                If InStr(Line, "=") = 0 Then _
                    n += 1 : Line = "#" & Right(zeros & CStr(n), L) & "=" & Line
            End If : LofS.Add(Line)
        Next : xLofS = LofS
    End Sub

    Private Sub GetSectionVars(ByRef xZeros As String, ByRef Lmax As Int16, xLofS As List(Of String))
        Dim x As String = "", nr As Int16 = 0 ' xZeros = "00000"
        For Each Line As String In xLofS : If Trim(Line) = "" Then Continue For
            If GetBrackNr(x, Line) = 0 And InStr(Line, "=") = 0 Then nr += 1
        Next : xZeros = StrDup(Len(CStr(nr)), "0") : Lmax = Len(xZeros)
    End Sub

    Public Function GetContentOfxDIC(xDIC) As List(Of String)
        Dim LofS As New List(Of String)
        For Each pair As KeyValuePair(Of String, String) In xDIC
            LofS.Add(pair.Key & " = " & pair.Value)
        Next : Return LofS
    End Function

    Public Sub CopyDIC(ByRef xDIC2 As Dictionary(Of String, String),
                       ByVal xDIC1 As Dictionary(Of String, String))
        xDIC2.Clear() : xDIC2 = xDIC1.ToDictionary(Function(x) x.Key, Function(x) x.Value)
    End Sub

    Public Function GetBrackNr(ByRef xContent, ByVal xStrg) As Int32
        xContent = xStrg : Dim brNr = 0
        Do : If Len(xContent) < 2 Then Return brNr
            If InStr(allbracks, Left(xContent, 1) & Right(xContent, 1)) = 0 Then Return brNr
            brNr += 1 : xContent = Mid(xContent, 2, Len(xContent) - 2)
        Loop Until brNr = 3 : Return brNr
    End Function

    Public Function enBr(xStr)
        Return "[" & xStr & "]" : End Function
End Class