标签： RFC5646

今天回趟家，顺便看看以前的代码……

Imports System.Text
 
''' <summary> 
''' 与语言相关的实用工具。 
''' </summary> 
Public Class Locale 
    ''' <summary> 
    ''' 将指定的语言标识格式化为标准格式。 
    ''' </summary> 
    ''' <param name="languageTag">待格式化的符合 BCP47 或 UTS#35 要求的语言标识。</param> 
    ''' <returns>符合 BCP47(RFC5646) 建议（如大小写建议）的语言标识。如果 <paramref name="languageTag" /> 为 <c>null</c>，则返回空字符串。</returns> 
    Public Shared Function FormatTag(ByVal languageTag As String) As String
        'An implementation can reproduce this format without accessing the registry as follows. 
        'All subtags, including extension and private use subtags, 
        'use lowercase letters with two exceptions:  
        'two-letter and four-letter subtags that neither  
        'appear at the start of the tag nor occur after singletons. 
        'Such two-letter subtags are all uppercase (as in the tags "en-CA-x-ca" or "sgn-BE-FR")  
        'and four-letter subtags are titlecase (as in the tag "az-Latn-x-latn").  
        Dim builder As New StringBuilder(languageTag) 
        Dim startIndex As Integer       '段开始的位置 
        Dim afterSingleton As Boolean   '标记是否之前出现了单个字符的段（可能表示私有用途） 
        With builder 
            For I = 0 To .Length - 1 
                If .Chars(I) = "_"c Then
                    '将 Unicode 允许的下划线分隔转化为横杠 
                    .Chars(I) = "-"c 
                End If
                If .Chars(I) = "-"c Then
                    '分隔符 
                    '小结 
                    Dim segmentLength = I - startIndex      '段长 
                    If segmentLength = 1 Then afterSingleton = True
                    If Not afterSingleton AndAlso startIndex > 0 Then
                        '不是第一段 
                        If segmentLength = 2 Then
                            '大写（区域） 
                            .Chars(I - 1) = Char.ToUpperInvariant(.Chars(I - 1)) 
                            .Chars(I - 2) = Char.ToUpperInvariant(.Chars(I - 2)) 
                        ElseIf segmentLength = 4 Then
                            '首字母大写（脚本） 
                            .Chars(startIndex) = Char.ToUpperInvariant(.Chars(startIndex)) 
                        End If
                    End If
                    startIndex = I + 1 
                Else
                    '小写 
                    .Chars(I) = Char.ToLowerInvariant(.Chars(I)) 
                End If
            Next
            Return .ToString 
        End With
    End Function
    
    ''' <summary> 
    ''' 将指定的语言标记进行回退（fallback）。 
    ''' </summary> 
    ''' <param name="languageTag">待回退的、符合 BCP47(RFC5646) 要求（除大小写外）语言标记。</param> 
    ''' <returns>符合 BCP47(RFC4647) 建议的回退后的语言标记。如果指定的语言标记为空、<c>null</c>，或已无法回退，则返回空字符串。</returns> 
    Public Shared Function Fallback(ByVal languageTag As String) As String
        'In the lookup scheme, the language range is progressively truncated 
        'from the end until a matching language tag is located.  Single letter 
        'or digit subtags (including both the letter 'x', which introduces 
        'private-use sequences, and the subtags that introduce extensions) are 
        'removed at the same time as their closest trailing subtag. 
        If languageTag = Nothing Then
            Return ""
        Else
            Dim LastSeparator = languageTag.LastIndexOf("-"c) 
            If LastSeparator = -1 Then
                '未找到 
                Return ""
            Else
                '存在横杠，至少 languageTag = "-" 
                Dim RV = languageTag.Substring(0, LastSeparator) 
                If RV.Length >= 2 AndAlso RV(RV.Length - 2) = "-"c Then
                    '末端存在单个字符，继续回退 
                    Return Fallback(RV) 
                ElseIf RV.Length = 1 Then
                    '单个字符，直接回退 
                    Return ""
                Else
                    Return RV 
                End If
            End If
        End If
    End Function
    
    Private Sub New() 
    
    End Sub
End Class