219 lines
8.2 KiB
VB.net
219 lines
8.2 KiB
VB.net
#Region "Microsoft.VisualBasic::07b083a0d6b08f3405f0ccca960faa24, Microsoft.VisualBasic.Core\Extensions\WebServices\HttpGet.vb"
|
||
|
||
' Author:
|
||
'
|
||
' asuka (amethyst.asuka@gcmodeller.org)
|
||
' xie (genetics@smrucc.org)
|
||
' xieguigang (xie.guigang@live.com)
|
||
'
|
||
' Copyright (c) 2018 GPL3 Licensed
|
||
'
|
||
'
|
||
' GNU GENERAL PUBLIC LICENSE (GPL3)
|
||
'
|
||
'
|
||
' This program is free software: you can redistribute it and/or modify
|
||
' it under the terms of the GNU General Public License as published by
|
||
' the Free Software Foundation, either version 3 of the License, or
|
||
' (at your option) any later version.
|
||
'
|
||
' This program is distributed in the hope that it will be useful,
|
||
' but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
' GNU General Public License for more details.
|
||
'
|
||
' You should have received a copy of the GNU General Public License
|
||
' along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
|
||
|
||
' /********************************************************************************/
|
||
|
||
' Summaries:
|
||
|
||
' Module HttpGet
|
||
'
|
||
' Properties: HttpRequestTimeOut
|
||
'
|
||
' Function: [GET], __get, __httpRequest, BuildWebRequest, Get_PageContent
|
||
' LogException
|
||
'
|
||
' /********************************************************************************/
|
||
|
||
#End Region
|
||
|
||
Imports System.IO
|
||
Imports System.Net
|
||
Imports System.Runtime.CompilerServices
|
||
Imports System.Text
|
||
Imports Microsoft.VisualBasic.CommandLine.Reflection
|
||
Imports Microsoft.VisualBasic.Language
|
||
Imports Microsoft.VisualBasic.Scripting.MetaData
|
||
Imports Microsoft.VisualBasic.Text.Parser.HtmlParser
|
||
|
||
''' <summary>
|
||
''' Tools for http get
|
||
''' </summary>
|
||
Public Module HttpGet
|
||
|
||
#If FRAMEWORD_CORE Then
|
||
''' <summary>
|
||
''' Get the html page content from a website request or a html file on the local filesystem.
|
||
''' (同时支持http位置或者本地文件，失败或者错误会返回空字符串)
|
||
''' </summary>
|
||
''' <param name="url">web http request url or a file path handle</param>
|
||
''' <param name="retry">发生错误的时候的重试的次数</param>
|
||
''' <returns>失败或者错误会返回空字符串</returns>
|
||
''' <remarks>这个工具只适合于文本数据的传输操作</remarks>
|
||
<ExportAPI("Webpage.Request", Info:="Get the html page content from a website request Or a html file on the local filesystem.")>
|
||
<Extension> Public Function [GET](url As String,
|
||
<Parameter("Request.TimeOut")>
|
||
Optional retry As UInt16 = 0,
|
||
Optional headers As Dictionary(Of String, String) = Nothing,
|
||
Optional proxy As String = Nothing,
|
||
Optional doNotRetry404 As Boolean = True,
|
||
Optional UA$ = Nothing,
|
||
Optional refer$ = Nothing) As String
|
||
#Else
|
||
''' <summary>
|
||
''' Get the html page content from a website request or a html file on the local filesystem.
|
||
''' </summary>
|
||
''' <param name="url">web http request url or a file path handle</param>
|
||
''' <param name="RequestTimeOut">发生错误的时候的重试的次数</param>
|
||
''' <returns></returns>
|
||
''' <remarks></remarks>
|
||
'''
|
||
<Extension> Public Function Get_PageContent(url As String, Optional RequestTimeOut As UInteger = 20, Optional FileSystemUrl As Boolean = False) As String
|
||
#End If
|
||
Dim isFileUrl As String = (InStr(url, "http://", CompareMethod.Text) <> 1) AndAlso (InStr(url, "https://", CompareMethod.Text) <> 1)
|
||
|
||
Call $"GET {If(isFileUrl, url.ToFileURL, url)}".__DEBUG_ECHO
|
||
|
||
' 类似于php之中的file_get_contents函数,可以读取本地文件内容
|
||
If File.Exists(url) Then
|
||
Call "[Job DONE!]".__DEBUG_ECHO
|
||
Return url.ReadAllText
|
||
Else
|
||
If isFileUrl Then
|
||
Call $"URL {url.ToFileURL} can not solved on your filesystem!".Warning
|
||
Return ""
|
||
End If
|
||
End If
|
||
|
||
If Not refer.StringEmpty Then
|
||
If headers Is Nothing Then
|
||
headers = New Dictionary(Of String, String)
|
||
End If
|
||
|
||
headers(NameOf(refer)) = refer
|
||
End If
|
||
|
||
Return url.__httpRequest(retry, headers, proxy, doNotRetry404, UA)
|
||
End Function
|
||
|
||
<Extension>
|
||
Private Function __httpRequest(url$, retries%, headers As Dictionary(Of String, String), proxy$, DoNotRetry404 As Boolean, UA$) As String
|
||
Dim retryTime As Integer = 0
|
||
|
||
If String.IsNullOrEmpty(proxy) Then
|
||
proxy = WebServiceUtils.Proxy
|
||
End If
|
||
|
||
Try
|
||
RETRY: Return BuildWebRequest(url, headers, proxy, UA).__get()
|
||
Catch ex As Exception When InStr(ex.Message, "(404) Not Found") > 0 AndAlso DoNotRetry404
|
||
Return LogException(url, New Exception(url, ex))
|
||
|
||
Catch ex As Exception When retryTime < retries
|
||
|
||
retryTime += 1
|
||
|
||
Call "Data download error, retry connect to the server!".PrintException
|
||
GoTo RETRY
|
||
|
||
Catch ex As Exception
|
||
ex = New Exception(url, ex)
|
||
ex.PrintException
|
||
|
||
Return LogException(url, ex)
|
||
End Try
|
||
End Function
|
||
|
||
Private Function LogException(url As String, ex As Exception) As String
|
||
Dim exMessage As String = String.Format("Unable to get the http request!" & vbCrLf &
|
||
" Url:=[{0}]" & vbCrLf &
|
||
" EXCEPTION ===>" & vbCrLf & ex.ToString, url)
|
||
Call App.LogException(exMessage, NameOf([GET]) & "::HTTP_REQUEST_EXCEPTION")
|
||
Return ""
|
||
End Function
|
||
|
||
Const doctorcomError$ = "Please login your Campus Broadband Network Client at first!"
|
||
|
||
''' <summary>
|
||
''' Request timeout unit in seconds.
|
||
''' </summary>
|
||
''' <returns></returns>
|
||
Public Property HttpRequestTimeOut As Double
|
||
|
||
Public Function BuildWebRequest(url$, headers As Dictionary(Of String, String), proxy$, UA$) As HttpWebRequest
|
||
Dim webRequest As HttpWebRequest = HttpWebRequest.Create(url)
|
||
|
||
webRequest.Headers.Add("Accept-Language", "en-US,en;q=0.8,zh-Hans-CN;q=0.5,zh-Hans;q=0.3")
|
||
webRequest.UserAgent = UA Or DefaultUA
|
||
|
||
If HttpRequestTimeOut > 0 Then
|
||
webRequest.Timeout = 1000 * HttpRequestTimeOut
|
||
End If
|
||
|
||
If Not headers.IsNullOrEmpty Then
|
||
For Each x In headers
|
||
webRequest.Headers(x.Key) = x.Value
|
||
Next
|
||
End If
|
||
If Not String.IsNullOrEmpty(proxy) Then
|
||
Call webRequest.SetProxy(proxy)
|
||
End If
|
||
|
||
Return webRequest
|
||
End Function
|
||
|
||
<Extension> Private Function __get(webrequest As HttpWebRequest) As String
|
||
Dim timer As Stopwatch = Stopwatch.StartNew
|
||
Dim url As String = webrequest.RequestUri.ToString
|
||
|
||
Using respStream As Stream = webrequest.GetResponse.GetResponseStream,
|
||
reader As New StreamReader(respStream)
|
||
|
||
Dim htmlBuilder As New StringBuilder
|
||
Dim line As Value(Of String) = ""
|
||
|
||
Do While Not (line = reader.ReadLine) Is Nothing
|
||
htmlBuilder.AppendLine(line)
|
||
Loop
|
||
|
||
Dim html As String = htmlBuilder.ToString
|
||
Dim title As String = html.HTMLTitle
|
||
|
||
' 判断是否是由于还没有登陆校园网客户端而导致的错误
|
||
If InStr(html, "http://www.doctorcom.com", CompareMethod.Text) > 0 Then
|
||
Call doctorcomError.PrintException
|
||
Return ""
|
||
Else
|
||
Dim time$ = ValueTypes.ReadableElapsedTime(timer.ElapsedMilliseconds)
|
||
Dim debug$ = $"[{url}] {title} - {Len(html)} chars in {time}"
|
||
|
||
If timer.ElapsedMilliseconds > 1000 Then
|
||
Call debug.Warning
|
||
Else
|
||
Call debug.__INFO_ECHO
|
||
End If
|
||
End If
|
||
|
||
#If DEBUG Then
|
||
Call html.SaveTo($"{App.AppSystemTemp}/{App.PID}/{url.NormalizePathString}.html")
|
||
#End If
|
||
Return html
|
||
End Using
|
||
End Function
|
||
End Module
|