'Bens Markup Language

hi I made this for getting used to using Instr and Mid and other string functions, It a very simple Markup Language, that I wanted to make so i can do my own config files.

anyway I hope someone finds the code usfull.

Ok to get this working you need to add a new class to vb and call it clsCfg Then add this code to the class

Code:

---

'Bens Markup Language
Private m_Col As New Collection

Public Function ReadValue(ByVal Selection As String, ByVal Key As String, Optional Default As String = "") As String
Dim Count As Long
Dim sLine As String
Dim sPos As Integer
Dim ePos As Integer
Dim eStart As Integer
Dim eEnd As Integer
Dim StartTag As String
Dim EndTag As String
Dim RetVal As String

    For Count = 1 To m_Col.Count
        sLine = m_Col(Count)
        'Get opening tag
        sPos = InStr(1, sLine, "<?", vbTextCompare)
        ePos = InStr(1, sLine, ">", vbTextCompare)
        '
        If (sPos > 0) And (ePos > 0) Then
            'Check that the selection is found
            If LCase$(Mid$(sLine, sPos + 2, ePos - sPos - 2)) = LCase(Selection) Then
                'Tag start position
                eStart = (Count + 1)
                Exit For
            End If
        End If
    Next Count
   
    'Check if we have a start
    If (eStart = 0) Then
        'Just return default value and exit
        ReadValue = Default
        Exit Function
    End If
   
    For Count = eStart To m_Col.Count
        sLine = m_Col(Count)
        'Check for end selection
        sPos = InStr(1, sLine, "<?", vbTextCompare)
        ePos = InStr(1, sLine, "/>", vbTextCompare)
       
        If (sPos > 0) And (ePos > 0) Then
            'Check that the selection is found
            If LCase$(Mid$(sLine, sPos + 2, ePos - sPos - 2)) = LCase(Selection) Then
                eEnd = (Count - 1)
                Exit For
            End If
        End If
    Next Count
   
    'Get the value
    If (eStart > 0) And (eEnd > 0) Then
        For Count = eStart To eEnd
            sLine = m_Col(Count)
            'Start tag
            StartTag = "<" & Key & ">"
            'End tag
            EndTag = "</" & Key & ">"
            'Check for open tag
            sPos = InStr(1, sLine, StartTag, vbTextCompare)
            ePos = InStr(1, sLine, EndTag, vbTextCompare)
            'Check that we found the tags
            If (sPos > 0) And (ePos > 0) Then
                'Extract the value between the tags
                RetVal = Mid$(sLine, sPos + Len(StartTag), ePos - Len(EndTag))
            End If
        Next Count
    End If
   
    ReadValue = IIf(Len(RetVal), RetVal, Default)
   
    'Clear up
    sLine = vbNullString
    RetVal = vbNullString
    StartTag = vbNullString
    EndTag = vbNullString
End Function

Public Sub LoadConfig(ByVal Filename As String)
Dim fp As Long
Dim sLine As String

    fp = FreeFile
   
    Set m_Col = Nothing
   
    Open Filename For Input As #fp
        Do Until EOF(fp)
            Line Input #fp, sLine
            'Trim down the line
            sLine = LTrimWhite(sLine)
            'Don't add comments
            If Left$(sLine, 3) = "<--" Then
                'Bring in next line
                Line Input #fp, sLine
            End If
            'Check for length
            If Len(sLine) Then
                Call m_Col.Add(sLine)
            End If
            DoEvents
        Loop
    Close #fp
End Sub

Private Function LTrimWhite(ByVal sString As String) As String
Dim Count As Long
Dim c As String
    'This is like LTrim but works with tabs
    For Count = 1 To Len(sString)
        c = Mid$(sString, Count, 1)
        If (c <> " ") And (c <> vbTab) Then
            Exit For
        End If
    Next Count
   
    LTrimWhite = Mid$(sString, Count)
End Function

---

Here is a simple config file I used for testing
put this into a new file in C:\test.bml

Code:

---

<?General>
        <Backcolor>Red</BackColor>
        <Enabled>True</Enabled>
<?General/>

<--This is a comment line-->

<?Main>
        <Path>C:\Windows\</Path>
<?Main/>

---

And here is an example using the class.

Code:

---

Dim MyCfg As clsCfg
   
    'Create the object
    Set MyCfg = New clsCfg
    'Load example filename
    Call MyCfg.LoadConfig("C:\test.bml")
    'Display a value form the general selection
    MsgBox MyCfg.ReadValue("general", "Backcolor")
    'Display a value form the main selection
    MsgBox MyCfg.ReadValue("main", "path")
    'Here an example if a value does not exsit we can use default
    MsgBox MyCfg.ReadValue("main", "ThisValueIsNotHere", "Testing Default Value")

---