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 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\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 StringAs 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 StringAs 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 StringAs 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 StringWith {
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 StringWith {
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 StringAs 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 StringAs 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 StringAs 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 StringAs String
419             ' <img>
420             Return html.RemoveTags("img")
421         End Function
422
423         <MethodImpl(MethodImplOptions.AggressiveInlining)>
424         <Extension>
425         Public Function RemovesHtmlHead(html As StringAs String
426             ' <head>
427             Return html.RemoveTags("head")
428         End Function
429
430         <MethodImpl(MethodImplOptions.AggressiveInlining)>
431         <Extension>
432         Public Function RemovesFooter(html As StringAs String
433             ' <footer>
434             Return html.RemoveTags("footer")
435         End Function
436
437         <MethodImpl(MethodImplOptions.AggressiveInlining)>
438         <Extension>
439         Public Function RemovesHtmlStrong(html As StringAs 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