Imports System.Configuration
Imports System.IO
Imports System.Text
Imports System.Xml
Imports System.Xml.Serialization
Public MustInherit Class SettingsBase
#Region " Constants"
Private Const DEFAULTSETTINGFILENAME = "Settings.config"
Private Const ROOTSECTION = "general"
Private Const ROOTITEM = "settings"
#End Region
#Region " Properties"
Private rFilename As String = DEFAULTSETTINGFILENAME
Public Property FileName() As String
Get
Return rFilename
End Get
Set(ByVal value As String)
rFilename = value
End Set
End Property
Private rCompanyName As String = My.Application.Info.CompanyName
Public Property CompanyName() As String
Get
Return rCompanyName
End Get
Set(ByVal value As String)
rCompanyName = value
End Set
End Property
Private rAppName As String = My.Application.Info.ProductName
Public Property AppName() As String
Get
Return rAppName
End Get
Set(ByVal value As String)
rAppName = value
End Set
End Property
Private ReadOnly Property pAppConfigFilename() As String
Get
Dim path = System.Environment.GetFolderPath(Environment.SpecialFolder.CommonApplicationData)
If Me.CompanyName.Length > 0 Then
path = System.IO.Path.Combine(path, Me.CompanyName)
If Not My.Computer.FileSystem.DirectoryExists(path) Then
My.Computer.FileSystem.CreateDirectory(path)
End If
End If
If Me.AppName.Length > 0 Then
path = System.IO.Path.Combine(path, Me.AppName)
If Not My.Computer.FileSystem.DirectoryExists(path) Then
My.Computer.FileSystem.CreateDirectory(path)
End If
End If
Dim Filename = System.IO.Path.Combine(path, Me.FileName)
Return Filename
End Get
End Property
Private ReadOnly Property pAppConfigMap() As ExeConfigurationFileMap
Get
Dim filemap = New ExeConfigurationFileMap
filemap.ExeConfigFilename = Me.pAppConfigFilename
Return filemap
End Get
End Property
Private ReadOnly Property pConfig() As Configuration
Get
Static cfg As Configuration
If cfg Is Nothing Then
cfg = ConfigurationManager.OpenMappedExeConfiguration(Me.pAppConfigMap, ConfigurationUserLevel.None)
End If
If Not cfg.HasFile Then
cfg.AppSettings.Settings.Add("version", My.Application.Info.Version.ToString)
cfg.Save()
End If
Dim bDirty As Boolean = False
If cfg.HasFile Then
Dim sect As ClientSettingsSection = cfg.Sections(ROOTSECTION)
If cfg.Sections(ROOTSECTION) Is Nothing Then
sect = cfg.Sections(ROOTSECTION)
cfg.Sections.Add(ROOTSECTION, sect)
bDirty = True
End If
Dim element = sect.Settings.Get(ROOTITEM)
If element Is Nothing Then
element = New SettingElement(ROOTITEM, SettingsSerializeAs.Xml)
sect.Settings.Add(element)
bDirty = True
End If
If element.Value.ValueXml Is Nothing Then
element.Value.ValueXml = New Xml.XmlDocument().CreateElement("value")
bDirty = True
End If
If bDirty Then cfg.Save()
End If
Return cfg
End Get
End Property
Protected ReadOnly Property ConnectionStrings() As ConnectionStringsSection
Get
Return pConfig.ConnectionStrings
End Get
End Property
Protected ReadOnly Property AppSettings() As AppSettingsSection
Get
Return pConfig.AppSettings
End Get
End Property
#End Region
#Region " Methods"
Public Sub Save()
With Me.pConfig
Dim sect = TryCast(.Sections(ROOTSECTION), ClientSettingsSection)
Dim element = sect.Settings.Get(ROOTITEM)
Dim s = New XmlSerializer(Me.GetType)
Using ms = New MemoryStream
s.Serialize(ms, Me)
ms.Seek(0, SeekOrigin.Begin)
Dim myutf As UTF8Encoding = New UTF8Encoding()
Dim xml = New XmlDocument
xml.LoadXml(myutf.GetString(ms.GetBuffer()))
element.Value.ValueXml.InnerXml = xml.DocumentElement.OuterXml
End Using
sect.SectionInformation.ForceSave = True
.Save()
End With
End Sub
Public Sub Load()
With Me.pConfig
Dim sect = TryCast(.Sections(ROOTSECTION), ClientSettingsSection)
Dim element As SettingElement = sect.Settings.Get(ROOTITEM)
If Len(element.Value.ValueXml.InnerXml) Then
Dim s = New XmlSerializer(Me.GetType)
Dim myutf As UTF8Encoding = New UTF8Encoding()
Using ms = New MemoryStream(myutf.GetBytes(element.Value.ValueXml.InnerXml))
Dim o As Object = Nothing
Try
o = s.Deserialize(ms)
Catch ex As Exception
Debug.Print("Problem")
End Try
If o IsNot Nothing Then
For Each Field In Me.GetType().GetFields
If Field.IsPublic Then
Try
Field.SetValue(Me, Field.GetValue(o))
Catch
End Try
End If
Next
For Each Prop In Me.GetType().GetProperties
Dim n = Prop.Name
Dim query As IEnumerable(Of System.Reflection.PropertyInfo) = Me.GetType.BaseType.GetProperties.Where(Function(Prop2) Prop2.Name = n)
If query.Count = 0 Then
If Prop.CanWrite Then
If Prop.GetIndexParameters.Count = 0 Then
Try
Prop.SetValue(Me, Prop.GetValue(o, Nothing), Nothing)
Catch
End Try
Else
End If
End If
End If
Next
End If
End Using
End If
End With
End Sub
#End Region
#Region " SettingsBaseDictionary"
<XmlRoot("dictionary", IsNullable:=True)> _
Public Class SettingsBaseDictionary(Of TKey, TValue)
Inherits Generic.Dictionary(Of TKey, TValue)
Implements IXmlSerializable
Private Const ITEMNAME = "item"
Private Const KEYNAME = "key"
Private Const VALUENAME = "value"
Public Function GetSchema() As System.Xml.Schema.XmlSchema Implements IXmlSerializable.GetSchema
Return Nothing
End Function
Public Sub New()
MyBase.New()
End Sub
Public Sub New(ByVal capacity As Integer)
MyBase.New(capacity)
End Sub
Public Sub New(ByVal comparer As System.Collections.Generic.IEqualityComparer(Of TKey))
MyBase.New(comparer)
End Sub
Public Sub New(ByVal capacity As Integer, ByVal comparer As System.Collections.Generic.IEqualityComparer(Of TKey))
MyBase.New(capacity, comparer)
End Sub
Public Sub New(ByVal dictionary As Generic.IDictionary(Of TKey, TValue))
MyBase.New(dictionary)
End Sub
Public Sub New(ByVal dictionary As Generic.IDictionary(Of TKey, TValue), ByVal comparer As System.Collections.Generic.IEqualityComparer(Of TKey))
MyBase.New(dictionary, comparer)
End Sub
Public Sub New(ByVal info As System.Runtime.Serialization.SerializationInfo, ByVal context As System.Runtime.Serialization.StreamingContext)
MyBase.New(info, context)
End Sub
Public Sub ReadXml(ByVal reader As System.Xml.XmlReader) Implements IXmlSerializable.ReadXml
Dim keySerializer As XmlSerializer = New XmlSerializer(GetType(TKey))
Dim valueSerializer As XmlSerializer = New XmlSerializer(GetType(TValue))
Dim wasEmpty As Boolean = reader.IsEmptyElement
reader.Read()
If wasEmpty Then Return
Do While (reader.NodeType <> System.Xml.XmlNodeType.EndElement)
reader.ReadStartElement(ITEMNAME)
reader.ReadStartElement(KEYNAME)
Dim key As TKey = DirectCast(keySerializer.Deserialize(reader), TKey)
reader.ReadEndElement()
reader.ReadStartElement(VALUENAME)
Dim value As TValue = DirectCast(valueSerializer.Deserialize(reader), TValue)
reader.ReadEndElement()
Me.Add(key, value)
reader.ReadEndElement()
reader.MoveToContent()
Loop
reader.ReadEndElement()
End Sub
Public Sub WriteXml(ByVal writer As System.Xml.XmlWriter) Implements IXmlSerializable.WriteXml
Dim keySerializer As XmlSerializer = New XmlSerializer(GetType(TKey))
Dim valueSerializer As XmlSerializer = New XmlSerializer(GetType(TValue))
For Each key As TKey In Me.Keys
writer.WriteStartElement(ITEMNAME)
writer.WriteStartElement(KEYNAME)
keySerializer.Serialize(writer, key)
writer.WriteEndElement()
writer.WriteStartElement(VALUENAME)
valueSerializer.Serialize(writer, DirectCast(Me(key), TValue))
writer.WriteEndElement()
writer.WriteEndElement()
Next
End Sub
End Class
#End Region
End Class
