VB 下 Post 中文编码的 http request

这是以前的一个机器人程序， 用来直接向 http server 提交中文的信息。程序使用了两个特别的控件：inet 与 web browser。

初始化：

Private Sub Form_Load()

    objInet.Protocol = icHTTP

    objInet.RequestTimeout = 12

    web.Navigate2 "about:blank"

End Sub

 

构造 http 头：

    strUrl = Trim(text_Url.Text)

    If strUrl = "" Then Exit Sub

    strHead = _

     "Accept-Language: zh-cn" & vbCrLf _

     & "Referer: " & strUrl & vbCrLf _

     & "Content-Type: application/x-www-form-urlencoded" & vbCrLf _

     & "User-Agent: Mozilla/4.0 (compatible; MSIE 5.5)" & vbCrLf _

     & "Accept-encoding: gzip , deflate" & vbCrLf _

     & "Connection: Keep-Alive" & vbCrLf _

     & "cache-Control: no-cache" & vbCrLf

      & "Cookie: " &  Trim(text_Cookie.Text) & vbCrLf & vbCrLf 

 

构造 post 内容：

    strPost = Trim(text_TagName.Text) & "=" & Encode(user) & "&" _

            & Trim(text_TagPassword.Text) & "=" & pass & "&" _

            & Trim(text_TagSubject.Text) & "=" & Encode(title) & "&" _

            & Trim(text_Other.Text)

 

发送：

    objInet.Execute strUrl, "POST", strPost, strHead

 

接受返回的 html 文件，显示在 web browser 上：

Private Sub displayHTML()

    Dim doc As HTMLDocument

    Dim obj As Object

    Dim col As HTMLElementCollection

    Dim anchor As HTMLAnchorElement

    Dim body As HTMLBody

    Dim str As String

    Dim s1 As String, s2 As String

    On Error GoTo endit

 

    s1 = ""

    s2 = ""

    Do

        DoEvents

        s1 = objInet.GetChunk(512, icString)

        s2 = s2 & s1

    Loop Until s1 = ""

       

    lbl_Status = "OK"

    bDone = True

    timeoutCount = 0

    Set doc = web.Document

    Set body = doc.body

    body.innerHTML = s2

endit:

End Sub

 

中文 GB2312 编码：

Function Encode(ByRef vKey As String) As String

    Dim i As Long, v As Long

    Dim temp As String

    Encode = ""

   

    For i = 1 To Len(vKey)

        temp = Mid(vKey, i, 1)

        v = AscW(temp)

        If temp = " " Then

            Encode = Encode & "%20"

        ElseIf v > 256 Then

            v = AscW(StrConv(temp, vbFromUnicode, &H804))

            v = IIf(v < 0, v + 65536, v)

            Encode = Encode & ToHex(v Mod 256) & ToHex(v / 256)

        Else

            Encode = Encode & temp

        End If

    Next

End Function

 

Function ToHex(n As Long) As String

    ToHex = IIf(n < 16, "%0" & Hex(n), "%" & Hex(n))

End Function