利用.Net的反射机制，完成一个自适应的程序配置保存类

最近老是为程序的配置保存烦恼。

客户的要求三天两头的变，每次给程序添加个配置变量都要重复好多代码。正好最近在看.net的反射机制，就像弄一个能自动反射配置类的机制

Imports System.Xml
Imports System.Reflection
Imports System.ComponentModel
Imports System.Data.OleDb
Imports System.Data.SqlClient

 

Public Class Liu_App_Config

    Private mDataBase As String = ""
    Private mLastEditTime As Date = Date.Now
    Private mDBConnection As New OleDb.OleDbConnection

     <CategoryAttribute("只读"), _
       Browsable(False), _
       [ReadOnly](True), _
       BindableAttribute(False), _
       DefaultValueAttribute(""), _
       DesignOnly(False), _
       DescriptionAttribute("数据库连接")> _
    Public Property DBConnection() As OleDbConnection
        Get
            Return Me.mDBConnection
        End Get
        Set(ByVal Value As OleDbConnection)
            Me.DBConnection = Value
        End Set
    End Property

    <CategoryAttribute("数据库"), _
       Browsable(True), _
       [ReadOnly](False), _
       BindableAttribute(False), _
       DefaultValueAttribute("db.mdb"), _
       DesignOnly(False), _
       DescriptionAttribute("输入数据库名")> _
    Public Property DataBase() As String
        Get
            Return Me.mDataBase
        End Get
        Set(ByVal Value As String)
            Me.mDataBase = Value
        End Set
    End Property

    <CategoryAttribute("只读"), _
       Browsable(True), _
       [ReadOnly](True), _
       BindableAttribute(False), _
       DefaultValueAttribute("1983-4-20"), _
       DesignOnly(False), _
       DescriptionAttribute("本次启动时间")> _
    Public Property LastEditTime() As Date
        Get
            Return Me.mLastEditTime
        End Get
        Set(ByVal Value As Date)
            Me.mLastEditTime = Value
        End Set
    End Property

    Public Function FillToXml(ByRef doc As XmlDocument)
        Dim tempro As PropertyInfo
        For Each tempro In Me.GetType.GetProperties()
            If tempro.PropertyType.ToString = GetType(String).ToString() Or _
                tempro.PropertyType.ToString = GetType(Date).ToString() Or _
                tempro.PropertyType.ToString = GetType(Double).ToString() Or _
                tempro.PropertyType.ToString = GetType(Integer).ToString() Then

                'Debug.WriteLine(tempro.Name)
                Dim xroot As XmlNode = doc.DocumentElement
                If xroot.Item(tempro.Name) Is Nothing Then
                    Dim tempnode As XmlNode = doc.CreateElement(tempro.Name)
                    tempnode.InnerText = CStr(tempro.GetValue(Me, Nothing)).Trim
                    xroot.AppendChild(tempnode)
                Else
                    xroot.Item(tempro.Name).InnerText = CStr(tempro.GetValue(Me, Nothing)).Trim
                End If

            End If
        Next
    End Function

    Public Function LoadFromXml(ByVal doc As XmlDocument)
        Dim tempro As PropertyInfo
        For Each tempro In Me.GetType.GetProperties()
            'Debug.WriteLine(tempro.Name)
            Dim xroot As XmlNode = doc.DocumentElement
            If Not xroot.Item(tempro.Name) Is Nothing Then
                Select Case tempro.PropertyType.ToString
                    Case GetType(String).ToString()
                        tempro.SetValue(Me, xroot.Item(tempro.Name).InnerText, Nothing)
                    Case GetType(Date).ToString()
                        tempro.SetValue(Me, CDate(xroot.Item(tempro.Name).InnerText), Nothing)
                    Case GetType(Double).ToString()
                        tempro.SetValue(Me, CDbl(xroot.Item(tempro.Name).InnerText), Nothing)
                    Case GetType(Integer).ToString()
                        tempro.SetValue(Me, CInt(xroot.Item(tempro.Name).InnerText), Nothing)
                End Select

            End If
        Next
    End Function

    Public Sub save(ByVal path As String)
        Dim sd As New XmlDocument
        sd.LoadXml("<ChengYiKeJi></ChengYiKeJi>")
        sd.InsertBefore(sd.CreateXmlDeclaration("1.0", "UTF-8", Nothing), sd.DocumentElement)
        Me.FillToXml(sd)
        Try
            sd.Save(path)
        Catch ex As Exception
            MsgBox("保存配置文件时发生错误:" & ex.Message)
        End Try
    End Sub

    Public Function Clone() As Object
        Dim obj As New Liu_App_Config
        obj.DataBase = Me.DataBase
        obj.LastEditTime = Me.LastEditTime
        Return obj
    End Function

End Class