在WebBrowser中发送POST请求

我们要用到的也是WebBrowser的“Navigate”方法，其函数原型如下所示：

Sub Navigate(URL As String, [Flags], [TargetFrameName], [PostData], [Headers])

新建一个工程，部件中勾选中 “Microsoft Internet Controls”，添加一个WebBrowser1、一个Command1在窗体上，可以把WebBrowser1适当拉大一点，Form1中添加以下代码：

Private Sub Command1_Click()

    ReDim aByte(0) As Byte ' Array of bytes to hold data to post
   
    cPostData = "login_name=帳號&password=密碼&cookietime=0&x=42&y=10"
   
    PackBytes aByte(), cPostData
   
    Dim vPost As Variant
   
    vPost = aByte ' Assign the byte array to a VARIANT
   
    Dim vHeaders As Variant
   
    vHeaders = "Content-Type: application/x-www-form-urlencoded" + Chr(10) + Chr(13)
   
    WebBrowser1.Navigate "http://www.csdn.net/member/logon.asp", , , vPost, vHeaders

End Sub

Private Sub PackBytes(ByteArray() As Byte, ByVal PostData As String)

    iNewBytes = Len(PostData) - 1   ' Get rid of the null termination
   
    If iNewBytes < 0 Then
        Exit Sub
    End If
   
    ReDim ByteArray(iNewBytes)
   
    For i = 0 To iNewBytes
   
        ch = Mid(PostData, i + 1, 1)
        If ch = Space(1) Then
            ch = "+"
        End If
        Debug.Print ch, Asc(ch)
        ByteArray(i) = Asc(ch)
    Next
End Sub

 

Sub  getWeb()

 

     Dim  X  As  XMLHTTP

     tmpth =  "c:\temp.htm"

     URL =  "http://www.baidu.com/"

     Set  X =  New  XMLHTTP

     X.Open  "GET" , URL,  False

     X.send

     s = X.responseText

     ss =  "<body"

     arr = Split(s, ss)

     ss = ss & arr(1)

     If  Dir(tmpth) <>  ""  Then  Kill tmpth

 

     Open tmpth  For  Output  As  1

     Print #1, , ss

     Close 1

     WebBrowser1.Navigate2 tmpth

     Set  bd = WebBrowser1.Document.body

     Do  While  bd  Is  Nothing

         DoEvents

         Set  bd = WebBrowser1.Document.body

     Loop

     SendKeys  "c:\baidu.htm"

     SendKeys  "{ENTER}"

     WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_PROMPTUSER

     Kill tmpth

End  Sub

转载于:https://www.cnblogs.com/lbnnbs/p/4784635.html