加载中…
个人资料
mfkwine
mfkwine
  • 博客等级:
  • 博客积分:0
  • 博客访问:2,101
  • 关注人气:14
  • 获赠金笔:0支
  • 赠出金笔:0支
  • 荣誉徽章:
正文 字体大小:

vb.net操作INI文件详细代码

(2013-06-20 19:55:33)
标签:

ini文件操作

分类: VB.net学习

在项目里新建个类,把下面的代码粘贴进去,相信你操作.INI文件就轻松多了。

注:下面有用法实例。

'------class代码

Imports System.Collections 'ArryList命名空间引用
Imports System.IO 'TextWriter   TextReader
Imports System.Diagnostics '使您能够与系统进程、事件日志和性能计数器进行交互
'Imports System.Security.Cryptography' 命名空间提供加密服务,Md5命名空间引,类Encryption中已经导入

'Imports System.Linq '提供支持使用语言集成查询 (LINQ) 进行查询的类和接口
'Imports System.Runtime.InteropServices '[DllImport("kernel32")]与非托管代码交互


Namespace OperateIniSorted

    '''
    '''Ini 配置文件类
    '''
    '''
    Public NotInheritable Class IniFileSorted
        Private m_strIniFilePath As String '配置文件路径
        Private m_bIsLoad As Boolean '是否已经初始化
        Private m_arrSections As ArrayList '属性分节单元
        Private m_arrProperties As ArrayList '属性值数组

        Private Const msgTile As String = "提示"
        Private Const msgNoPro As String = "该属性不存在"
        Private Const msgNoInit As String = "尚未初始化"
        Private Const msgNoOpenInifile As String = "没有打开配置文件"
        Private Const msgIncorrectProperty As String = "属性名称不能为空"
        Private Const msgIncorrectSection As String = "指定的属性名称不能为空"
        Private Const msgIncorrectValue As String = "指定的属性值不能为空"
        Private Const msgExistedProperty As String = "属性已经存在"
        '''
        ''' ini文件加载后,获取全部属性对象
        '''
        Public ReadOnly Property PropertiesLst() As ArrayList
            Get
                Return IIf(m_bIsLoad, m_arrProperties, Nothing)
            End Get

        End Property
        '''
        ''' INI文件加载后,获取全部单元对象
        '''
        '''
        '''
        '''
        Public ReadOnly Property SectionLst() As ArrayList
            Get
                Return IIf(m_bIsLoad, m_arrSections, Nothing)
            End Get
        End Property
        '''
        ''' 配置INI文件路径
        '''
        '''
        '''
        '''
        Public Property IniFilePath() As String
            Get
                Return m_strIniFilePath
            End Get
            Set(ByVal value As String)
                m_strIniFilePath = value
            End Set
        End Property

        Public Sub New() '构造
            m_strIniFilePath = ""
            m_bIsLoad = False
            m_arrSections = New ArrayList()
            m_arrProperties = New ArrayList()
        End Sub
        Public Sub New(ByVal a_strIniFilePath As String) '重构
            m_strIniFilePath = a_strIniFilePath
            m_bIsLoad = False
            m_arrSections = New ArrayList()
            m_arrProperties = New ArrayList()
        End Sub
#Region "属性单元Section类"
        Public Class Section
            Private m_strSectionNmae As String '单元名称
            Public Property SectionName() As String '存取单元名称
                Get
                    Return m_strSectionNmae
                End Get
                Set(ByVal value As String)
                    m_strSectionNmae = value
                End Set
            End Property
            Public Sub New()
                m_strSectionNmae = ""
            End Sub
            Public Sub New(ByVal a_strName As String)
                m_strSectionNmae = a_strName
            End Sub

        End Class
#End Region

#Region "属性类"
        '''
        ''' 属性类
        '''
        '''
        Public Class [Property]
            Private m_strSection As String '单元名称
            Private m_strPropertyName As String ' 属性名称
            Private m_strValue As String ' 属性值

            '''读取所在单元名称
            Public ReadOnly Property InSection() As String
                Get
                    Return m_strSection
                End Get
            End Property
            ''' 存取属性名称
            Public Property PropertyName() As String
                Get
                    Return m_strPropertyName
                End Get
                Set(ByVal value As String)
                    m_strPropertyName = value
                End Set
            End Property

            ''' 存取属性值
            Public Property PropertyValue() As String
                Get
                    Return m_strValue
                End Get
                Set(ByVal value As String)
                    m_strValue = value
                End Set
            End Property
            ''' 构造函数
            Public Sub New()
                m_strSection = ""
                m_strPropertyName = ""
                m_strValue = ""
            End Sub
            '''
            '''重载构造函数  
            ''' 
            ''' 属性所在单元名称
            '''  属性名称
            '''  属性值
            Public Sub New(ByVal strPropertyName As String, ByVal strValue As String, ByVal stInrSection As String)
                m_strSection = stInrSection
                m_strPropertyName = strPropertyName
                m_strValue = strValue
            End Sub

            '''
            ''' 重构函数
            '''
            ''' 属性名称
            ''' 所在单元名称
            ''' 第二个参数为单元名称标示。若为真,第二参数为单元名称,若为假第二个参数为属性值
            '''
            Public Sub New(ByVal strPropertyName As String, ByVal strSectionOrValue As String, ByVal intSectionFlag As Boolean)
                If intSectionFlag Then
                    m_strSection = strSectionOrValue
                    m_strPropertyName = strPropertyName
                    m_strValue = ""
                Else
                    m_strSection = ""
                    m_strPropertyName = strPropertyName
                    m_strValue = strSectionOrValue
                End If
            End Sub

            '''
            ''' 重构
            '''
            ''' 属性名称
            ''' 属性值
            '''
            Public Sub New(ByVal strPropertyName As String, ByVal strValue As String)
                m_strSection = ""
                m_strPropertyName = strPropertyName
                m_strValue = strValue
            End Sub
            '''
            ''' 重构
            '''
            ''' 属性名称
            '''
            Public Sub New(ByVal strPropertyName As String)
                m_strSection = ""
                m_strPropertyName = strPropertyName
                m_strValue = ""
            End Sub

        End Class
#End Region
#Region "添加单元 AddSection(a_strName as string)"
        '''
        ''' 添加划分属性的单元名称,添加空单元无效。
        '''
        ''' 新属性单元名称
        ''' 添加成功返回单元名称,否则返回空字符串
        '''
        Public Function AddSection(ByVal strNewSection As String) As String
            If strNewSection.Trim = "" Then
                Return ""
            End If

            '检查是否已有该单元
            Dim bExists As Boolean = False
            strNewSection = strNewSection.Trim

            For i As Integer = 0 To m_arrSections.Count - 1
                Dim s As Section = DirectCast(m_arrSections(i), Section)
                If StrComp(s.SectionName, strNewSection) = 0 Then
                    bExists = True
                    Exit For
                End If
            Next

            If Not bExists Then
                m_arrSections.Add(New Section(strNewSection)) '分别向单元和属性arraylist集合追加单元信息

                m_arrProperties.Add(New [Property](strNewSection))

                Return strNewSection
            Else
                Return ""
            End If
        End Function
#End Region
#Region "添加属性 AddProperty(a_strName as string, a_strValue as string)"

        '''
        ''' 根据单元、值的设置添加属性
        '''
        ''' 属性名称,空字符串属性名称添加无效
        ''' 操作成功,返回属性名称;失败,返回空字符串。
        ''' 只添加属性名称
        Public Overloads Function AddProperty(ByVal strPropertyName As String) As String
            If strPropertyName.Trim = "" Then
                Return ""
            Else
                Return AddPr(strPropertyName)
            End If
        End Function

        '''
        ''' 根据单元、值的设置添加属性
        '''
        ''' 属性名称
        ''' 属性值
        ''' 操作成功,返回属性名称;失败,返回空字符串。
        ''' 同时添加属性名称和属性值
        Public Overloads Function AddProperty(ByVal strPropertyName As String, ByVal strValue As String) As String
            strPropertyName = strPropertyName.Trim
            strValue = strValue.Trim

            If strPropertyName = "" And strValue = "" Then
                Return ""
            ElseIf strValue = "" Then
                Return AddProperty(strPropertyName)
            ElseIf strPropertyName = "" Then
                Return ""
            Else
                Return AddPr(strPropertyName, strValue)
            End If
        End Function


        '''
        ''' 根据单元、值的设置添加属性
        '''
        ''' 属性名称
        ''' 属性值
        ''' 所在单元名称
        ''' 操作成功,返回属性名称;失败,返回空字符串。
        ''' 同时添加属性名称、属性值和属性所在单元名称
        Public Overloads Function Addproperty(ByVal strPropertyName As String, ByVal strValue As String, ByVal strInSection As String) As String
            strPropertyName = strPropertyName.Trim
            strValue = strValue.Trim
            strInSection = strInSection.Trim

            If strPropertyName <> "" And strValue <> "" And strInSection <> "" Then
                Return AddPr(strPropertyName, strValue, strInSection)
            ElseIf strPropertyName <> "" And strValue <> "" And strInSection = "" Then
                Return AddPr(strPropertyName, strValue)
            ElseIf strPropertyName <> "" And strValue = "" And strInSection = "" Then
                Return AddPr(strPropertyName)
            ElseIf strPropertyName <> "" And strValue = "" And strInSection <> "" Then
                Return AddPr(strPropertyName, "", strInSection)
            Else
                Return ""
            End If

        End Function


        ''' 添加属性。
        ''' strPropertyName属性名称,strValue属性值,strInSetion,所在单元名称
        Private Function AddPr(ByVal strPropertyName As String, Optional ByVal strValue As String = "", Optional ByVal strInSetion As String = "") As String
            If strPropertyName.Trim = "" Then
                Return ""
            End If

            Dim bExists As Boolean = False

            If strInSetion <> "" Then '划分单元

                If AddSection(strInSetion) = "" Then '检查指定单元是否存在,不存在则创建;存在则检查是否已有该属性
                    '检查是否已有该属性
                    For cx As Integer = 0 To m_arrProperties.Count - 1

                        Dim pS As [Property] = DirectCast(m_arrProperties(cx), [Property])

                        If pS.InSection.Trim.CompareTo(strInSetion.Trim) = 0 Then
                            For i As Integer = cx To m_arrProperties.Count - 1
                                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])
                                If p.PropertyName = strPropertyName Then
                                    bExists = True
                                    Exit For
                                End If
                            Next
                        End If

                        If bExists Then Exit For

                    Next
                End If

            Else '没有划分单元

                For i As Integer = 0 To m_arrProperties.Count - 1 '直接检查是否已有该属性
                    Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])
                    If p.PropertyName = strPropertyName Then
                        bExists = True
                        Exit For
                    End If
                Next
            End If

            If Not bExists Then '不存在则添加,并返回属性名称;否则返回空字符串
                If strInSetion <> "" And strValue <> "" Then
                    m_arrProperties.Add(New [Property](strInSetion, strPropertyName, strValue))
                ElseIf strInSetion = "" And strValue <> "" Then
                    m_arrProperties.Add(New [Property](strPropertyName, strValue))
                ElseIf strInSetion <> "" And strValue = "" Then
                    m_arrProperties.Add(New [Property](strPropertyName, strInSetion, True))
                Else
                    m_arrProperties.Add(New [Property](strPropertyName))
                End If
            Else
                strPropertyName = ""
                ' MsgBox(msgExistedProperty, MsgBoxStyle.OkOnly + MsgBoxStyle.OkOnly, msgTile)
            End If

            m_bIsLoad = True
            Return strPropertyName
        End Function
#End Region

#Region "设置属性值 SetProperty(string strPropertyName, string strPropertyValue)"

        '''
        ''' 设置指定属性的值
        '''
        ''' 指定属性
        ''' 属性的新值
        ''' 若设置成功返回True,否则返回False。
        '''
        Public Overloads Function SetProperty(ByVal strProperty As String, ByVal strValue As String) As Boolean
            If strProperty.Trim = "" Or (Not m_bIsLoad) Then
                Return False
            End If

            Return SetProValue(strProperty, strValue)

        End Function
        '''
        ''' 设置指定单元内的指定属性的值
        '''
        ''' 指定要修改值的属性
        ''' 新值
        ''' 该属性所在的单元
        ''' 若设置成功返回True,若设置失败则返回False
        '''
        Public Overloads Function SetProperty(ByVal strProperty As String, ByVal strValue As String, ByVal strInSection As String) As Boolean
            If strProperty.Trim = "" Or (Not m_bIsLoad) Then
                Return False
            ElseIf strInSection.Trim = "" Then
                Return SetProperty(strProperty, strValue)
            Else
                Return SetProValue(strProperty, strValue, strInSection)
            End If
        End Function

        '''设置属性值,strPropertyName属性名称,strPropertyValue新属性值,strInSection属性所在单元;默认修改所有单元的同名属性的值。
        '''设置成功,返回True;若设置失败,返回False
        Private Function SetProValue(ByVal strPropertyName As String, ByVal strPropertyValue As String, Optional ByVal strInSection As String = "") As Boolean

            Dim bExists As Boolean = False
            Dim bSection As Boolean = True

            For i As Integer = 0 To m_arrProperties.Count - 1

                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])
                'Dim s As Section = New Section

                If p.PropertyName.Trim.CompareTo(strPropertyName.Trim) = 0 AndAlso IIf(strInSection = "", True, p.InSection.Trim.CompareTo(strInSection.Trim) = 0) Then
                    DirectCast(m_arrProperties(i), [Property]).PropertyValue = strPropertyValue
                    bSection = True
                    bExists = True

                End If

                If bExists And bSection And IIf(strInSection = "", False, Not p.InSection.Trim.CompareTo(strInSection.Trim) = 0) Then '指定单元搜索完毕
                    Exit For
                End If
            Next

            Return bExists

        End Function
        '''
        ''' 设置第intAt个同名属性的值
        '''
        ''' 指定属性名称
        ''' 新值
        ''' 第n个与指定属性同名的属性
        ''' 成功赋值返回True,否则返回False
        '''
        Public Overloads Function SetProperty(ByVal strPropertyName As String, ByVal strValue As String, ByVal intAt As Integer) As Boolean
            If strPropertyName.Trim() <> "" Or Not m_bIsLoad Then
                Return False
            End If
            Dim bExist As Boolean = False
            Dim intFound As Integer = 0

            For i As Integer = 0 To m_arrProperties.Count - 1

                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])

                If StrComp(p.PropertyName.Trim, strPropertyName.Trim) = 0 Then
                    intFound = intFound + 1
                    If intFound = intAt Then
                        DirectCast(m_arrProperties(i), [Property]).PropertyValue = strValue
                        bExist = True
                        Exit For
                    End If
                End If
            Next
            Return bExist
        End Function

        '''
        ''' 设置属性值(可指定范围或属性所在单元)
        '''
        ''' 属性名称
        ''' 新属性值
        ''' 从第n个同名属性开始修改属性值
        ''' 修改n个同名属性的值,默认修改从intRangFrom开始的所有同名属性的值
        ''' 修改同名属性数目由intRangTo参数确定,该参数设置为-1时,将修改从intRangFrom开始的所有同名属性
        Public Overloads Function SetProperty(ByVal strPropertyName As String, ByVal strValue As String, ByVal intRangFrom As Integer, ByVal intRangTo As Integer) As Boolean

            If strPropertyName.Trim() <> "" Or Not m_bIsLoad Then
                Return False
            End If

            Dim bExists As Boolean = False
            Dim intFound As Integer = 0

            For i As Integer = 0 To m_arrProperties.Count - 1

                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])

                If StrComp(p.PropertyName.Trim, strPropertyName.Trim) = 0 Then
                    intFound = intFound + 1
                    If intFound >= intRangFrom And intFound <= intRangTo Then
                        DirectCast(m_arrProperties(i), [Property]).PropertyValue = strValue
                    End If

                    bExists = True

                End If

                If (Not intRangTo = -1) And intFound > intRangTo Then '指定范围修改完毕
                    Exit For
                End If
            Next
            Return bExists

        End Function

#End Region
#Region "删除属性 DelProperty(string strPropertyName)"

        '''
        ''' 删除属性或删除指定单元内的指定属性
        '''
        ''' 属性名称
        ''' 所在单元
        '''
        Public Overloads Function DelProperty(ByVal strPropertyName As String, ByVal strInSection As String) As Boolean
            If strPropertyName.Trim() <> "" Or strInSection.Trim() <> "" Or Not m_bIsLoad Then
                Return False
            End If
            Dim bExist As Boolean = False
            For i As Integer = 0 To m_arrProperties.Count - 1
                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])
                If StrComp(p.PropertyName.Trim, strPropertyName.Trim) = 0 And StrComp(p.InSection.Trim, strInSection.Trim) Then
                    m_arrProperties.Remove(i)
                    bExist = True
                    Exit For
                End If
            Next
            Return bExist
        End Function

        '''
        '''删除属性或删除指定单元内的指定属性
        '''
        ''' 属性名称
        ''' 如果没有找到属性则什么也不做
        Public Overloads Function DelProperty(ByVal strPropertyName As String) As Boolean
            If strPropertyName.Trim() <> "" Or Not m_bIsLoad Then
                Return False
            End If
            '#If DEBUG Then
                      Debug.Assert(strPropertyName.Trim() <> "", msgIncorrectProperty)
                      Debug.Assert(m_bIsLoad, msgNoInit, msgNoOpenInifile)
            '#End If
            Dim bExist As Boolean = False

            For i As Integer = 0 To m_arrProperties.Count - 1
                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])
                If StrComp(p.PropertyName.Trim, strPropertyName.Trim) = 0 Then
                    m_arrProperties.Remove(i)
                    bExist = True
                    Exit For
                End If
            Next
            Return bExist
        End Function
#End Region
#Region "查找指定单元SearchSection(ByVal strSection As String)"
        '''
        ''' 查找指定的属性单元
        '''
        ''' 单元名称
        ''' 成功找到返回True,失败则返回False。
        '''
        Public Function SearchSection(ByVal strSection As String) As String
#If DEBUG Then
            Debug.Assert(strSection.Trim() <> "", msgIncorrectSection)
            Debug.Assert(m_bIsLoad, msgNoInit, msgNoOpenInifile)
#End If
            Dim bExists As Boolean = False

            For i As Integer = 0 To m_arrSections.Count - 1

                Dim s As Section = DirectCast(m_arrSections(i), Section)

                If StrComp(s.SectionName.Trim, strSection.Trim) = 0 Then
                    bExists = True
                    Exit For
                End If
            Next
            If bExists Then
                Return strSection.Trim
            Else
                Return ""
            End If
        End Function

        '''
        ''' 查找指定索引的单元名称
        '''
        ''' 索引号,从0开始计算
        '''
        '''
        Public Function SearchSection(ByVal intIndex As Integer) As String
#If DEBUG Then
            Debug.Assert(m_bIsLoad, msgNoInit, msgNoOpenInifile)
#End If
            'Dim bExists As Boolean = False
            Dim str As String = ""
            For i As Integer = 0 To m_arrSections.Count - 1

                Dim s As Section = DirectCast(m_arrSections(i), Section)
                If i = intIndex Then
                    str = s.SectionName
                    Exit For
                End If
            Next
            Return str
        End Function
#End Region

#Region "查找指定属性"

        '''
        ''' 查找指定属性
        '''
        ''' 指定要查找的属性名称
        ''' 查找成功返回True,否则返回False
        '''
        Public Overloads Function SearchProperty(ByVal strProperty As String) As Boolean
#If DEBUG Then
            Debug.Assert(strProperty.Trim() <> "", msgIncorrectProperty)
            Debug.Assert(m_bIsLoad, msgNoInit, msgNoOpenInifile)
#End If
            Dim bExists As Boolean = False

            For i As Integer = 0 To m_arrProperties.Count - 1

                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])

                If StrComp(p.PropertyName.Trim, strProperty.Trim) = 0 Then
                    bExists = True
                    Exit For
                End If
            Next

            Return bExists

        End Function

        '''
        ''' 查找指定单元内的属性
        '''
        ''' 要查找的属性名称
        ''' 指定查找单元范围
        ''' 找到该属性返回它的名称,否则返回空字符串
        '''
        Public Overloads Function SearchProperty(ByVal strProperty As String, ByVal strSection As String) As Boolean
#If DEBUG Then
            Debug.Assert(strProperty.Trim() <> "", msgIncorrectProperty)
            Debug.Assert(strSection.Trim() <> "", msgIncorrectSection)
            Debug.Assert(m_bIsLoad, msgNoInit, msgNoOpenInifile)
#End If
            Dim bExists As Boolean = False

            For i As Integer = 0 To m_arrProperties.Count - 1

                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])

                If p.PropertyName.Trim.CompareTo(strProperty.Trim) = 0 AndAlso p.InSection.Trim.CompareTo(strSection.Trim) = 0 Then

                    bExists = True
                    Exit For

                End If
            Next
            Return bExists
        End Function
#End Region

#Region "获取指定的属性值 strGetProperty(string strPropertyName,[string strInSection])"
        '''
        '''获取指定属性值或获取指定单元的指定属性的值
        '''
        ''' 属性名称
        ''' 找到搜索的属性返回该属性的值;如果找不到,则返回""。
        Public Overloads Function strGetProperty(ByVal strPropertyName As String) As String

#If DEBUG Then
            Debug.Assert(strPropertyName.Trim() <> "", msgIncorrectProperty)
            Debug.Assert(m_bIsLoad, msgNoInit, msgNoOpenInifile)
#End If
            Dim strFndFstValue As String = ""

            For i As Integer = 0 To m_arrProperties.Count - 1

                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])

                If p.PropertyName.Trim.CompareTo(strPropertyName.Trim) = 0 Then

                    strFndFstValue = p.PropertyValue
                End If
            Next

            Return strFndFstValue
        End Function

        '''
        ''' 获取指定属性值或获取指定单元的指定属性的值
        '''
        ''' 属性名称
        ''' 属性所在单元
        ''' 找到属性返回该属性的值;否则返回""。
        '''
        Public Overloads Function strGetProperty(ByVal strPropertyName As String, ByVal strInSection As String) As String

#If DEBUG Then
            Debug.Assert(strPropertyName.Trim() <> "", msgIncorrectProperty)
            Debug.Assert(strInSection.Trim() <> "", msgIncorrectSection)
            Debug.Assert(m_bIsLoad, msgNoInit, msgNoOpenInifile)
#End If

            Dim strFndFstValue As String = ""

            For i As Integer = 0 To m_arrProperties.Count - 1

                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])

                If p.PropertyName.Trim.CompareTo(strPropertyName.Trim) = 0 AndAlso IIf(strInSection = "", True, p.InSection.Trim.CompareTo(strInSection.Trim) = 0) Then
                    strFndFstValue = p.PropertyValue.Trim '  DirectCast(m_arrProperties(i), [Property]).PropertyValue
                    Exit For
                End If
            Next

            Return strFndFstValue

        End Function
#End Region
#Region "保存配置文件 Save(Optional ByVal strPrLnvbCrLf)  As String = vbcrlf)"
        '''  
        ''' 保存配置文件
        '''
        '''  INI文件行结束特定字符
        ''' 确定是否将数据追加到文件里。若为False,则原文件将被覆盖;若为True,则将数据追加到文件里;若文件不存在,则创建
        ''' 确定是否单元与属性一多对应。若为True,需要为每一个属性指定单元;若为False,则按追加先后依次存入文件
        ''' 单元加“[]”,属性行默认换行符为“,”
        Public Sub Save(Optional ByVal blnAppend As Boolean = False, Optional ByVal blnContractWithSections As Boolean = True, Optional ByVal strPrLnvbCrLf As String = vbCrLf)
            '定义单元和属性不同的换行符
            Dim strSenCrlf = vbCrLf
            If StrComp(strPrLnvbCrLf, "") = 0 Then
                strPrLnvbCrLf = strPrLnvbCrLf & vbCrLf
            End If

            ' Dim blnBgnSen As Boolean = True '确定是否第一个单元区。每个单元以一个空行分隔,想法不完善暂时取消

            Dim tw As StreamWriter = Nothing


            Try
                '如果指定目录不存在则创建   
                'Dim fi As New System.IO.FileInfo(m_strIniFilePath)
                'If Not fi.Directory.Exists Then
                'fi.Directory.Create()
                'End If
                'tw = TextWriter.Synchronized(fi.CreateText())'使用TextWriter创建新文本文件时创建文件流使用
                'tw = fi.CreateText

                tw = New StreamWriter(m_strIniFilePath, blnAppend)


                If (Not blnContractWithSections) Or (m_arrSections.Count = 0) Then '若没有划分单元直接添加属性及属性值
                    For i As Integer = 0 To m_arrProperties.Count - 1

                        Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])

                        If p.InSection <> "" Then

                            tw.NewLine = strSenCrlf

                            ' If blnBgnSen Then
                            'blnBgnSen = False
                            ' Else
                              tw.WriteLine("")
                            'End If
                            tw.WriteLine("[" & p.InSection & "]")
                        Else

                            tw.NewLine = strPrLnvbCrLf

                            tw.WriteLine(p.PropertyName & " = " & p.PropertyValue) '

                        End If

                    Next
                    tw.Flush()

                Else

                    For cx As Integer = 0 To m_arrSections.Count - 1

                        Dim s As Section = DirectCast(m_arrSections(cx), Section) '添加单元

                        tw.Write("[" & s.SectionName & "]" & vbCrLf)
                        tw.Flush() '写入文件流

                        Dim blnFind As Boolean = False '检查当前单元是否结束

                        For i As Integer = 0 To m_arrProperties.Count - 1 '添加属性及属性值

                            Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])

                            If StrComp(p.InSection, s.SectionName, CompareMethod.Text) = 0 Then

                                If p.PropertyName <> "" Then
                                    tw.NewLine = strPrLnvbCrLf
                                    tw.WriteLine(p.PropertyName & " = " & p.PropertyValue) ' & vbCrLf)
                                    blnFind = True
                                Else
                                    tw.NewLine = strSenCrlf
                                    'If blnBgnSen Then
                                    tw.WriteLine("[" & p.InSection & "]")
                                      blnBgnSen = False
                                    'Else
                                      tw.WriteLine("")
                                      tw.WriteLine("[" & p.InSection & "]")
                                    'End If
                                End If

                            End If

                        Next

                    Next
                End If

                tw.Close()
            Catch e As Exception
#If DEBUG Then
                Console.WriteLine("写配置文件出错:" & Err.Description)
#End If
                Throw (New Exception("写配置文件出错:" & Err.Description))
            Finally
                If tw IsNot Nothing Then
                    tw.Close()
                End If
            End Try

        End Sub
#End Region
#Region "读取配置文件 ReadIniContent(Optional ByVal chrSeparative As Char = ',')"
        '''
        '''   读取配置文件全部内容 
        '''  属性值分隔符,同时也是属性结束符,省略为","
        '''
        Public Sub ReadIniContent(Optional ByVal chrSeparative As Char = ",")

            m_arrSections.Clear()
            m_arrProperties.Clear()

            Dim ts As StreamReader = Nothing
            Try
                ts = New StreamReader(m_strIniFilePath)

                'Dim strBlankLine As String = ""
                Dim chrEqualSign As Char = "=" '属性与值间符号
                Dim chrBgnSection As Char = "[" '单元标识
                Dim chrEndSection As Char = "]"
                Dim strCurLine As String = "" '当前行内容
                Dim strLSection As String = "" '单元字符
                Dim strTmp() As String

                While Not ts.EndOfStream '.Peek() <> -1

                    strCurLine = ts.ReadLine().Trim.ToString

                    If strCurLine <> "" Then '处理非空行数据
                        If strCurLine.First = chrBgnSection And strCurLine.EndsWith(chrEndSection) Then '单元
                            strLSection = strCurLine.Substring(1, strCurLine.Length - 2)
                            m_arrSections.Add(New Section(strLSection))
                        Else
                            ' m_arrSections.Add(New Section(strLSection))
                            strCurLine = IIf(strCurLine.EndsWith(chrSeparative), strCurLine.Substring(0, strCurLine.Length - 1), strCurLine)
                            strTmp = strCurLine.Split(chrEqualSign)
                            m_arrProperties.Add(New [Property](strLSection, strTmp(0).Trim, strTmp(1).Trim)) '属性(包含其所在单元以及属性的名称和值)
                        End If

                    End If

                End While
                ts.Close()
                Me.m_bIsLoad = True '已初始化
            Catch ex As Exception
#If DEBUG Then
                Console.WriteLine("读取配置文件出错:" & Err.Description)
#End If
                Throw (New Exception(Err.Description))
            Finally
                If ts IsNot Nothing Then
                    ts.Close()
                End If
            End Try
        End Sub
#End Region
#Region "插入新属性"
        '突发奇想,发现一个别类的用法,完全推翻了我的思路,相信这些代码也足够大家展开了就不码下去了。
#End Region
#Region "属性排序"

#End Region
#Region "添加加密属性(string a_strName, string a_strValue)"

        '''
        '''   添加加密属性
        ''' 
        '''  属性名称
        '''  属性值
        Public Sub AddSecurityProperty(ByVal a_strName As String, ByVal a_strValue As String)
            '检查是否已有该属性  
            Dim bExists As Boolean = False
            Dim enc As New Encryption

            For i As Integer = 0 To m_arrProperties.Count - 1
                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])
                If p.PropertyName = a_strName Then
                    bExists = True
                    Exit For
                End If
            Next
            If Not bExists Then

                m_arrProperties.Add(New [Property](a_strName, enc.GetMD5(a_strValue, 16)))
            Else
                Throw (New Exception("该属性已经存在"))
            End If
        End Sub

#End Region

#Region "设置加密属性值 SetSecurityProperty(string a_strName, string a_strValue)"
        '''   ''' 设置加密属性值
        ''' 
        '''  属性名称
        '''  属性值
        ''' 
        '''  改变已有的属性值,如果没有找到指定属性,则抛出异常
        Public Sub SetSecurityProperty(ByVal a_strName As String, ByVal a_strValue As String)
            Dim bExists As Boolean = False
            Dim enc As New Encryption
            For i As Integer = 0 To m_arrProperties.Count - 1
                Dim p As [Property] = DirectCast(m_arrProperties(i), [Property])
                If p.PropertyName = a_strName Then
                    DirectCast(m_arrProperties(i), [Property]).PropertyValue = enc.GetMD5(a_strValue, 16)
                    bExists = True
                    Exit For
                End If
            Next
            If Not bExists Then
                Throw (New Exception("未找到指定属性"))
            End If
        End Sub
#End Region

    End Class
End Namespace

 

 

'-------下面是实例哟

 Private Sub BtnRefreshlUser_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnRefreshlUser.Click
        Dim newIni As New OperateIniSorted.IniFileSorted("F:\IniTest.txt") '这里的文本文件路径及名称记得换成自己的
        'newIni.AddSection("Countrys")
        'newIni.AddProperty("china", "1")
        'newIni.AddProperty("Britain", "2")
        'newIni.AddProperty("Canada", "3")
        'newIni.Save(",", , False)

       

        'newIni.AddProperty("china", "1", "country")
        'newIni.AddProperty("Britain", "2", "country")
        'newIni.AddProperty("Canada", "3", "country")
        'newIni.AddProperty("zhengzhou", "1", "government")
        'newIni.AddProperty("shenyang", "2", "government")
        'newIni.AddProperty("shijiazhuang", "3", "government")
        'newIni.Save(",", True)
        'newIni = Nothing

        '用ini文件更新Treeview控件
        'newIni.ReadIniContent()
        'Dim AllProps As ArrayList = newIni.GetlPropertiesLst

        'TreeExistUsers.Nodes.Clear() '先清除所有节点
        'For i As Integer = 0 To AllProps.Count() - 1
          TreeExistUsers.Nodes.Add(AllProps.ToArray .Item(i).ToString)
        'Next

        ''调用PropertiesLst、SetionLst属性
        'newIni.ReadIniContent()
        'Dim lstSetion As ArrayList = newIni.PropertiesLst
        'TreeExistUsers.Nodes.Clear() '先清除所有节点

        'For i As Integer = 0 To lstSetion.Count() - 1
          'Dim s As Section = lstSetion(i)
          ' Dim str As String = s.SectionName
          'TreeExistUsers.Nodes.Add(str)
          'TreeExistUsers.Nodes.Add(CType(lstSetion(i), [Property]).PropertyName) '与上面的三句同效
          TreeExistUsers.Nodes.Add(DirectCast(lstSetion(i), [Property]).PropertyName) '与上句同效
        'Next
        'newini=nothing

        ''设置属性值
        'newIni.ReadIniContent()
        'newIni.SetProperty("Canada ", "4", "country")
        'newIni.Save(, True)
        'newIni = Nothing

        '获取属性的值
        newIni.ReadIniContent()
        MsgBox(newIni.strGetProperty("Canada", "countries"))
        newIni = Nothing
    End Sub

 

 

0

阅读 收藏 喜欢 打印举报/Report
  

新浪BLOG意见反馈留言板 欢迎批评指正

新浪简介 | About Sina | 广告服务 | 联系我们 | 招聘信息 | 网站律师 | SINA English | 产品答疑

新浪公司 版权所有