高分求 VB 代码 ，真心求！解决方法

高分求 VB 代码 ，真心求！
求Vb代码；100积分已经是系统允许出的最高分了，真心求，希望大家能帮忙解决!

原始网址：
http://s.click.taobao.com/t?e=m%3D2%26s%3DBN7SH4ym5NwcQipKwQzePOeEDrYVVa64LKpWJ%2Bin0XJRAdhuF14FMUEJvDfzbX%2Fr79%2FTFaMDK6RP0drGFRffB8njyd38oaEmGsHJgnEgyQh3vHEOpE5W%2FDHgmaPYYnLH  

真实网址：
http://item.taobao.com/item.htm?id=35816417612&ali_trackid=2:mm_11382983_0_0:1384050201_6k1_1580699870

代码要求：给原始网址，得到真实网址中的id=35816417612
[解决办法]

Option Explicit

Private Sub Form_Load()
    Dim url As String
    url = "http://s.click.taobao.com/t?e=m%3D2%26s%3DBN7SH4ym5NwcQipKwQzePOeEDrYVVa64LKpWJ%2Bin0XJRAdhuF14FMUEJvDfzbX%2Fr79%2FTFaMDK6RP0drGFRffB8njyd38oaEmGsHJgnEgyQh3vHEOpE5W%2FDHgmaPYYnLH"
    Dim WinHttp
    Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    WinHttp.Open "GET", url, False
    WinHttp.Option(6) = False
    WinHttp.Send
    Dim redir1 As String
    redir1 = WinHttp.GetResponseHeader("Location")
    Dim et As String
    et = Unescape(Mid(redir1, InStr(1, redir1, "tu=") + 3, Len(redir1) - InStr(1, redir1, "tu=") - 2))
    WinHttp.Open "GET", et, False
    WinHttp.SetRequestHeader "Referer", "http://s.click.taobao.com/t_js?tu=" & Escape(redir1)
    WinHttp.Option(6) = False
    WinHttp.Send
    MsgBox WinHttp.GetResponseHeader("Location")
End Sub

Function Unescape(ByVal pstrInput As String) As String
     Dim objScrCtl      As Object
    
     Set objScrCtl = CreateObject("MSScriptControl.ScriptControl")
     objScrCtl.Language = "JavaScript"
     Unescape = objScrCtl.Eval("unescape('" & pstrInput & "')")
     Set objScrCtl = Nothing
End Function

Function Escape(ByVal pstrInput As String) As String
     Dim objScrCtl      As Object
    
     Set objScrCtl = CreateObject("MSScriptControl.ScriptControl")
     objScrCtl.Language = "JavaScript"
     Escape = objScrCtl.Eval("escape('" & pstrInput & "')") 
 
     Set objScrCtl = Nothing
End Function