16,716
社区成员
发帖
与我相关
我的任务
分享
Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
Namespace Domain.Text
''' <summary>
''' Punycode IDN编码操作
''' </summary>
Public Class Punycode
' Punycode parameters
Shared TMIN As Integer = 1
Shared TMAX As Integer = 26
Shared BASE As Integer = 36
Shared INITIAL_N As Integer = 128
Shared INITIAL_BIAS As Integer = 72
Shared DAMP As Integer = 700
Shared SKEW As Integer = 38
Shared DELIMITER As Char = "-"c
Public Shared Function EncodingDomain(domain As String) As String
domain = domain.Replace("。", ".")
Dim domainArray As String() = domain.Split(New String() {"."}, StringSplitOptions.None)
Dim result As String = ""
For Each item As String In domainArray
If item = "" Then
result += "."
Continue For
End If
result += "xn--" & Encode(item) & "."
Next
If result(result.Length - 1) = "."c Then
result = result.Substring(0, result.Length - 1)
End If
Return result
End Function
Public Shared Function DecodingDomain(domain As String) As String
domain = domain.Replace("。", ".")
Dim domainArray As String() = domain.Split(New String() {"."}, StringSplitOptions.None)
Dim result As String = ""
For Each item As String In domainArray
If item = "" Then
result += "."
Continue For
End If
Dim item2 As String = item
If item2.Length > 4 AndAlso item2.Substring(0, 4) = "xn--" Then
result += Decode(item2.Substring(4, item2.Length - 4)) + "."
End If
Next
If result(result.Length - 1) = "." Then
result = result.Substring(0, result.Length - 1)
End If
Return result
End Function
Public Shared Function Encode(inputStr As String) As String
Dim n As Integer = INITIAL_N
Dim delta As Integer = 0
Dim bias As Integer = INITIAL_BIAS
Dim output As New StringBuilder()
' Copy all basic code points to the output
Dim b As Integer = 0
For i As Integer = 0 To inputStr.Length - 1
Dim c As Char = inputStr(i)
If isBasic(c) Then
output.Append(c)
b += 1
End If
Next
' Append delimiter
If b > 0 Then
output.Append(DELIMITER)
End If
Dim h As Integer = b
While h < inputStr.Length
Dim m As Integer = Integer.MaxValue
' Find the minimum code point >= n
For i As Integer = 0 To inputStr.Length - 1
Dim c As Integer = AscW(inputStr.Substring(i, 1))
If c >= n AndAlso c < m Then
m = c
End If
Next
If m - n > (Integer.MaxValue - delta) \ (h + 1) Then
Throw New Exception("OVERFLOW")
End If
delta = delta + (m - n) * (h + 1)
n = m
For j As Integer = 0 To inputStr.Length - 1
Dim c As Integer = AscW(inputStr.Substring(j, 1))
If c < n Then
delta += 1
If 0 = delta Then
Throw New Exception("OVERFLOW")
End If
End If
If c = n Then
Dim q As Integer = delta
Dim k As Integer = BASE
While True
Dim t As Integer
If k <= bias Then
t = TMIN
ElseIf k >= bias + TMAX Then
t = TMAX
Else
t = k - bias
End If
If q < t Then
Exit While
End If
output.Append(ChrW(digit2codepoint(t + (q - t) Mod (BASE - t))))
q = (q - t) \ (BASE - t)
k += BASE
End While
output.Append(ChrW(digit2codepoint(q)))
bias = adapt(delta, h + 1, h = b)
delta = 0
h += 1
End If
Next
delta += 1
n += 1
End While
Return output.ToString()
End Function
Public Shared Function Decode(input As String) As String
Dim n As Integer = INITIAL_N
Dim i As Integer = 0
Dim bias As Integer = INITIAL_BIAS
Dim output As New StringBuilder()
Dim d As Integer = input.LastIndexOf(DELIMITER)
If d > 0 Then
For j As Integer = 0 To d - 1
Dim c As Char = input(j)
If Not isBasic(c) Then
Throw New Exception("BAD_INPUT")
End If
output.Append(c)
Next
d += 1
Else
d = 0
End If
While d < input.Length
Dim oldi As Integer = i
Dim w As Integer = 1
Dim k As Integer = BASE
While True
If d = input.Length Then
Throw New Exception("BAD_INPUT")
End If
Dim c As Integer = AscW(input.Substring(d, 1))
d = d + 1
Dim digit As Integer = codepoint2digit(c)
If digit > (Integer.MaxValue - i) \ w Then
Throw New Exception("OVERFLOW")
End If
i = i + digit * w
Dim t As Integer
If k <= bias Then
t = TMIN
ElseIf k >= bias + TMAX Then
t = TMAX
Else
t = k - bias
End If
If digit < t Then
Exit While
End If
w = w * (BASE - t)
k += BASE
End While
bias = adapt(i - oldi, output.Length + 1, oldi = 0)
If i \ (output.Length + 1) > Integer.MaxValue - n Then
Throw New Exception("OVERFLOW")
End If
n = n + i \ (output.Length + 1)
i = i Mod (output.Length + 1)
output.Insert(i, ChrW(n))
i += 1
End While
Return output.ToString()
End Function
Private Shared Function adapt(delta As Integer, numpoints As Integer, first As Boolean) As Integer
If first Then
delta = delta \ DAMP
Else
delta = delta \ 2
End If
delta = delta + (delta \ numpoints)
Dim k As Integer = 0
While delta > ((BASE - TMIN) * TMAX) \ 2
delta = delta \ (BASE - TMIN)
k = k + BASE
End While
Return k + ((BASE - TMIN + 1) * delta) \ (delta + SKEW)
End Function
Private Shared Function isBasic(c As Char) As Boolean
Return AscW(c) < &H80
End Function
Private Shared Function digit2codepoint(d As Integer) As Integer
If d < 26 Then
' 0..25 : 'a'..'z'
Return d + Asc("a"c)
ElseIf d < 36 Then
' 26..35 : '0'..'9';
Return d - 26 + Asc("0"c)
Else
Throw New Exception("BAD_INPUT")
End If
End Function
Private Shared Function codepoint2digit(c As Integer) As Integer
If c - Asc("0"c) < 10 Then
' '0'..'9' : 26..35
Return c - Asc("0"c) + 26
ElseIf c - Asc("a"c) < 26 Then
' 'a'..'z' : 0..25
Return c - Asc("a"c)
Else
Throw New Exception("BAD_INPUT")
End If
End Function
End Class
End Namespace