ClsoINIPure.vb

https://blog.clso.fun/posts/219.html

用法

Dim ini As New ClsoINIPure("路径或者内容，空数据时新建INI配置文件")
 
Dim value As String = ini("项目名", "键名") '读取一个参数值
ini("项目名", "键名") = "一个新的参数值" '写入一个参数值
ini.SetValue("[项目名] 键名 = 参数值") '快速写入一个参数值
 
ini.RemoveSection("项目名") '移除一整个项内的参数
ini.RemoveKey("项目名", "键名") '移除一个键
 
ini.SaveIni("文件路径或是文件流") '立刻存储INI数据到文件
Dim IniContent As String = ini.OutputIni() '立刻获取INI完整文本数据

代码

' ClsoINI Pure Edition 
' 0.5.5 将创造函数的 createfile 默认设置为 false
' 0.5.4
' (c)2020-2023 clso.fun
' https://clso.fun/go/?clsoini
' 
' Licenses LGPL
' https://www.gnu.org/licenses/lgpl-3.0.html
' http://www.thebigfly.com/gnu/lgpl/lgpl-v3.php


Imports System.Text
Imports System.Text.RegularExpressions
Imports System.IO

#If _COMP Then
<Assembly: System.Reflection.AssemblyVersion("0.5.5.0")> 
<Assembly: System.Reflection.AssemblyFileVersion("0.5.5.0")> 

<Assembly: System.Reflection.AssemblyTitle("ClsoINI")>
<Assembly: System.Reflection.AssemblyDescription("https://clso.fun")>
<Assembly: System.Reflection.AssemblyCompany("clso.fun")>
<Assembly: System.Reflection.AssemblyProduct("Clso Lib - ClsoINI")>
<Assembly: System.Reflection.AssemblyCopyright("©2020-2023 clso.fun")>
<Assembly: System.Reflection.AssemblyTrademark("clso.fun")>

<Assembly: System.Runtime.InteropServices.ComVisible(False)>
#End If


Public Class ClsoINIPure

	Dim sections As New Dictionary(Of String, Dictionary(Of String, String))(StringComparer.OrdinalIgnoreCase)

	Sub New()
	End Sub

	''' <summary></summary>
	''' <param name="content">INI内容文本</param>
	Sub New(ByVal content As String)
		Parser(content)
	End Sub

	''' <param name="filePath">文件路径</param>
	''' <param name="enc">文件编码，传递Null时默认为UTF8</param>
	''' <param name="createfile">如果文件不存在，是否尝试创建文件</param>
	Sub New(ByVal filePath As String, ByVal enc As Encoding, Optional ByVal createfile As Boolean = False)
		If enc Is Nothing Then enc = Me.Encoding Else Me.Encoding = enc
		Dim content As String = ""
		If Not File.Exists(filePath) Then
			If createfile Then File.Create(filePath).Close()
		Else
			content = File.ReadAllText(filePath, enc)
		End If
		Parser(content)
	End Sub

	Sub New(ByVal file As FileInfo, Optional ByVal enc As Encoding = Nothing, Optional ByVal createfile As Boolean = False)
		Dim content As String = ""
		If file.Exists Then
			If enc Is Nothing Then enc = Me.Encoding Else Me.Encoding = enc
			Using sr = New StreamReader(file.OpenRead, enc)
				content = sr.ReadToEnd
			End Using
		Else
			If createfile Then file.Create.Close()
		End If

		Parser(content)
	End Sub

	''' <param name="s">文件流</param>
	''' <param name="enc">文件编码，传递Null时默认为UTF8</param>
	''' <param name="closeStream">是否自动关闭文件流</param>
	Sub New(ByVal s As Stream, Optional ByVal enc As Encoding = Nothing, Optional ByVal closeStream As Boolean = False)
		If enc Is Nothing Then enc = Me.Encoding Else Me.Encoding = enc
		Dim sr As New StreamReader(s, enc)
		s.Position = 0
		Dim content As String = sr.ReadToEnd
		If closeStream Then
			sr.Dispose()
			s.Dispose()
		End If
		Parser(content)
	End Sub


	''' <summary>解析INI内容</summary>
	''' <param name="clearContent">是否清理已存储的内容</param>
	Sub Parser(ByVal content As String, Optional ByVal clearContent As Boolean = False)
		If clearContent Then Me.Clear()

		Dim lines As String() = content.Split(New String() {vbCrLf, vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)

		Dim m As Match
		Dim opt As RegexOptions = RegexOptions.IgnoreCase
		Dim p1 As String = "^\s*(;|#)"
		Dim p2 As String = "^\s*\[\s*(.+?)\s*\]\s*$"
		Dim p3 As String = "^\s*(.+?)\s*=\s*(.+)\s*$"

		Dim sname As String = Nothing '节点
		Dim kv As Dictionary(Of String, String) = Nothing '节点的键值字典


		For Each line As String In lines
			' 忽略注释
			If Regex.IsMatch(line, p1, opt) Then
				Continue For
			End If

			' 节点
			m = Regex.Match(line, p2, opt)
			If m.Success Then
				sname = m.Groups(1).Value '节点名
				If Me.sections.ContainsKey(sname) Then '如果存在节点名，则从字典中取出
					kv = Me.sections(sname)
				Else '如果不存在节点，则创建并加入字典
					kv = New Dictionary(Of String, String)(StringComparer.OrdinalIgnoreCase)
					Me.sections(sname) = kv
				End If

				Continue For
			End If

			' 键值
			m = Regex.Match(line, p3, opt)
			If m.Success Then
				If kv Is Nothing Then '若未定义节点，则默认以 @ 为节点名
					sname = "@"
					kv = New Dictionary(Of String, String)(StringComparer.OrdinalIgnoreCase)
					Me.sections(sname) = kv
				End If

				kv(m.Groups(1).Value) = m.Groups(2).Value 'kv赋值
			End If
		Next

	End Sub

	''' <summary>清空内容</summary>
	''' <param name="clearGC">手动清理GC</param>
	Sub Clear(Optional ByVal clearGC As Boolean = False)
		For Each kv In Me.sections
			kv.Value.Clear()
		Next
		Me.sections.Clear()
		If clearGC Then GC.Collect()
	End Sub

	''' <summary>获取或设置默认节点下的值</summary>
	Default Property Value(ByVal key As String) As String
		Get
			Return GetValue("@", key)
		End Get
		Set(ByVal value As String)
			SetValue("@", key, value)
		End Set
	End Property
	''' <summary>获取或设置指定节点下的值</summary>
	Default Property Value(ByVal section As String, ByVal key As String) As String
		Get
			Return GetValue(section, key)
		End Get
		Set(ByVal value As String)
			SetValue(section, key, value)
		End Set
	End Property

	''' <summary>默认编码</summary>
	Property Encoding As Encoding = Encoding.UTF8

	''' <summary>获取所有节点字典</summary>
	Friend ReadOnly Property SectionsDict() As Dictionary(Of String, Dictionary(Of String, String))
		Get
			Return Me.sections
		End Get
	End Property
	''' <summary>获取指定节点字典</summary>
	Friend ReadOnly Property SectionDict(ByVal section As String) As Dictionary(Of String, String)
		Get
			Return If(Me.sections.ContainsKey(section), Me.sections(section), Nothing)
		End Get
	End Property


	''' <summary>获取默认节点下的值</summary>
	Function GetValue(ByVal key As String) As String
		Return GetValue("@", key)
	End Function
	''' <summary>获取指定节点下的值</summary>
	Function GetValue(ByVal section As String, ByVal key As String) As String
		If Not Me.sections.ContainsKey(section) Then Return Nothing
		If Not Me.sections(section).ContainsKey(key) Then Return Nothing

		Return Me.sections(section)(key)
	End Function

	''' <summary>设置默认节点下的值</summary>
	Sub SetValue(ByVal key As String, ByVal value As String)
		SetValue("@", key, value)
	End Sub
	''' <summary>设置指定节点下的值</summary>
	Sub SetValue(ByVal section As String, ByVal key As String, ByVal value As String)
		Dim kv As Dictionary(Of String, String)

		If Me.sections.ContainsKey(section) Then '如果存在节名，则从字典中取出
			kv = Me.sections(section)
		Else '如果不存在节，则创建并加入字典
			kv = New Dictionary(Of String, String)(StringComparer.OrdinalIgnoreCase)
			Me.sections(section) = kv
		End If

		kv(key) = value
	End Sub

	''' <summary>[节点] 键 = 值 | 键=值</summary>
	Sub SetValue(ByVal kvs As String)
		Dim m As Match
		m = Regex.Match(kvs, "^\s*(?:\[(.+?)\]\s*)?(.+?)\s*=\s*(.+)\s*$", RegexOptions.IgnoreCase)
		If m.Success Then
			Dim s = m.Groups(1).Value
			Dim k = m.Groups(2).Value
			Dim v = m.Groups(3).Value
			If s = Nothing Then
				SetValue("@", k, v)
			Else
				SetValue(s, k, v)
			End If
		End If
	End Sub


	''' <summary>移除指定节点</summary>
	Sub RemoveSection(ByVal section As String)
		If Me.sections.ContainsKey(section) Then Me.sections.Remove(section)
	End Sub
	''' <summary>移除默认节点下的键</summary>
	Sub RemoveKey(ByVal key As String)
		RemoveKey("@", key)
	End Sub
	''' <summary>移除指定节点下的键</summary>
	Sub RemoveKey(ByVal section As String, ByVal key As String)
		If Me.sections.ContainsKey(section) AndAlso Me.sections(section).ContainsKey(key) Then
			Me.sections(section).Remove(key)
		End If
	End Sub

	''' <summary>清理空的节点和元素</summary>
	''' <param name="clearEle">是否清理空的元素</param>
	Sub ClearContent(Optional ByVal clearEle As Boolean = True)
		' 总结点为空，直接跳出
		If Me.sections.Count < 1 Then Return

		' 取出所有节点名
		Dim skeys(Me.sections.Count - 1) As String
		Me.sections.Keys.CopyTo(skeys, 0)

		For i As Integer = 0 To skeys.Length - 1
			' 取出当前节点名
			Dim skname As String = skeys(i)

			' 如果需要清理空元素
			If clearEle Then
				' 取出当前节点
				Dim skv = Me.sections(skname)

				' 当前节点下的所有元素名
				Dim ekeys(skv.Count - 1) As String
				skv.Keys.CopyTo(ekeys, 0)

				' 取出所有元素值并进行比对、删除
				For Each ename As String In ekeys
					If skv(ename) = Nothing Then skv.Remove(ename) '删除元素
				Next
			End If

			' 清理空节点
			If Me.sections(skname).Count < 1 Then
				Me.sections.Remove(skname)
			End If
		Next
	End Sub

	''' <summary>比较元素并清理</summary>
	Sub ClearContent(ByVal eleComp As DEleComp)
		ClearContentComp(eleComp)
	End Sub
	''' <summary>比较节点并清理</summary>
	Sub ClearContent(ByVal secComp As DSecComp)
		ClearContentComp(Nothing, secComp)
	End Sub
	''' <summary>比较元素与节点并清理</summary>
	Sub ClearContent(ByVal eleComp As DEleComp, ByVal secComp As DSecComp)
		ClearContentComp(eleComp, secComp)
	End Sub

	''' <summary>对元素进行比较，返回 true 删除元素</summary>
	Delegate Function DEleComp(ByVal Section As String, ByVal Key As String, ByVal Value As String) As Boolean
	''' <summary>对当前节点进行比较，返回 true 删除当前节点</summary>
	Delegate Function DSecComp(ByVal Section As String) As Boolean

	''' <summary>清理空的节点和元素</summary>
	''' <param name="eleComp">对元素进行自定义比较，返回 true 删除元素</param>
	''' <param name="secComp">对节点进行自定义比较，返回 true 删除元素</param>
	Sub ClearContentComp(Optional ByVal eleComp As DEleComp = Nothing, Optional ByVal secComp As DSecComp = Nothing)
		If Me.sections.Count < 1 Then Return
		Dim skeys(Me.sections.Count - 1) As String
		Me.sections.Keys.CopyTo(skeys, 0)

		For i As Integer = 0 To skeys.Length - 1
			Dim skname As String = skeys(i)
			Dim skv = Me.sections(skname)
			Dim ekeys(skv.Count - 1) As String
			skv.Keys.CopyTo(ekeys, 0)

			' 先执行节点的比较
			If secComp IsNot Nothing AndAlso secComp(skname) Then
				Me.sections.Remove(skname)
				Continue For
			End If

			' 再执行详细内容的比较
			If eleComp IsNot Nothing Then
				For Each ename As String In ekeys
					If eleComp(skname, ename, skv(ename)) Then skv.Remove(ename) '删除元素
				Next
			End If

			' 清理空节点
			If Me.sections(skname).Count < 1 Then
				Me.sections.Remove(skname)
			End If
		Next
	End Sub

	''' <summary>获取文本内容表示</summary>
	Function OutputIni(Optional ByVal noInfo As Boolean = False) As String
		Dim sb As New StringBuilder
		If noInfo = False Then
			sb.AppendLine("# ClsoINI https://clso.fun/go/?clsoini")
			sb.AppendLine()
		End If

		If Me.sections.ContainsKey("@") Then
			Dim kv = Me.sections("@")
			For Each ks In kv
				sb.AppendLine(ks.Key & "=" & ks.Value)
			Next
			sb.AppendLine()
		End If

		For Each kv In Me.sections
			If kv.Key = "@" Then Continue For
			sb.AppendLine("[" & kv.Key & "]")
			For Each ks In kv.Value
				sb.AppendLine(ks.Key & "=" & ks.Value)
			Next
			sb.AppendLine()
		Next

		Return sb.ToString
	End Function

	''' <summary>保存文本内容到指定文件</summary>
	Sub SaveIni(ByVal filePath As String, Optional ByVal enc As Encoding = Nothing, Optional ByVal noInfo As Boolean = False)
		If enc Is Nothing Then enc = Me.Encoding
		File.WriteAllText(filePath, OutputIni(noInfo), enc)
	End Sub
	''' <summary>保存文本内容到流</summary>
	Sub SaveIni(ByVal s As Stream, Optional ByVal enc As Encoding = Nothing, Optional ByVal noInfo As Boolean = False)
		If enc Is Nothing Then enc = Me.Encoding
		Dim sw As New StreamWriter(s, enc)
		sw.Write(OutputIni(noInfo))
		sw.Flush()
	End Sub

End Class