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