宝塔服务器面板，一键全能部署及管理，送你10850元礼包，点我领取

Sub Main() Dim strText As String Dim objHTTP As Object Dim Key_q As String Dim Key_a As String Dim Key_id As String Dim JsText As String Dim JsFuncJ As String Dim Parm_p As String Dim strURL As String Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") strURL = "http://www.tvmao.com/program/CCTV-CCTV1-w5.html" With objHTTP .Open "GET", strURL, False .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 5.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/49.0.2623.75 Safari/537.36" .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8" .Send strText = .responsetext End With strText = Split(strText, " id=""searchform""")(1) Key_q = Split(Split(strText, " q=""")(1), """")(0) Key_a = Split(Split(strText, " a=""")(1), """")(0) Key_id = Split(Split(strText, "value=""猫一把"" id=""")(1), """")(0) JsFuncJ = "var b='',i=0,c, chr2, chr3, enc1, enc2, enc3, enc4;" JsFuncJ = JsFuncJ & "while (i<a.length){" JsFuncJ = JsFuncJ & "c=a.charCodeAt(i++);chr2=a.charCodeAt(i++);chr3=a.charCodeAt(i++);" JsFuncJ = JsFuncJ & "enc1=c>>2;enc2=((c&3)<<4)|(chr2>>4);enc3=((chr2&15)<<2)|(chr3>>6);enc4=chr3&63;" JsFuncJ = JsFuncJ & "if(isNaN(chr2)){enc3=enc4=64}else if(isNaN(chr3)){enc4=64}" JsFuncJ = JsFuncJ & "b=b+keyStr.charAt(enc1)+keyStr.charAt(enc2)+keyStr.charAt(enc3)+keyStr.charAt(enc4)" JsFuncJ = JsFuncJ & "}return b" JsText = "var keyStr='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';" JsText = JsText & "function J(a){" & JsFuncJ & "};" JsText = JsText & "function f(q,a,id){var b=new Date();var d=b.getDay();var w=d==0?7:d;" JsText = JsText & "return keyStr.charAt(w*w)+J(id+'|'+a)+J('|'+q)}" With CreateObject("HTMLFILE") .write "<html><script>" & JsText & "</script></html>" Parm_p = .parentwindow.f(Key_q, Key_a, Key_id) End With With objHTTP .Open "GET", "http://www.tvmao.com/api/pg?p=" & Parm_p, False .setRequestHeader "Referer", strURL .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 5.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/49.0.2623.75 Safari/537.36" .setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01" .Send strText = .responsetext End With Set objHTTP = Nothing Debug.Print strText End Sub