宝塔服务器面板，一键全能部署及管理，送你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 = SplitstrText, " id=""searchform""")1) Key_q = SplitSplitstrText, " q=""")1), """")0) Key_a = SplitSplitstrText, " a=""")1), """")0) Key_id = SplitSplitstrText, "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.charCodeAti++);chr2=a.charCodeAti++);chr3=a.charCodeAti++);" JsFuncJ = JsFuncJ & "enc1=c>>2;enc2=c&3)<<4)|chr2>>4);enc3=chr2&15)<<2)|chr3>>6);enc4=chr3&63;" JsFuncJ = JsFuncJ & "ifisNaNchr2)){enc3=enc4=64}else ifisNaNchr3)){enc4=64}" JsFuncJ = JsFuncJ & "b=b+keyStr.charAtenc1)+keyStr.charAtenc2)+keyStr.charAtenc3)+keyStr.charAtenc4)" JsFuncJ = JsFuncJ & "}return b" JsText = "var keyStr='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';" JsText = JsText & "function Ja){" & JsFuncJ & "};" JsText = JsText & "function fq,a,id){var b=new Date);var d=b.getDay);var w=d==0?7:d;" JsText = JsText & "return keyStr.charAtw*w)+Jid+'|'+a)+J'|'+q)}" With CreateObject"HTMLFILE") .write "<html><script>" & JsText & "</script></html>" Parm_p = .parentwindow.fKey_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