ini.vb

文件复制器 2007.07.28.0最新VB源代码 地狱门神(F.R.C.) 适用范围 Windows环境下

                TempString = TheCol.Section.Item(Key)
            Catch
                Return False
            End Try
        Else
            Return False
        End If
        Dim Temp As String()
        If Not TempString.StartsWith("@") Then
            If TempString = "" Then Return True
            Temp = TempString.Split(",")
            If Value Is Nothing OrElse Value.GetUpperBound(0) <> Temp.GetUpperBound(0) Then Value = New String(Temp.GetUpperBound(0)) {}
            For n As Integer = 0 To Math.Min(Value.GetUpperBound(0), Temp.GetUpperBound(0))
                Temp(n) = Temp(n).Replace("\a", Chr(7))
                Temp(n) = Temp(n).Replace("\b", Back)
                Temp(n) = Temp(n).Replace("\t", Tab)
                Temp(n) = Temp(n).Replace("\r", Cr)
                Temp(n) = Temp(n).Replace("\v", VerticalTab)
                Temp(n) = Temp(n).Replace("\f", Chr(12))
                Temp(n) = Temp(n).Replace("\n", Lf)
                Temp(n) = Temp(n).Replace("\e", Chr(27))
                Temp(n) = Temp(n).Replace("\b", Back)
                Index = Temp(n).IndexOf("\x")
                While Not (Index < 0 OrElse Index > Temp(n).Length - 3)
                    Dim TempSubstring As String = Temp(n).Substring(Index + 2, 2)
                    Temp(n) = Temp(n).Replace("\x" & TempSubstring, Chr(CInt("&H" & TempSubstring)))
                    Index = Temp(n).IndexOf("\x")
                End While
                Value(n) = Temp(n)
            Next
        Else
            TempString = TempString.Remove(0, 1)
            If TempString = "" Then Return True
            Temp = TempString.Split(",")
            If Value Is Nothing OrElse Value.GetUpperBound(0) <> Temp.GetUpperBound(0) Then Value = New String(Temp.GetUpperBound(0)) {}
            For n As Integer = 0 To Math.Min(Value.GetUpperBound(0), Temp.GetUpperBound(0))
                Value(n) = Temp(n)
            Next
        End If
        Return True
    End Function
    Public Function ReadValue(ByVal SectionToRead As String, ByVal Key As String, ByRef Value As String(,)) As Boolean
        '读数据
        Dim TheCol As SectionBase
        If SectionToRead = "" Then
            TheCol = NoneNameSection
        Else
            If Root.Contains(SectionToRead) Then
                TheCol = Root.Item(SectionToRead)
            Else
                Return False
            End If
        End If
        Dim TempString As String
        Dim Index As Integer
        If (Key <> "") AndAlso (TheCol.Section.Contains(Key)) Then
            Try
                TempString = TheCol.Section.Item(Key)
            Catch
                Return False
            End Try
        Else
            Return False
        End If
        If Value Is Nothing Then Return False
        Dim TempLine As String()
        Dim Temp As String()
        If Not TempString.StartsWith("@") Then
            If TempString = "" Then Return True
            TempLine = TempString.Replace(Environment.NewLine, Lf).Split(Lf)
            For n As Integer = 0 To Math.Min(Value.GetUpperBound(1), TempLine.GetUpperBound(0))
                Temp = TempLine(n).Split(",")
                For m As Integer = 0 To Math.Min(Value.GetUpperBound(0), Temp.GetUpperBound(0))
                    Temp(m) = Temp(m).Replace("\a", Chr(7))
                    Temp(m) = Temp(m).Replace("\b", Back)
                    Temp(m) = Temp(m).Replace("\t", Tab)
                    Temp(m) = Temp(m).Replace("\r", Cr)
                    Temp(m) = Temp(m).Replace("\v", VerticalTab)
                    Temp(m) = Temp(m).Replace("\f", Chr(12))
                    Temp(m) = Temp(m).Replace("\n", Lf)
                    Temp(m) = Temp(m).Replace("\e", Chr(27))
                    Temp(m) = Temp(m).Replace("\b", Back)
                    Index = Temp(m).IndexOf("\x")
                    While Not (Index < 0 OrElse Index > Temp(m).Length - 3)
                        Dim TempSubstring As String = Temp(m).Substring(Index + 2, 2)
                        Temp(m) = Temp(m).Replace("\x" & TempSubstring, Chr(CInt("&H" & TempSubstring)))
                        Index = Temp(m).IndexOf("\x")
                    End While
                    Value(m, n) = Temp(m)
                Next
            Next
        Else
            TempString = TempString.Remove(0, 1)
            If TempString = "" Then Return True
            TempLine = TempString.Replace(Environment.NewLine, Lf).Split(Lf)
            For n As Integer = 0 To Math.Min(Value.GetUpperBound(1), TempLine.GetUpperBound(0))
                Temp = TempLine(n).Split(",")
                For m As Integer = 0 To Math.Min(Value.GetUpperBound(0), Temp.GetUpperBound(0))
                    Value(m, n) = Temp(m)
                Next
            Next
        End If
        Return True
    End Function
    Public Sub WriteValue(ByVal SectionToWrite As String, ByVal Key As String, ByVal Value As String, Optional ByVal TransferMeaning As Boolean = True)
        Dim TheCol As SectionBase
        If SectionToWrite = "" Then
            TheCol = NoneNameSection
        Else
            If Root.Contains(SectionToWrite) Then
                TheCol = Root.Item(SectionToWrite)
            Else
                ReDim Preserve Section(Section.GetUpperBound(0) + 1)
                Section(Section.GetUpperBound(0)) = SectionToWrite
                Root.Add(SectionToWrite, New SectionBase)
                TheCol = Root.Item(SectionToWrite)
            End If
        End If
        Dim KeyAdd As Boolean
        KeyAdd = (TheCol.Key Is Nothing) OrElse (Not TheCol.Section.Contains(Key.Trim(" ")))
        If KeyAdd = False Then
            TheCol.Section.Remove(Key.Trim(" "))
        Else
            If Not TheCol.Key Is Nothing Then
                ReDim Preserve TheCol.Key(TheCol.Key.GetUpperBound(0) + 1)
            Else
                ReDim TheCol.Key(0)
            End If
            TheCol.Key(TheCol.Key.GetUpperBound(0)) = Key.Trim(" ")
        End If
        Dim TempString As String = ""
        If Value <> "" Then TempString = Value.Trim(" ")
        If TransferMeaning Then
            TempString = TempString.Replace(";", "\x3B")
            TempString = TempString.Replace("#", "\x23")
            TempString = TempString.Replace("//", "\x2F\x2F")
            TempString = TempString.Replace("/*", "\x2F\x2A")
            TempString = TempString.Replace("*/", "\x2A\x2F")
            TempString = TempString.Replace("{", "\x7B")
            TempString = TempString.Replace("}", "\x7D")
            TempString = TempString.Replace("@", "\x40")
            TempString = TempString.Replace("$", "\x24")
            TempString = TempString.Replace("\", "\x5C")
            TempString = TempString.Replace(Chr(7), "\a")
            TempString = TempString.Replace(Back, "\b")
            TempString = TempString.Replace(Tab, "\t")
            TempString = TempString.Replace(Cr, "\r")
            TempString = TempString.Replace(VerticalTab, "\v")
            TempString = TempString.Replace(Chr(12), "\f")
            TempString = TempString.Replace(Lf, "\n")
            TempString = TempString.Replace(Chr(27), "\e")
            TempString = TempString.Replace(Back, "\b")
        Else
            TempString = "@" & TempString
        End If
        TheCol.Section.Add(Key.Trim(" "), TempString)
    End Sub
    Public Sub WriteValue(ByVal SectionToWrite As String, ByVal Key As String, ByVal Value As String())
        If Value Is Nothing OrElse Value.GetLength(0) = 0 Then
            Return
        End If
        Dim s As New StringBuilder
        For x As Integer = 0 To Value.GetUpperBound(0) - 1
            s.Append(Value(x) & ",")
        Next
        s.Append(Value(Value.GetUpperBound(0)))
        WriteValue(SectionToWrite, Key, s.ToString)
    End Sub
    Public Sub WriteValue(ByVal SectionToWrite As String, ByVal Key As String, ByVal Value As String(,))
        If Value Is Nothing OrElse Value.GetLength(0) = 0 OrElse Value.GetLength(1) = 0 Then
            Return
        End If
        Dim s As New StringBuilder
        For y As Integer = 0 To Value.GetUpperBound(1) - 1
            For x As Integer = 0 To Value.GetUpperBound(0) - 1
                s.Append(Value(x, y) & ",")
            Next
            s.Append(Value(Value.GetUpperBound(0), y) & Environment.NewLine)
        Next
        For x As Integer = 0 To Value.GetUpperBound(0) - 1
            s.Append(Value(x, Value.GetUpperBound(1)) & ",")
        Next
        s.Append(Value(Value.GetUpperBound(0), Value.GetUpperBound(1)))
        WriteValue(SectionToWrite, Key, s.ToString(), False)
    End Sub
    Public Function WriteToFile(Optional ByVal Comment As String = "") As Boolean
        Dim Temp As String
        Dim StringToWrite As String = ""
        If Not (NoneNameSection.Key Is Nothing) Then
            For m As Integer = 0 To NoneNameSection.Key.GetUpperBound(0)
                StringToWrite &= NoneNameSection.Key(m) & " = "
                Temp = NoneNameSection.Section.Item(m + 1)
                If Temp.StartsWith("@") AndAlso Temp.Contains(Lf) Then
                    Temp = "{" & Environment.NewLine & Temp.Remove(0, 1) & Environment.NewLine & "}"
                End If
                StringToWrite &= Temp
                StringToWrite &= Environment.NewLine
            Next
            StringToWrite &= Environment.NewLine
        End If
        Dim TheCol As SectionBase
        For n As Integer = 0 To Section.GetUpperBound(0)
            TheCol = Root.Item(Section(n))
            If Not (TheCol.Key Is Nothing) Then
                StringToWrite &= "[" & Section(n) & "]" & Environment.NewLine
                For m As Integer = 0 To TheCol.Key.GetUpperBound(0)
                    StringToWrite &= TheCol.Key(m) & " = "
                    Temp = TheCol.Section.Item(TheCol.Key(m))
                    If Temp.StartsWith("@") AndAlso Temp.Contains(Lf) Then
                        Temp = "{" & Environment.NewLine & Temp.Remove(0, 1) & Environment.NewLine & "}"
                    End If
                    StringToWrite &= Temp
                    StringToWrite &= Environment.NewLine
                Next
                StringToWrite &= Environment.NewLine
            End If
        Next
        If StringToWrite.Length >= 2 Then
            StringToWrite = StringToWrite.Substring(0, StringToWrite.Length - Environment.NewLine.Length)
        End If

        If Comment <> "" Then
            Dim TempString As String = Comment
            TempString = TempString.Replace("\a", Chr(7))
            TempString = TempString.Replace("\b", Back)
            TempString = TempString.Replace("\t", Tab)
            TempString = TempString.Replace("\r", Cr)
            TempString = TempString.Replace("\v", VerticalTab)
            TempString = TempString.Replace("\f", Chr(12))
            TempString = TempString.Replace("\n", Lf)
            TempString = TempString.Replace("\e", Chr(27))
            TempString = TempString.Replace("\b", Back)
            Dim Index As Integer = TempString.IndexOf("\x")
            While Not (Index < 0 OrElse Index > TempString.Length - 3)
                Dim TempSubstring As String = TempString.Substring(Index + 2, 2)
                TempString = TempString.Replace("\x" & TempSubstring, Chr(CInt("&H" & TempSubstring)))
                Index = TempString.IndexOf("\x")
            End While
            Comment = TempString
        End If

        Dim sw As StreamWriter
        Try
            Dim dir As String = GetFileDirectory(FileName)
            If dir <> "" AndAlso Not IO.Directory.Exists(dir) Then IO.Directory.CreateDirectory(dir)
            sw = New StreamWriter(FileName, False, System.Text.Encoding.Default)
        Catch
            Return False
        End Try
        If Not (Comment Is Nothing OrElse Comment = "") Then
            sw.Write(Comment & Environment.NewLine)
        End If
        sw.Write(StringToWrite)
        sw.Close()
    End Function
    Public Sub SetFileName(ByVal FILE_NAME As String)
        FileName = FILE_NAME
    End Sub
End Class

''' <summary>INI本地化类</summary>
''' <remarks>
''' 本类管理以INI形式存储的本地化字符串
''' 需要的本地化文件格式样例如下：
''' 
''' Program.en.ini
''' [en]
''' Text1 = Hello
''' Text2 = Welldone
''' Text3 = Color
''' 
''' [en-GB]
''' Text3 = Colour
''' 
''' Program.zh-CN.ini
''' [zh-CN]
''' Text1 = 你好
''' Text2 = 棒极了
''' Text3 = 颜色
''' 
''' </remarks>
Public Class INILocalization
    Protected LanRes As INI
    Protected LanFull As String
    ReadOnly Property LanguageIndentiySignFull() As String
        Get
            Return LanFull
        End Get
    End Property
    Protected LanParent As String
    ReadOnly Property LanguageIndentiySignParent() As String
        Get
            Return LanParent
        End Get
    End Property
    Protected LanNative As String
    ReadOnly Property LanguageIndentiySignNative() As String
        Get
            Return LanNative
        End Get
    End Property
    Protected LanDefault As String
    ReadOnly Property DefaultLanguageIndentiySign() As String
        Get
            Return LanDefault
        End Get
    End Property
    Sub New(ByVal LanguageFileMainName As String, ByVal Language As String, Optional ByVal DefaultLanguage As String = "en")
        LanFull = Language
        LanDefault = DefaultLanguage

        If LanFull = "" Then LanFull = Globalization.CultureInfo.InstalledUICulture.Name
        Dim Index As Integer = LanFull.IndexOf("-")
        If Index < 0 Then
            LanParent = LanFull
            LanNative = ""
            LanParent = LanParent.ToLower
            LanFull = LanParent
        Else
            LanParent = LanFull.Substring(0, Index)
            LanNative = LanFull.Substring(Index + 1)
            LanParent = LanParent.ToLower
            LanNative = LanNative.ToUpper
            LanFull = LanParent & "-" & LanNative
        End If

        LanRes = New INI
        LanRes.ReadFromFile(LanguageFileMainName & "." & DefaultLanguage & ".ini")
        LanRes.ReadFromFile(LanguageFileMainName & "." & LanParent & ".ini")
        LanRes.ReadFromFile(LanguageFileMainName & "." & LanFull & ".ini")
    End Sub
    Sub ReadValue(ByVal Key As String, ByRef Value As String)
        LanRes.ReadValue(LanDefault, Key, Value)
        LanRes.ReadValue(LanParent, Key, Value)
        LanRes.ReadValue(LanFull, Key, Value)
    End Sub
End Class