VB.net 获取网页源码
标签搜索
侧边栏壁纸
  • 累计撰写 10 篇文章
  • 累计收到 0 条评论

VB.net 获取网页源码

Hanse
2020-01-22 / 0 评论 / 147 阅读 / 正在检测是否收录...
温馨提示:
本文最后更新于2022年01月07日,已超过1308天没有更新,若内容或图片失效,请留言反馈。

方法一

Public Function getWebSource(ByVal url As String) As String
    Try
        Dim stream As IO.Stream = WebRequest.Create(url).GetResponse().GetResponseStream()
        Dim sr As StreamReader = New StreamReader(stream, System.Text.Encoding.UTF8)
        Return sr.ReadToEnd()
    Catch ex As Exception
        Return ""
        'Return ex.ToString()
    End Try
End Function

方法二

节选自网络,实测较慢

Public Function GetWebCode(ByVal strURL As String) As String
    Dim httpReq As System.Net.HttpWebRequest
    Dim httpResp As System.Net.HttpWebResponse
    Dim httpURL As New System.Uri(strURL)
    Dim ioS As System.IO.Stream, charSet As String, tCode As String
    Dim k() As Byte
    ReDim k(0)
    Dim dataQue As New Queue(Of Byte)
    httpReq = CType(WebRequest.Create(httpURL), HttpWebRequest)
    Dim sTime As Date = CDate("1990-09-21 00:00:00")
    httpReq.IfModifiedSince = sTime
    httpReq.Method = "GET"
    httpReq.Timeout = 7000

    Try
        httpResp = CType(httpReq.GetResponse(), HttpWebResponse)
    Catch
        Debug.Print("weberror")
        GetWebCode = "<title>no thing found</title>" : Exit Function
    End Try
    '以上为网络数据获取
    ioS = CType(httpResp.GetResponseStream, Stream)
    Do While ioS.CanRead = True
        Try
            dataQue.Enqueue(ioS.ReadByte)
        Catch
            Debug.Print("read error")
            Exit Do
        End Try
    Loop
    ReDim k(dataQue.Count - 1)
    For j As Integer = 0 To dataQue.Count - 1
        k(j) = dataQue.Dequeue
    Next
    '以上,为获取流中的的二进制数据
    tCode = Encoding.GetEncoding("UTF-8").GetString(k) '获取特定编码下的情况,毕竟UTF-8支持英文正常的显示
    charSet = Replace(GetByDiv2(tCode, "charset=", """"), """", "") '进行编码类型识别
    '以上,获取编码类型
    If charSet = "" Then 'defalt
        If httpResp.CharacterSet = "" Then
            tCode = Encoding.GetEncoding("UTF-8").GetString(k)
        Else
            tCode = Encoding.GetEncoding(httpResp.CharacterSet).GetString(k)
        End If
    Else
        tCode = Encoding.GetEncoding(charSet).GetString(k)
    End If
    Debug.Print(charSet)
    'Stop
    '以上,按照获得的编码类型进行数据转换
    '将得到的内容进行最后处理,比如判断是不是有出现字符串为空的情况
    GetWebCode = tCode
    If tCode = "" Then GetWebCode = "<title>no thing found</title>"
End Function

Public Function GetByDiv2(ByVal code As String, ByVal divBegin As String, ByVal divEnd As String) '获取分隔符所夹的内容[完成,未测试]
'仅用于获取编码数据
    Dim lgStart As Integer
    Dim lens As Integer
    Dim lgEnd As Integer
    lens = Len(divBegin)
    If InStr(1, code, divBegin) = 0 Then GetByDiv2 = "" : Exit Function
    lgStart = InStr(1, code, divBegin) + CInt(lens)

    lgEnd = InStr(lgStart + 1, code, divEnd)
    If lgEnd = 0 Then GetByDiv2 = "" : Exit Function
    GetByDiv2 = Mid(code, lgStart, lgEnd - lgStart)
End Function
0

评论

博主关闭了所有页面的评论