當使用中文網址時，例如：小喵.姍舞之間凝聚.net。如何取得中文的子網域名稱(小喵)，與網域名稱(姍舞之間凝聚.net)，這篇會應用到中文網址的編碼 PunyCode，讓我們看下去
緣起
小喵會寫這篇，是因為一個網友在藍色小舖中詢問了使用中文網址的問題
http://www.blueshop.com.tw/board/FUM20041006161839LRJ/BRD20160104215734ALP.html
小喵於是動手來測試看看，把過程記錄下來，提供大家參考
PunyCode
中文網址在運作時，實際上會由瀏覽器轉碼為PunyCode，然後再進行後續連係，有關PunyCode的部分，可以參考一下維基百科上的內容
https://zh.wikipedia.org/wiki/Punycode
例如：
中文網址：小喵.姍舞之間凝聚.net
PunyCode：xn--i2rr1m.xn--9iqw0ge4i7u5br3b6z0c.net
中文網址測試環境建立
要測試這樣的問題，首先要在自己的機器上建立一個可以使用中文網址的環境。最簡單的方式就是透過 hosts 來處理，檔案位置在【c:\windows\System32\drivers\etc】，將準備的網址填上，指向 127.0.0.1 ，這樣就能夠在本機IIS測試時，用指定的中文網址來替代 localhost。填上需要填 PunyCode轉換後的網址，填上中文會沒有作用。
127.0.0.1 localhost
127.0.0.1 xn--i2rr1m.xn--9iqw0ge4i7u5br3b6z0c.net
PunyCode轉換工具程式
環境有了，接下來就來撰寫，由於需要進行 PunyCode 與 中文 的轉換，所以小喵必須準備一段轉換的程式碼，將他寫成一個類別，未來可以放到專案中，由其他需要的人引用。小喵參考網路上一篇討論，裡面有些小錯誤(Domain轉換的部分，他少處理非中文的部分)，小喵順手將相關問題補好。
新增一個類別，命名為：UtilPunyCode，相關程式如下：
Imports Microsoft.VisualBasic
Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
''' <summary>
''' PunyCode轉換
''' 參考來源：http://bbs.csdn.net/topics/390110788
''' </summary>
''' <remarks></remarks>
Public Class UtilPunyCode
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 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
'檢查是否有無中文
If ChkENC(item) Then
'無中文，只有英數_-
result += item & "."
Else
'有中文
result += "xn--" & Encode(item) & "."
End If
Next
If result(result.Length - 1) = "."c Then
result = result.Substring(0, result.Length - 1)
End If
Return result
End Function
Public 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)) + "."
Else
result &= item2 & "."
End If
Next
If result(result.Length - 1) = "." Then
result = result.Substring(0, result.Length - 1)
End If
Return result
End Function
Public 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 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 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 Function isBasic(c As Char) As Boolean
Return AscW(c) < &H80
End Function
Private 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 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
Private Function ChkENC(item As String) As Boolean
Dim Rc As Boolean = False
Dim Reg As New Regex("^[a-zA-Z0-9_-]+$")
Rc = Reg.IsMatch(item)
Return Rc
End Function
End Class
測試畫面：
小喵準備一個WebForm的畫面來進行測試，安排一個Button，還有幾個Label來顯式結果，aspx的內容如下：
<asp:Button ID="btnProcessUrl" runat="server" Text="處理" /><br />
網址：<asp:Label ID="lblURL" runat="server" Text=""></asp:Label>
<br />
網站：<asp:Label ID="lblSite" runat="server" Text=""></asp:Label>
<br />
子網域：<asp:Label ID="lblSubDomain" runat="server" Text=""></asp:Label><br />
網域：<asp:Label ID="lblDomain" runat="server" Text=""></asp:Label>
接著，就是按鈕Click的程式碼：
Protected Sub btnProcessUrl_Click(sender As Object, e As EventArgs) Handles btnProcessUrl.Click
Me.lblURL.Text = Request.Url.ToString
Dim Host As String = Request.ServerVariables("HTTP_HOST")
Dim oUPC As New UtilPunyCode
Dim ChtHost As String = oUPC.DecodingDomain(Host)
Me.lblSite.Text = ChtHost
Dim sArr() As String = ChtHost.Split(".")
Dim SubDomain As String = sArr(0)
Dim Domain As String = Mid(ChtHost.Replace(SubDomain, ""), 2, Len(ChtHost.Replace(SubDomain, "")) - 1)
Me.lblSubDomain.Text = SubDomain
Me.lblDomain.Text = Domain
End Sub
執行結果如下：
末記
透過這個範例的實做中，小喵從過程中學到兩個東西，一個是中文網址與 PunyCode，另一個是如何從本機上建立中文網址的測試環境，提供給大家參考
^_^
參考來源：
PunyCode轉換：http://bbs.csdn.net/topics/390110788
以下是簽名：
- 歡迎轉貼本站的文章，不過請在貼文主旨上加上【轉貼】，並在文章中附上本篇的超連結與站名【topcat姍舞之間的極度凝聚】，感恩大家的配合。
- 小喵大部分的文章會以小喵熟悉的語言VB.NET撰寫，如果您需要C#的Code，也許您可以試著用線上的工具進行轉換，這裡提供幾個參考
| Microsoft MVP Visual Studio and Development Technologies (2005~2019/6) | topcat Blog:http://www.dotblogs.com.tw/topcat |