XMLHttp 登录淘宝 (tid参数还有待完善)

tid参数还有待完善，有时间再完善，需要你自己抓包获得。

 

Private Sub CommandButton1_Click()    '登录淘宝  tid参数还有待完善
    On Error Resume Next
    Set oDoc = CreateObject("htmlfile")
    Set mx = CreateObject("WinHttp.WinHttpRequest.5.1")
    Set ms = CreateObject("msscriptcontrol.scriptcontrol")
    ms.Language = "JavaScript"
    '---------------------------------，这里开始登录
    m0 = "用户名"
    m1 = "密码"
    m2 = ms.Eval("encodeURIComponent('" & m0 & "');")
    a = Split("=on&,newlogin=&,tid=&,pstrong=&,callback=&,ie|8&", ",")
    b = Split(",newlogin=1&,tid=XOR_1_000000000000000000000000000000_20564B27317T7B727B02030A&,pstrong=2&,callback=1&,ie|8", ",")
    With CreateObject("internetexplorer.application")
        .Visible = False
        .Navigate "https://login.taobao.com/member/login.jhtml"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        .document.getelementbyid("TPL_username_1").Value = m0
        .document.getelementbyid("TPL_password_1").Value = m1
        Set r = .document.forms("J_StaticForm").All.tags("input")
        ss = ""
        For i = 0 To r.Length
            ss = ss & r(i).Name & "=" & r(i).Value & "&"
        Next i
        For i = 0 To UBound(a)
            ss = Replace(ss, a(i), b(i))
        Next i
        tt = .document.body.parentElement.outerhtml
        .Quit
    End With

    mx.Open "POST", "https://login.taobao.com/member/login.jhtml", False
    mx.setRequestHeader "x-requested-with", "XMLHttpRequest"
    mx.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
    mx.setRequestHeader "Connection", "Keep-Alive"
    mx.send ss
    token = Split(mx.responsetext, """")(11)    '参数token

    mx.Open "GET", "https://passport.alipay.com/mini_apply_st.js?site=0&token=" & token & "&callback=vstCallback93", False
    mx.setRequestHeader "Referer", "https://login.taobao.com/member/login.jhtml"
    mx.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0; .NET CLR 2.0.50727; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729; .NET4.0C; .NET4.0E)"
    mx.setRequestHeader "Connection", "Keep-Alive"
    mx.send
    st = Split(mx.responsetext, """")(5)    '参数st

    mx.Open "GET", "https://login.taobao.com/member/vst.htm?st=" & st & "¶ms=style%3Ddefault%26sub%3D%26TPL_username%3D" & m2 & "%26loginsite%3D0%26from_encoding%3D%26not_duplite_str%3D%26guf%3D%26full_redirect%3D%26isIgnore%3D%26need_sign%3D%26sign%3D%26from%3Dtb%26TPL_redirect_url%3D&_ksTS=" & ms.Eval("new Date().getTime()") & "_105&callback=jsonp106", False
    mx.setRequestHeader "x-requested-with", "XMLHttpRequest"
    mx.setRequestHeader "Referer", "https://login.taobao.com/member/login.jhtml"
    mx.setRequestHeader "Accept", "text/javascript, application/javascript, application/ecmascript, application/x-ecmascript, */*; q=0.01"
    mx.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0; .NET CLR 2.0.50727; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729; .NET4.0C; .NET4.0E)"
    mx.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
    mx.setRequestHeader "Connection", "Keep-Alive"
    mx.send
    url1 = Split(mx.responsetext, """")(11)    '参数url

    mx.Open "GET", url1, False
    mx.setRequestHeader "Accept", "image/gif, image/jpeg, image/pjpeg, image/pjpeg, application/x-ms-application, application/x-ms-xbap, application/vnd.ms-xpsdocument, application/xaml+xml, application/vnd.ms-excel, application/msword, application/vnd.ms-powerpoint, */*"
    mx.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 5.1; Trident/4.0; .NET CLR 2.0.50727; .NET CLR 3.0.4506.2152; .NET CLR 3.5.30729; .NET4.0C; .NET4.0E)"
    mx.setRequestHeader "Connection", "Keep-Alive"
    mx.send
    spm = Split(Split(mx.responsetext, "data-spm=""")(1), """")(0)    '参数spm
    '---------------------------------，到这里，才算登录结束。

    Columns("A:A").NumberFormatLocal = "@"
    For p = 1 To 1000
        mx.Open "GET", "http://trade.taobao.com/trade/itemlist/listBoughtItems.htm?spm=" & spm & "&action=itemlist/QueryAction&event_submit_do_query=1&prePageNo=" & p - 1 & "&clickMore=0&pageNum=" & p, False
        mx.send
        oDoc.body.innerhtml = mx.responsetext
        Set r1 = oDoc.All.tags("tbody")
        For q = 0 To r1.Length - 1
            k = Range("d65536").End(xlUp).Row + 1
            Set r2 = r1(q).All.tags("span")
            s = 2
            If r2(2).innerText Like "成交时间*" Then s = 1
            Cells(k, 1) = r2(s).innerText    '订单编号
            Cells(k, 2) = r2(s + 1).innerText  '成交时间
            Cells(k, 3) = r2(s + 2).All.tags("a")(0).Title  '店名
            Set r3 = r1(q).All.tags("tr")
            For i = 2 To r3.Length - 1
                For j = 0 To r3(2).Cells.Length - 1
                    Cells(k + i - 2, j + 4) = Replace(r3(i).Cells(j).innerText, vbCrLf, "")
                Next j
            Next i
        Next q
        If p = Val(Split(Split(mx.responsetext, "<span>共")(1), "页")(0)) Then Exit For
    Next p
End Sub