1	#Region "Microsoft.VisualBasic::a6727972f3ff5b4685a77b883939bae3, Microsoft.VisualBasic.Core\Text\Parser\HtmlParser\HtmlStrips.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	'     Module HtmlStrips
35	'
36	'         Constructor: (+1 Overloads) Sub New
37	'         Function: GetHtmlComments, GetImageLinks, GetInput, GetInputGroup, GetLinks
38	'                   GetSelectInputGroup, GetSelectOptions, GetSelectValue, GetValue, href
39	'                   HtmlLines, HTMLTitle, img, RemovesCSSstyles, RemovesFooter
40	'                   RemovesHtmlComments, RemovesHtmlHead, RemovesHtmlStrong, RemovesImageLinks, RemovesJavaScript
41	'                   RemoveTags, (+2 Overloads) src, StripHTMLTags, stripTag, TagAttributes
42	'                   TrimResponseTail
43	'
44	'
45	' /********************************************************************************/
46
47	#End Region
48
49	Imports System.Runtime.CompilerServices
50	Imports System.Text
51	Imports System.Text.RegularExpressions
52	Imports Microsoft.VisualBasic.CommandLine.Reflection
53	Imports Microsoft.VisualBasic.ComponentModel.DataSourceModel
54	Imports Microsoft.VisualBasic.Scripting.MetaData
55	Imports Microsoft.VisualBasic.Serialization.JSON
56	Imports r = System.Text.RegularExpressions.Regex
57
58	Namespace Text.HtmlParser
59
60	''' <summary>
61	''' Html text document operations for a given html text
62	''' </summary>
63	Public Module HtmlStrips
64
65	''' <summary>
66	''' 将<paramref name="html"/>文本之中的注释部分的字符串拿出来
67	''' </summary>
68	''' <param name="html"></param>
69	''' <returns></returns>
70	<MethodImpl(MethodImplOptions.AggressiveInlining)>
71	<Extension>
72	Public Function GetHtmlComments(html As String) As String()
73	Return r.Matches(html, "<![-]{2}.+?[-]{2}>", RegexICSng).ToArray
74	End Function
75
76	''' <summary>
77	''' removes all of the html code comments from a given <paramref name="html"/> document.
78	''' </summary>
79	''' <param name="html"></param>
80	''' <returns></returns>
81	<Extension>
82	Public Function RemovesHtmlComments(html As StringBuilder) As StringBuilder
83	For Each comment$ In html.ToString.GetHtmlComments
84	Call html.Replace(comment, "")
85	Next
86
87	Return html
88	End Function
89
90	''' <summary>
91	''' 从html文本之中解析出所有的链接
92	''' </summary>
93	''' <param name="html$"></param>
94	''' <returns></returns>
95	<Extension> Public Function GetLinks(html$) As String()
96	If String.IsNullOrEmpty(html) Then
97	Return New String() {}
98	Else
99	Dim links$() = r _
100	.Matches(html, HtmlLink, RegexICSng) _
101	.ToArray(AddressOf HtmlStrips.GetValue)
102	Return links
103	End If
104	End Function
105
106	Public Const HtmlLink$ = "<a\s.+?</a>"
107	Public Const HtmlPageTitle$ = "<title>.+</title>"
108
109	''' <summary>
110	''' Parsing the title text from the html inputs.
111	''' </summary>
112	''' <param name="html"></param>
113	''' <returns></returns>
114	<Extension> Public Function HTMLTitle(html As String) As String
115	Dim title$ = r.Match(html, HtmlPageTitle, RegexICSng).Value
116
117	If String.IsNullOrEmpty(title) Then
118	title = "null"
119	Else
120	title = title.GetValue.TrimNewLine.Trim(" "c, ASCII.TAB)
121	End If
122
123	Return title
124	End Function
125
126	''' <summary>
127	''' Removes the html tags from the text string.(这个函数会移除所有的html标签)
128	''' </summary>
129	''' <param name="s"></param>
130	''' <returns></returns>
131	<ExportAPI("Html.Tag.Trim"), Extension> Public Function StripHTMLTags(s$, Optional stripBlank As Boolean = False) As String
132	If String.IsNullOrEmpty(s) Then
133	Return ""
134	Else
135	' 在这里将<br/><br>标签替换为换行符
136	' 否则文本的排版可能会乱掉的
137	s = r.Replace(s, "[<][/]?br[>]", vbLf, RegexICSng)
138	s = r.Replace(s, "[<]h\d", vbLf & "<null", RegexICSng)
139	End If
140
141	' 因为js和css都是夹在两个标签之间的，所以会被误认为是文本
142	' 在这里需要使用专门的函数来删除掉
143	s = s.RemovesCSSstyles _
144	.RemovesJavaScript _
145	.RemovesFooter _
146	.RemovesHtmlHead
147
148	s = r.Replace(s, "<[^>]+>", "")
149	s = r.Replace(s, "</[^>]+>", "")
150
151	If stripBlank Then
152	s = s.StripBlank
153	s = r.Replace(s, "(\n){3,}", vbLf & vbLf, RegexICSng)
154	End If
155
156	Return s
157	End Function
158
159	Const HtmlTags$ = "</?.+?(\s+.+?="".+?"")*>"
160	Const hrefPattern$ = "href\s*=\s*[""'].+?[""']"
161
162	''' <summary>
163	''' Gets the link text in the html fragement text.
164	''' </summary>
165	''' <param name="html">A string that contains the url string pattern like: href="url_text"</param>
166	''' <returns></returns>
167	''' <remarks></remarks>
168	'''
169	<ExportAPI("Html.Href")>
170	<Extension> Public Function href(<Parameter("HTML", "A string that contains the url string pattern like: href=""url_text""")> html$) As String
171	If String.IsNullOrEmpty(html) Then
172	Return ""
173	End If
174
175	Dim url$ = r _
176	.Match(html, hrefPattern, RegexOptions.IgnoreCase) _
177	.Value
178
179	If String.IsNullOrEmpty(url) Then
180	Return ""
181	Else
182	Return url.GetTagValue("=", trim:=True).Value.GetStackValue("""", """")
183	End If
184	End Function
185
186	#Region "Parsing image source url from the img html tag."
187
188	Public Const imgHtmlTagPattern As String = "<img.+?src=.+?>"
189
190	<MethodImpl(MethodImplOptions.AggressiveInlining)>
191	<Extension>
192	Public Function GetImageLinks(html As String) As String()
193	Dim list$() = r _
194	.Matches(html, imgHtmlTagPattern, RegexICSng) _
195	.EachValue(Function(img) img.src) _
196	.ToArray
197
198	Return list
199	End Function
200
201	''' <summary>
202	''' Parsing image source url from the img html tag.
203	''' </summary>
204	''' <param name="img"></param>
205	''' <returns></returns>
206	<Extension> Public Function src(img$) As String
207	If String.IsNullOrEmpty(img) Then
208	Return ""
209	Else
210	img = r.Match(img, "src\s*[=]\s*"".+?""", RegexOptions.IgnoreCase).Value
211	End If
212
213	If String.IsNullOrEmpty(img) Then
214	Return ""
215	Else
216	img = img.GetTagValue("=", trim:=True).Value.GetStackValue("""", """")
217	Return img
218	End If
219	End Function
220
221	<MethodImpl(MethodImplOptions.AggressiveInlining)>
222	<Extension>
223	Public Function src(img As (tag$, attrs As NamedValue(Of String)())) As String
224	Return img.attrs.GetByKey("src", True).Value
225	End Function
226
227	<Extension>
228	Public Function img(html$) As (tag$, attrs As NamedValue(Of String)())
229	Return ("img", r.Match(html, imgHtmlTagPattern, RegexICSng).Value.TagAttributes.ToArray)
230	End Function
231	#End Region
232
233	''' <summary>
234	''' 有些时候后面可能会存在多余的vbCrLf，则使用这个函数去除
235	''' </summary>
236	''' <param name="value"></param>
237	''' <returns></returns>
238	<Extension> Public Function TrimResponseTail(value As String) As String
239	If String.IsNullOrEmpty(value) Then
240	Return ""
241	End If
242
243	Dim l% = Len(value)
244	Dim i% = value.LastIndexOf(vbCrLf)
245
246	If i = l - 2 Then
247	Return Mid(value, 1, l - 2)
248	Else
249	Return value
250	End If
251	End Function
252
253	ReadOnly vbCrLfLen% = Len(vbCrLf)
254
255	''' <summary>
256	''' 获取两个尖括号之间的内容
257	''' </summary>
258	''' <param name="html"></param>
259	''' <returns></returns>
260	''' <remarks></remarks>
261	<MethodImpl(MethodImplOptions.AggressiveInlining)>
262	<ExportAPI("Html.GetValue", Info:="Gets the string value between two wrapper character.")>
263	<Extension> Public Function GetValue(html As String) As String
264	Return html.GetStackValue(">", "<")
265	End Function
266
267	<Extension>
268	Public Function GetInput(html$) As NamedValue(Of String)
269	Dim input$ = r.Match(html, "<input.+?>", RegexICSng) _
270	.Value _
271	.Trim("<"c) _
272	.StripHTMLTags(stripBlank:=True)
273	Dim attrs = input.TagAttributes.ToArray
274	Dim name$ = attrs.GetByKey("name", True).Value
275	Dim value$ = attrs.GetByKey("value", True).Value
276	Dim title$ = attrs.GetByKey("title", True).Value
277
278	Return New NamedValue(Of String) With {
279	.Name = name,
280	.Value = value,
281	.Description = title
282	}
283	End Function
284
285	<Extension>
286	Public Iterator Function GetInputGroup(html$) As IEnumerable(Of NamedValue(Of String))
287	Dim inputs$() = r.Matches(html, "<input.+?>", RegexICSng).ToArray
288
289	For Each input As String In inputs
290	Yield input.GetInput
291	Next
292	End Function
293
294	Public Function GetSelectOptions(html) As NamedCollection(Of String)
295	Throw New NotImplementedException
296	End Function
297
298	Const selected$ = " " & NameOf(selected)
299
300	Public Function GetSelectValue(html$) As NamedValue(Of String)
301	Dim select$ = r.Match(html, "<select.+?/select", RegexICSng).Value
302	Dim options$() = r.Matches([select], "<option.+?>", RegexICSng).ToArray
303
304	[select] = r.Match([select], "<select.*?>", RegexICSng).Value
305
306	Dim attrs = [select].TagAttributes.ToArray
307	Dim name$ = attrs.GetByKey("name", True).Value
308	Dim value$ = options _
309	.Where(Function(s)
310	Return InStr(s, selected, CompareMethod.Text) > 0
311	End Function) _
312	.FirstOrDefault _
313	?.Replace(selected, "") _
314	.TagAttributes _
315	.GetByKey("value", True) _
316	.Value
317
318	Return New NamedValue(Of String) With {
319	.Name = name,
320	.Value = value
321	}
322	End Function
323
324	<MethodImpl(MethodImplOptions.AggressiveInlining)>
325	<Extension>
326	Public Function GetSelectInputGroup(html$) As NamedValue(Of String)()
327	Return r _
328	.Matches(html, "<select.+?/select", RegexICSng) _
329	.ToArray _
330	.Select(AddressOf GetSelectValue) _
331	.ToArray
332	End Function
333
334	' <br><br/>
335	''' <summary>
336	''' The line break html tag in the html document.
337	''' </summary>
338	Const LineFeed$ = "(<br>)|(<br\s*/>)"
339
340	''' <summary>
341	''' Split the html text into lines by tags: ``&lt;br>`` or ``&lt;br/>``
342	''' </summary>
343	''' <param name="html$"></param>
344	''' <returns></returns>
345	<Extension>
346	Public Function HtmlLines(html$) As String()
347	If html.StringEmpty Then
348	Return {}
349	Else
350	Return Regex.Split(html, LineFeed, RegexICSng)
351	End If
352	End Function
353
354	' <area shape=rect coords=40,45,168,70 href="/dbget-bin/www_bget?hsa05034" title="hsa05034: Alcoholism" onmouseover="popupTimer(&quot;hsa05034&quot;, &quot;hsa05034: Alcoholism&quot;, &quot;#ffffff&quot;)" onmouseout="hideMapTn()" />
355	''' <summary>
356	''' The regexp pattern for the attributes in a html tag.
357	''' </summary>
358	Const attributeParse$ = "(\S+?\s*[=]\s*"".+?"")|(\S+?\s*[=]\s*\S+)"
359
360	<Extension>
361	Private Function stripTag(ByRef tag$) As String
362	If tag Is Nothing Then
363	tag = ""
364	Else
365	tag = tag _
366	.Trim("<"c) _
367	.Trim(">"c) _
368	.Trim("/"c)
369	End If
370	Return tag
371	End Function
372
373	''' <summary>
374	''' 获取一个html标签之中的所有的attribute属性数据
375	''' </summary>
376	''' <param name="tag$"></param>
377	''' <returns></returns>
378	<MethodImpl(MethodImplOptions.AggressiveInlining)>
379	<Extension>
380	Public Function TagAttributes(tag As String) As IEnumerable(Of NamedValue(Of String))
381	Return Regex _
382	.Matches(tag.GetBetween("<", ">"), attributeParse, RegexICSng) _
383	.EachValue _
384	.Select(Function(t) t.GetTagValue("=", trim:=""""""))
385	End Function
386
387	''' <summary>
388	''' 将<paramref name="html"/>中的``&lt;script>&lt;/script>``代码块删除
389	''' </summary>
390	''' <param name="html$"></param>
391	''' <returns></returns>
392	<MethodImpl(MethodImplOptions.AggressiveInlining)>
393	<Extension>
394	Public Function RemovesJavaScript(html As String) As String
395	' <script>
396	Return html.RemoveTags("script")
397	End Function
398
399	''' <summary>
400	''' Removes all of the ``&lt;style>`` css styles block from a given <paramref name="html"/> document.
401	''' </summary>
402	''' <param name="html"></param>
403	''' <returns></returns>
404	<MethodImpl(MethodImplOptions.AggressiveInlining)>
405	<Extension>
406	Public Function RemovesCSSstyles(html As String) As String
407	' <style>
408	Return html.RemoveTags("style")
409	End Function
410
411	''' <summary>
412	''' Removes all of the ``&lt;img>`` image links block from a given <paramref name="html"/> document.
413	''' </summary>
414	''' <param name="html"></param>
415	''' <returns></returns>
416	<MethodImpl(MethodImplOptions.AggressiveInlining)>
417	<Extension>
418	Public Function RemovesImageLinks(html As String) As String
419	' <img>
420	Return html.RemoveTags("img")
421	End Function
422
423	<MethodImpl(MethodImplOptions.AggressiveInlining)>
424	<Extension>
425	Public Function RemovesHtmlHead(html As String) As String
426	' <head>
427	Return html.RemoveTags("head")
428	End Function
429
430	<MethodImpl(MethodImplOptions.AggressiveInlining)>
431	<Extension>
432	Public Function RemovesFooter(html As String) As String
433	' <footer>
434	Return html.RemoveTags("footer")
435	End Function
436
437	<MethodImpl(MethodImplOptions.AggressiveInlining)>
438	<Extension>
439	Public Function RemovesHtmlStrong(html As String) As String
440	Dim buffer As New StringBuilder(html)
441
442	For Each m As Match In r.Matches(html, "(<[/]?strong>)|(<[/]?b>)", RegexICSng)
443	buffer.Replace(m.Value, "")
444	Next
445
446	Return buffer.ToString
447	End Function
448
449	Sub New()
450	RegexpTimeout = 5
451	End Sub
452
453	<Extension>
454	Public Function RemoveTags(html$, ParamArray tags$()) As String
455	For Each tag As String In tags
456
457	' img 标签可能会在这里超时，如果没有<img></img>的话
458	' 则直接忽略掉这个错误
459	Try
460	html = r.Replace(html, $"<{tag}.*?>.*?</{tag}>", "", RegexICSng)
461	Catch ex As Exception When TypeOf ex Is TimeoutException
462	Call App.LogException(ex, tags.GetJson)
463	Catch ex As Exception
464	Throw ex
465	End Try
466
467	html = r.Replace(html, $"<{tag}.*?>", "", RegexICSng)
468	Next
469
470	Return html
471	End Function
472	End Module
473	End Namespace