今天回趟家，顺便看看以前的代码……
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
