1 #Region "Microsoft.VisualBasic::7d9335dfdc1513a79a8d1526d7c24167, 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 OverloadsSub New
37     '         FunctionGetHtmlComments, 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 StringAs 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 StringAs 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 = FalseAs 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=[""'].+?[""']"
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                 url = Mid(url, 6)
183                 url = Mid(url, 2, Len(url) - 2)
184                 Return url
185             End If
186         End Function
187
188 #Region "Parsing image source url from the img html tag."
189
190         Public Const imgHtmlTagPattern As String = "<img.+?src=.+?>"
191
192         <MethodImpl(MethodImplOptions.AggressiveInlining)>
193         <Extension>
194         Public Function GetImageLinks(html As StringAs String()
195             Dim list$() = r _
196                 .Matches(html, imgHtmlTagPattern, RegexICSng) _
197                 .EachValue(Function(img) img.src) _
198                 .ToArray
199
200             Return list
201         End Function
202
203         ''' <summary>
204         ''' Parsing image source url from the img html tag.
205         ''' </summary>
206         ''' <param name="img"></param>
207         ''' <returns></returns>
208         <Extension> Public Function src(img$) As String
209             If String.IsNullOrEmpty(img) Then
210                 Return ""
211             Else
212                 img = Regex.Match(img, "src="".+?""", RegexOptions.IgnoreCase).Value
213             End If
214
215             If String.IsNullOrEmpty(img) Then
216                 Return ""
217             Else
218                 img = Mid(img, 5)
219                 img = Mid(img, 2, Len(img) - 2)
220                 Return img
221             End If
222         End Function
223
224         <MethodImpl(MethodImplOptions.AggressiveInlining)>
225         <Extension>
226         Public Function src(img As (tag$, attrs As NamedValue(Of String)())) As String
227             Return img.attrs.GetByKey("src"True).Value
228         End Function
229
230         <Extension>
231         Public Function img(html$) As (tag$, attrs As NamedValue(Of String)())
232             Return ("img", r.Match(html, imgHtmlTagPattern, RegexICSng).Value.TagAttributes.ToArray)
233         End Function
234 #End Region
235
236         ''' <summary>
237         ''' 有些时候后面可能会存在多余的vbCrLf,则使用这个函数去除
238         ''' </summary>
239         ''' <param name="value"></param>
240         ''' <returns></returns>
241         <Extension> Public Function TrimResponseTail(value As StringAs String
242             If String.IsNullOrEmpty(value) Then
243                 Return ""
244             End If
245
246             Dim l% = Len(value)
247             Dim i% = value.LastIndexOf(vbCrLf)
248
249             If i = l - 2 Then
250                 Return Mid(value, 1, l - 2)
251             Else
252                 Return value
253             End If
254         End Function
255
256         ReadOnly vbCrLfLen% = Len(vbCrLf)
257
258         ''' <summary>
259         ''' 获取两个尖括号之间的内容
260         ''' </summary>
261         ''' <param name="html"></param>
262         ''' <returns></returns>
263         ''' <remarks></remarks>
264         <MethodImpl(MethodImplOptions.AggressiveInlining)>
265         <ExportAPI("Html.GetValue"Info:="Gets the string value between two wrapper character.")>
266         <Extension> Public Function GetValue(html As StringAs String
267             Return html.GetStackValue(">""<")
268         End Function
269
270         <Extension>
271         Public Function GetInput(html$) As NamedValue(Of String)
272             Dim input$ = r.Match(html, "<input.+?>", RegexICSng) _
273                 .Value _
274                 .Trim("<"c) _
275                 .StripHTMLTags(stripBlank:=True)
276             Dim attrs = input.TagAttributes.ToArray
277             Dim name$ = attrs.GetByKey("name"True).Value
278             Dim value$ = attrs.GetByKey("value"True).Value
279             Dim title$ = attrs.GetByKey("title"True).Value
280
281             Return New NamedValue(Of StringWith {
282                 .Name = name,
283                 .Value = value,
284                 .Description = title
285             }
286         End Function
287
288         <Extension>
289         Public Iterator Function GetInputGroup(html$) As IEnumerable(Of NamedValue(Of String))
290             Dim inputs$() = r.Matches(html, "<input.+?>", RegexICSng).ToArray
291
292             For Each input As String In inputs
293                 Yield input.GetInput
294             Next
295         End Function
296
297         Public Function GetSelectOptions(html) As NamedCollection(Of String)
298             Throw New NotImplementedException
299         End Function
300
301         Const selected$ = " " & NameOf(selected)
302
303         Public Function GetSelectValue(html$) As NamedValue(Of String)
304             Dim select$ = r.Match(html, "<select.+?/select", RegexICSng).Value
305             Dim options$() = r.Matches([select], "<option.+?>", RegexICSng).ToArray
306
307             [select] = r.Match([select], "<select.*?>", RegexICSng).Value
308
309             Dim attrs = [select].TagAttributes.ToArray
310             Dim name$ = attrs.GetByKey("name"True).Value
311             Dim value$ = options _
312                 .Where(Function(s)
313                            Return InStr(s, selected, CompareMethod.Text) > 0
314                        End Function) _
315                 .FirstOrDefault _
316                ?.Replace(selected, "") _
317                 .TagAttributes _
318                 .GetByKey("value"True) _
319                 .Value
320
321             Return New NamedValue(Of StringWith {
322                 .Name = name,
323                 .Value = value
324             }
325         End Function
326
327         <MethodImpl(MethodImplOptions.AggressiveInlining)>
328         <Extension>
329         Public Function GetSelectInputGroup(html$) As NamedValue(Of String)()
330             Return r _
331                 .Matches(html, "<select.+?/select", RegexICSng) _
332                 .ToArray _
333                 .Select(AddressOf GetSelectValue) _
334                 .ToArray
335         End Function
336
337         ' <br><br/>
338         ''' <summary>
339         ''' The line break html tag in the html document. 
340         ''' </summary>
341         Const LineFeed$ = "(<br>)|(<br\s*/>)"
342
343         ''' <summary>
344         ''' Split the html text into lines by tags: ``&lt;br>`` or ``&lt;br/>``
345         ''' </summary>
346         ''' <param name="html$"></param>
347         ''' <returns></returns>
348         <Extension>
349         Public Function HtmlLines(html$) As String()
350             If html.StringEmpty Then
351                 Return {}
352             Else
353                 Return Regex.Split(html, LineFeed, RegexICSng)
354             End If
355         End Function
356
357         ' <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()" />
358         ''' <summary>
359         ''' The regexp pattern for the attributes in a html tag.
360         ''' </summary>
361         Const attributeParse$ = "(\S+?\s*[=]\s*"".+?"")|(\S+?\s*[=]\s*\S+)"
362
363         <Extension>
364         Private Function stripTag(ByRef tag$) As String
365             If tag Is Nothing Then
366                 tag = ""
367             Else
368                 tag = tag _
369                     .Trim("<"c) _
370                     .Trim(">"c) _
371                     .Trim("/"c)
372             End If
373             Return tag
374         End Function
375
376         ''' <summary>
377         ''' 获取一个html标签之中的所有的attribute属性数据
378         ''' </summary>
379         ''' <param name="tag$"></param>
380         ''' <returns></returns>
381         <MethodImpl(MethodImplOptions.AggressiveInlining)>
382         <Extension>
383         Public Function TagAttributes(tag As StringAs IEnumerable(Of NamedValue(Of String))
384             Return Regex _
385                 .Matches(tag.GetBetween("<"">"), attributeParse, RegexICSng) _
386                 .EachValue _
387                 .Select(Function(t) t.GetTagValue("=", trim:=""""""))
388         End Function
389
390         ''' <summary>
391         ''' 将<paramref name="html"/>中的``&lt;script>&lt;/script>``代码块删除
392         ''' </summary>
393         ''' <param name="html$"></param>
394         ''' <returns></returns>
395         <MethodImpl(MethodImplOptions.AggressiveInlining)>
396         <Extension>
397         Public Function RemovesJavaScript(html As StringAs String
398             ' <script>
399             Return html.RemoveTags("script")
400         End Function
401
402         ''' <summary>
403         ''' Removes all of the ``&lt;style>`` css styles block from a given <paramref name="html"/> document.
404         ''' </summary>
405         ''' <param name="html"></param>
406         ''' <returns></returns>
407         <MethodImpl(MethodImplOptions.AggressiveInlining)>
408         <Extension>
409         Public Function RemovesCSSstyles(html As StringAs String
410             ' <style>
411             Return html.RemoveTags("style")
412         End Function
413
414         ''' <summary>
415         ''' Removes all of the ``&lt;img>`` image links block from a given <paramref name="html"/> document.
416         ''' </summary>
417         ''' <param name="html"></param>
418         ''' <returns></returns>
419         <MethodImpl(MethodImplOptions.AggressiveInlining)>
420         <Extension>
421         Public Function RemovesImageLinks(html As StringAs String
422             ' <img>
423             Return html.RemoveTags("img")
424         End Function
425
426         <MethodImpl(MethodImplOptions.AggressiveInlining)>
427         <Extension>
428         Public Function RemovesHtmlHead(html As StringAs String
429             ' <head>
430             Return html.RemoveTags("head")
431         End Function
432
433         <MethodImpl(MethodImplOptions.AggressiveInlining)>
434         <Extension>
435         Public Function RemovesFooter(html As StringAs String
436             ' <footer>
437             Return html.RemoveTags("footer")
438         End Function
439
440         <MethodImpl(MethodImplOptions.AggressiveInlining)>
441         <Extension>
442         Public Function RemovesHtmlStrong(html As StringAs String
443             Dim buffer As New StringBuilder(html)
444
445             For Each m As Match In r.Matches(html, "(<[/]?strong>)|(<[/]?b>)", RegexICSng)
446                 buffer.Replace(m.Value, "")
447             Next
448
449             Return buffer.ToString
450         End Function
451
452         Sub New()
453             RegexpTimeout = 5
454         End Sub
455
456         <Extension>
457         Public Function RemoveTags(html$, ParamArray tags$()) As String
458             For Each tag As String In tags
459
460                 ' img 标签可能会在这里超时,如果没有<img></img>的话
461                 ' 则直接忽略掉这个错误
462                 Try
463                     html = r.Replace(html, $"<{tag}.*?>.*?</{tag}>""", RegexICSng)
464                 Catch ex As Exception When TypeOf ex Is TimeoutException
465                     Call App.LogException(ex, tags.GetJson)
466                 Catch ex As Exception
467                     Throw ex
468                 End Try
469
470                 html = r.Replace(html, $"<{tag}.*?>""", RegexICSng)
471             Next
472
473             Return html
474         End Function
475     End Module
476 End Namespace