推荐订阅源

 
返加网页
 Public Function Login(ByVal Url As String, ByVal Params As String) As String
        Dim strResult As String = getPageByPost(Url, Params)
        Return strResult
    End Function

    Public Function getPageByPost(ByVal url As String, ByVal payload As String, Optional ByVal needEncode As Boolean = False) As String
        Dim result As HttpWebResponse
        Dim strResult As String = ""
        Try
            Dim req As HttpWebRequest
            Dim RequestStream As Stream
            Dim ReceiveStream As Stream
            Dim encode As Encoding
            Dim sr As StreamReader

            req = CType(WebRequest.Create(url), HttpWebRequest)
            req.Method = "POST"
            req.ContentType = "application/x-www-form-urlencoded"
            req.CookieContainer = New CookieContainer
            req.UserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; Q312461; .NET CLR 1.0.3705)"

            If Not Me.Cookies Is Nothing Then
                req.CookieContainer.Add(New Uri(url), Me.Cookies)
            End If

            Dim SomeBytes() As Byte
            Dim UrlEncoded As New StringBuilder
            Dim reserved() As Char = {ChrW(63), ChrW(61), ChrW(38)}

            If payload <> Nothing Then
                If needEncode Then '有些网站encode后反而出现中文乱码所以加上这个开关
                    Dim i As Integer = 0
                    Dim j As Integer
                    While i < payload.Length
                        j = payload.IndexOfAny(reserved, i)
                        If j = -1 Then

                            UrlEncoded.Append(HttpUtility.UrlEncode(payload.Substring(i, payload.Length - i)))
                            Exit While
                        End If
                        UrlEncoded.Append(HttpUtility.UrlEncode(payload.Substring(i, j - i)))
                        UrlEncoded.Append(payload.Substring(j, 1))
                        i = j + 1
                    End While
                    SomeBytes = System.Text.Encoding.ASCII.Default.GetBytes(UrlEncoded.ToString())
                Else
                    SomeBytes = System.Text.Encoding.ASCII.Default.GetBytes(payload)
                End If
                req.ContentLength = SomeBytes.Length
                RequestStream = req.GetRequestStream()
                RequestStream.Write(SomeBytes, 0, SomeBytes.Length)
                RequestStream.Close()
            Else
                req.ContentLength = 0
            End If
            'result.Cookies = New CookieCollection
            result = CType(req.GetResponse(), HttpWebResponse)

            ReceiveStream = result.GetResponseStream()
            encode = System.Text.Encoding.ASCII.Default
            sr = New StreamReader(ReceiveStream, encode)

            Dim read(256) As Char
            Dim count As Integer = sr.Read(read, 0, 256)

            Do While count > 0
                strResult &= New String(read, 0, count)
                count = sr.Read(read, 0, 256)
            Loop
            Me.Cookies = req.CookieContainer.GetCookies(New Uri(url))

        Catch Exc As Exception

            Debug.Write(Exc.Message)
        Finally

            If Not result Is Nothing Then
                result.Close()
            End If

        End Try
        Return strResult
    End Function
    Public Function getPageByUrl(ByVal url As String) As String
        Dim result As HttpWebResponse
        Dim strResult As String = ""
        Try
            Dim req As HttpWebRequest

            Dim ReceiveStream As Stream
            Dim encode As Encoding
            Dim sr As StreamReader

            req = CType(WebRequest.Create(url), HttpWebRequest)

            req.Method = "GET"

            req.CookieContainer = New CookieContainer
            req.UserAgent = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; Q312461; .NET CLR 1.0.3705)"

            If Not Me.Cookies Is Nothing Then
                req.CookieContainer.Add(New Uri(url), Me.Cookies)
            End If

            result = CType(req.GetResponse(), HttpWebResponse)

            ReceiveStream = result.GetResponseStream()
            encode = System.Text.Encoding.ASCII.Default
            sr = New StreamReader(ReceiveStream, encode)

            Dim read(256) As Char
            Dim count As Integer = sr.Read(read, 0, 256)

            Do While count > 0
                strResult &= New String(read, 0, count)
                count = sr.Read(read, 0, 256)
            Loop
            Me.Cookies = req.CookieContainer.GetCookies(New Uri(url))
        Catch Exc As Exception

        Finally

            If Not result Is Nothing Then
                result.Close()
            End If

        End Try
        Return strResult
    End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function GetSource(ByVal url As String) As String
        Try
            Dim httpReq As System.Net.HttpWebRequest 'HttpWebRequest 类对 WebRequest 中定义的属性和方法提供支持'，也对使用户能够直接与使用 HTTP 的服务器交互的附加属性和方法提供支持。
            Dim httpResp As System.Net.HttpWebResponse ' HttpWebResponse 类用于生成发送 HTTP 请求和接收 HTTP 响'应的 HTTP 独立客户端应用程序。
            Dim httpURL As New System.Uri(url)
            httpReq = CType(WebRequest.Create(httpURL), HttpWebRequest)
            httpReq.Method = "GET"
            httpResp = CType(httpReq.GetResponse(), HttpWebResponse)
            Dim reader As StreamReader = _
            New StreamReader(httpResp.GetResponseStream, System.Text.Encoding.GetEncoding("GB2312")) '如是中文，要设置编码格式为“GB2312”。
            Dim respHTML As String = reader.ReadToEnd() 'respHTML就是网页源代码
            Return respHTML
            httpResp.Close()
        Catch e As Exception
            Console.WriteLine("GetSource出现问题:{0},{1}", e.Message, url)
        End Try
    End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        txtHTML.Text = getPageByUrl("http" & "://www.google.cn/search?complete=1&hl=zh-CN&newwindow=1&q=" & txt.Text.Trim & "&meta=" & "start=" & cbo.Text.Trim)

网址加入google +mytext

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
返回email
 ' Dim strRegex As String = "[\w-]+@([\w-]+\.)+[\w-]+" 'email
        Dim strRegex As String = "[a-zA-Z0-9\-]+@([\w-]+\.)+[a-zA-Z0-9\-]+" 'email

        ' Dim strRegex As String = "[a-zA-Z0-9_\-\.\+]+)@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)"
        '[a-zA-Z0-9_\-\.\+]+)@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)$/;

        '这就是表达式'：“^\w+[-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*$”
        Dim r As System.Text.RegularExpressions.Regex
        Dim m As System.Text.RegularExpressions.MatchCollection
        r = New System.Text.RegularExpressions.Regex(strRegex, System.Text.RegularExpressions.RegexOptions.IgnoreCase)
        m = r.Matches(txtHTML.Text)
        Dim i As Integer
        Dim ddd As String
        'ListBox1.Items.Clear()

        For i = 0 To m.Count - 1
            'ddd = ddd & m(i).Value
            ListBox1.Items.Add(m(i).Value)

            '  Fdorm1.DefInstance.ListBox1.Items.Add(m(i).Value) 'form1.DefInstance是form1的共享属性和实例
        Next i