1 #Region "Microsoft.VisualBasic::800e31560b0c188e953893216e2f677e, Microsoft.VisualBasic.Core\ApplicationServices\Tools\Network\DomainParser.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Structure DomainName
35     
36     '         Properties: Domain, Invalid, TLD
37     
38     '         Constructor: (+1 OverloadsSub New
39     '         FunctionToString
40     
41     '     Module DomainParser
42     
43     '         Function: Trim, TrimPathAndQuery, (+2 OverloadsTryParse
44     
45     
46     ' /********************************************************************************/
47
48 #End Region
49
50 Imports Microsoft.VisualBasic.ComponentModel.Collection.Generic
51 Imports Microsoft.VisualBasic.Language
52
53 Namespace Net
54
55     Public Structure DomainName : Implements IKeyValuePairObject(Of StringString)
56
57         Public Property Domain As String Implements IKeyValuePairObject(Of StringString).Key
58         ''' <summary>
59         ''' 顶级域名
60         ''' </summary>
61         ''' <returns></returns>
62         Public Property TLD As String Implements IKeyValuePairObject(Of StringString).Value
63
64         Sub New(url As String)
65             url = TryParse(url)
66             Dim Tokens As String() = url.Split(CChar("."))
67             Domain = Tokens(0)
68             TLD = Tokens.Skip(1).JoinBy(".")
69         End Sub
70
71         Public ReadOnly Property Invalid As Boolean
72             Get
73                 Return (String.IsNullOrEmpty(Domain) OrElse String.IsNullOrEmpty(TLD))
74             End Get
75         End Property
76
77         Public Overrides Function ToString() As String
78             Return $"{Domain}.{TLD}"
79         End Function
80     End Structure
81
82     ''' <summary>
83     ''' http://sub.domain.com/somefolder/index.html -> domain.com
84     ''' somedomain.info -> somedomain.info
85     ''' http://anotherdomain.org/home -> anotherdomain.org
86     ''' www.subdomain.anothersubdomain.maindomain.com/something/ -> maindomain.com
87     ''' </summary>
88     Public Module DomainParser
89
90         ''' <summary>
91         ''' 解析错误会返回空字符串
92         ''' </summary>
93         ''' <param name="url"></param>
94         ''' <returns></returns>
95         Public Function TryParse(url As StringOptional preserveSubdomain As Boolean = FalseAs String
96             url = Trim(url)
97             url = TrimPathAndQuery(url, preserveSubdomain)
98             Return url
99         End Function
100
101         Public Function TryParse(url As Value(Of String), ByRef DomainName As DomainName) As Boolean
102             If String.IsNullOrEmpty(url = TryParse(+url)) Then
103                 Return False
104             End If
105
106             DomainName = New DomainName(+url)
107             Return True
108         End Function
109
110         Private Function TrimPathAndQuery(url As String, preserveSubdomain As BooleanAs String
111             url = url.Split(CChar("/")).First
112
113             If preserveSubdomain Then
114                 Return url
115             End If
116
117             Dim tokens As New List(Of String)(url.Split(CChar(".")))
118
119             If tokens.Count = 2 Then
120                 Return url
121             ElseIf tokens.Count = 1 Then
122                 Return ""
123             End If
124
125             ' 剩下的这些事token数量大于等于3的情况
126             Dim tld2 As String = tokens(tokens.Count - 2)  ' 处理类似于.com.cn这种情况
127
128             ' .com.cn
129             ' .co.uk
130             ' .ac.cn
131             If InStr("co|ac|com|org|net|edu", tld2, CompareMethod.Text) > 0 Then  ' .com.cn,,..co.uk的情况,则直接返回
132                 ' 取最后的三个token
133                 If tokens.Count > 3 Then
134                     tokens = New List(Of String)(tokens.GetRange(tokens.Count - 3, 3))
135                 End If
136                 url = String.Join(".", tokens.ToArray)
137             Else
138                 url = $"{tokens(tokens.Count - 2)}.{tokens(tokens.Count - 1)}"
139             End If
140
141             Return url
142         End Function
143
144         Private Function Trim(url As StringAs String
145
146             For Each protocol As String In {"http://""file://""https://""ftp://"}
147                 If InStr(url, protocol, CompareMethod.Text) = 1 Then
148                     url = Mid(url, Len(protocol) + 1)
149                     Return url
150                 End If
151             Next
152
153             If InStr(url, "mailto://", CompareMethod.Text) = 1 Then
154                 url = url.Split("@"c).Last
155             End If
156
157             Return url
158         End Function
159     End Module
160 End Namespace