在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