XMLHTTP POST GET 。MSXML2.ServerXMLHTTP | Microsoft.XMLHTTP 一点心得

最新推荐文章于 2025-01-19 15:15:09 发布

hljqfl

最新推荐文章于 2025-01-19 15:15:09 发布

阅读量2.5k

点赞数

分类专栏： VB

本文链接：https://blog.youkuaiyun.com/hljqfl/article/details/86015205

版权

VB 专栏收录该内容

15 篇文章

订阅专栏

本文详细介绍了使用VBScript中的XMLHTTP对象进行GET和POST请求的方法，包括设置请求头、发送请求、处理响应等关键步骤，并提供了具体示例代码。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

XMLHTTP POST GET

Option Explicit

Function GetPage(Url As String, Optional Host As String = "", Optional Cookie As String = "", Optional Referer As String = "", Optional HeaderStr As String = "", Optional ByRef GetCookie As String)
'编写: 风飞雪 http://hi.baidu.com/f_fx 2009年5月25日
On Error Resume Next
    Dim HTTP As New XMLHTTP
    'Dim HTTP
    'Set HTTP = CreateObject("Microsoft.XMLHTTP")

    Dim Header
    Dim HeaderName As String
    Dim HeaderData As String
    Dim I

    With HTTP
        .Open "Get", Url, False
        If HeaderStr <> "" Then
          HeaderStr = vbNewLine & HeaderStr
          HeaderStr = Replace(HeaderStr, vbNewLine & vbNewLine, "")
          Header = Split(HeaderStr, vbNewLine)
          For I = 0 To UBound(Header) - 1
            If Header(I) <> "" Then
               HeaderName = Trim(Mid(Header(I), 1, InStr(Header(I), ":") - 1))
               HeaderData = Trim(Mid(Header(I), InStr(Header(I), ":") + 1))
               If HeaderName <> "" And HeaderData <> "" Then .setRequestHeader HeaderName, HeaderData
            End If
          Next I
        End If

       If Referer <> "" Then .setRequestHeader "Referer", Referer
       If Host <> "" Then .setRequestHeader "Host", Host
       If Cookie <> "" Then .setRequestHeader "Cookie", Cookie
       .send
       If Err.Number = 0 Then
         GetCookie = .getResponseHeader("Set-Cookie")
         'Debug.Print .getAllResponseHeaders
         GetPage = BytesToBstr(.responseBody, "GB2312")
       End If
    End With
    Set HTTP = Nothing
End Function

Function PostData(PostUrl As String, PostStr As String, Optional Host As String = "", Optional PostCok As String = "", Optional PostRef As String = "", Optional HeaderStr As String = "", Optional Cset As String = "GB2312", Optional ByRef GetCookie As String)
'编写: 风飞雪 http://hi.baidu.com/f_fx 2009年5月25日
    On Error Resume Next
    Dim HTTP As New XMLHTTP
    'Dim HTTP
    'Set HTTP = CreateObject("Microsoft.XMLHTTP")
    Dim Header
    Dim HeaderName As String
    Dim HeaderData As String
    Dim I
    'PostStr = URLEncoding(PostStr)
    With HTTP
        .Open "POST", PostUrl, False
        If HeaderStr <> "" Then
          HeaderStr = vbNewLine & HeaderStr
          HeaderStr = Replace(HeaderStr, vbNewLine & vbNewLine, "")
          Header = Split(HeaderStr, vbNewLine)
          For I = 0 To UBound(Header) - 1
            If Header(I) <> "" Then
               HeaderName = Trim(Mid(Header(I), 1, InStr(Header(I), ":") - 1))
               HeaderData = Trim(Mid(Header(I), InStr(Header(I), ":") + 1))
               If HeaderName <> "" And HeaderData <> "" Then .setRequestHeader HeaderName, HeaderData
            End If
          Next I
        End If

        If PostRef <> "" Then .setRequestHeader "Referer", PostRef
        If Host <> "" Then .setRequestHeader "Host", Host
        If PostCok <> "" Then .setRequestHeader "Cookie", PostCok
        .setRequestHeader "Content-Length", Len(PostStr)
        .send PostStr
    End With
    If Err.Number <> 0 Then
        PostData = ""
      Else
        GetCookie = HTTP.getResponseHeader("Set-Cookie")
        Select Case Cset
           Case "responseText"
             PostData = HTTP.responseText
           Case "responseBody"
             PostData = HTTP.responseBody
           Case "responseXML"
             PostData = HTTP.responseXML
           Case "responseStream"
             PostData = HTTP.responseStream
           Case Else
             PostData = BytesToBstr(HTTP.responseBody, Cset)
         End Select
    End If
    Set HTTP = Nothing
End Function

Function URLEncoding(vstrIn)
Dim strReturn, ThisChr, InnerCode, Hight8, Low8, i
        strReturn = ""
        For i = 1 To Len(vstrIn)
            ThisChr = Mid(vstrIn, i, 1)
            If Abs(Asc(ThisChr)) < &HFF Then
                strReturn = strReturn & ThisChr
            Else
                InnerCode = Asc(ThisChr)
                If InnerCode < 0 Then
                    InnerCode = InnerCode + &H10000
                End If
                Hight8 = (InnerCode And &HFF00) \ &HFF
                Low8 = InnerCode And &HFF
                strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
            End If
        Next
        URLEncoding = strReturn
End Function

Function BytesToBstr(Body, Cset)
    Dim ADOS
    Set ADOS = CreateObject("Adodb.Stream")
    With ADOS
      .Type = 1
      .Mode = 3
      .Open
      .Write Body
      .Position = 0
      .Type = 2
      .Charset = Cset
      BytesToBstr = .ReadText
      .Close
    End With
    Set ADOS = Nothing
End Function

Function bytes2BSTR(vIn)
    Dim strReturn
    Dim i, ThisCharCode, NextCharCode
    strReturn = ""
    For i = 1 To LenB(vIn)
        ThisCharCode = AscB(MidB(vIn, i, 1))
        If ThisCharCode < &H80 Then
            strReturn = strReturn & Chr(ThisCharCode)
        Else
            NextCharCode = AscB(MidB(vIn, i + 1, 1))
            strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
            i = i + 1
        End If
    Next
    bytes2BSTR = strReturn
End Function

'使用方式

Dim HeaderStr As String
HeaderStr = ""
HeaderStr = HeaderStr & vbNewLine & "Accept: */*"
HeaderStr = HeaderStr & vbNewLine & "Referer: http://hi.baidu.com/f%5FFX"
HeaderStr = HeaderStr & vbNewLine & "Accept -Language: zh -cn"
HeaderStr = HeaderStr & vbNewLine & "Accept -Encoding: gzip , deflate"
HeaderStr = HeaderStr & vbNewLine & "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)"
HeaderStr = HeaderStr & vbNewLine & "Host: hi.baidu.com"
HeaderStr = HeaderStr & vbNewLine & "Connection: Keep -Alive"
HeaderStr = HeaderStr & vbNewLine & "Cookie: BAIDUID=4BCD69B2A430279A066A9D7811B29C51:FG=1; BDLFONT=0; BDUSS=IzbzZ4cEZ0UENkT3ViR3FkNWlGTDVKTlJVUzM4TGpyY0txLXh4b1dMUmNqa05LQVFBQUFBJCQAAAAAAAAAAApBESIebasBRl9GWAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoTeABAAAAAFxJ4AEAAAAAMEngAQAAAACQfEJaAAAAAFwBHEpcARxKbU; _BDSC=1; IM_old=2|fv5b96ho; BDSTAT=20b33235dac31c427539037af7491398292756086c061d951e7b020879f434d5; BDSP=0a2d0d95a8ed8a13bdd6dffce96e3a8e20ca12fa4f508d96d9c8276d55fbb2fb43166d224f4a20a4462309f790529822720e0cf3d7ca7bcb0a46f21fbe096b63f6246b600c338744ebf81a4c510fd9f9d72a6059252dd42a2834349b033b5bb5cbeac1d9; BDSPINFO=d787becfb6f5cf39b600c8f1|F_FX|f_fx|30912d00962fe635571147ec7de05377; BDOPINFO=d787becfb6f5cf39b600c8f1|F_FX|f_fx|30912d00962fe635571147ec7de05377"
GetPage "http://hi.baidu.com/f%5Ffx/creat/blog/", , , , HeaderStr

Dim HeaderStr As String
HeaderStr = ""
HeaderStr = HeaderStr & vbNewLine & "Accept: */*"
HeaderStr = HeaderStr & vbNewLine & "Accept -language: zh -Cn"
HeaderStr = HeaderStr & vbNewLine & "Referer: http://172.25.208.10:8080/ept/component.do"
HeaderStr = HeaderStr & vbNewLine & "User -Agent: Microsoft.XMLHTTP"
HeaderStr = HeaderStr & vbNewLine & "Accept -encoding: gzip , deflate"
HeaderStr = HeaderStr & vbNewLine & "Host: 172.25.208.10:8080"
HeaderStr = HeaderStr & vbNewLine & "Connection: Keep -Alive"
HeaderStr = HeaderStr & vbNewLine & "cache -Control: no -cache"

Call PostData("http://172.25.208.10:8080/ept/component.do?name=cmp_jjhk_djbjgk_print&event=show&para=", _
"<msginfo><parameters><parameter name=QueryLX>JGK</parameter><parameter name=QYGTLX>0</parameter><parameter name=ZCH>4304233000111</parameter><parameter name=DAHS></parameter><parameter name=DAHF></parameter><parameter name=DDMS></parameter><parameter name=DDMF></parameter><parameter name=NEW>0</parameter><parameter name=HYDM></parameter><parameter name=DJJG></parameter><parameter name=QYLX></parameter><parameter name=JGDW></parameter><parameter name=ACTION>query</parameter><parameter name=QUERY></parameter></parameters></msginfo>", _
, , , HeaderStr)

===========================================================