tv.asp

全国电视节目预报代码 源码!

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%Server.ScriptTimeOut=999999999%>
<%
'===============================================
'=     全国电视预报小偷程序				  	   =
'=     去掉了原站所有连接，改为本地。	  	   =
'=     使用有问题请联系QQ5169562			   =
'=	   www.tudoudvd.com  土豆DVD绿色影院       =
'=     www.dydy8.com     电影电影吧            =
'=     www.61xf.com      六一幸福儿童网        =
'===============================================

'请更改标题
WebName = "土豆DVD影院 全国电视预报"
	URL = "http://www.tvsou.com/union/uni2.asp?TVid=1&channelid=1&programDT=2008-2-13"
	if request("v")<>"" then URL=request("v")
	if request("u")<>"" then URL=request("u")&"&channelid="&request("channelid")&"&programDT="&request("programDT")
	if request("d")<>"" then URL=request("d")&"&channelid="&request("channelid")&"&pro="&request("pro")
		Hstr_1 = GetURL(URL)
		B = instr(Hstr_1,"<table width=""758"" border=""0"" cellspacing=""10"" cellpadding=""0"">")
		E = InstrRev(Hstr_1,"</table>")
		Hstr_1=Mid(Hstr_1,B,E-B)
		Hstr_1=Replace(Hstr_1,"<TABLE cellSpacing=10 cellPadding=0 width=758 border=0>","")
		
		B = instr(Hstr_1,"<!--节目列表开始-->")
		E = instr(Hstr_1,"<!--节目列表结束-->")
		Hstr_2 = Mid(Hstr_1,B,E-B)
		Hstr_1 = Replace(Hstr_1,Hstr_2,"<-HTML->")
		Hstr_2 = RemoveHTML_A(Hstr_2,"<a")
		Hstr_1 = Replace(Hstr_1,"<-HTML->",Hstr_2)
		
		B = instr(Hstr_1, "节目时间表")
		E = instr(Hstr_1,"讨论区</a> )")
		DelStr=Mid(Hstr_1,B,E-B)
		Hstr_1=Replace(Hstr_1,delStr,"")
		Hstr_1=Replace(Hstr_1,"讨论区</a> )","")
		
		Hstr_1=Replace(Hstr_1,"<TABLE cellSpacing=10 cellPadding=0 width=758 border=0>","")
		Hstr_1=Replace(Hstr_1,"<img src=""/","<img src=""http://www.tvsou.com/")
		Hstr_1=Replace(Hstr_1,"剧情","")	
		Hstr_1=Replace(Hstr_1,"高速下载","")
		Hstr_1=Replace(Hstr_1,"重新选择地区","")
		Hstr_1=Replace(Hstr_1,"·本节目预告固定于每周一发布，如果您关注的频道更新较慢或内容有误，<a href=""http://www.tvsou.com/contact.asp"" target=""_blank"">请点此向我们反馈相关情况</a>","")	
		Hstr_1=Replace(Hstr_1,"<a href=""http","<a href=""?u=http")
		Hstr_1=Replace(Hstr_1,"<a href='http","<a href='?u=http")
		Hstr_1=Replace(Hstr_1, "<a href=""/","<a href=""?u=http://www.tvsou.com/")
		Hstr_1=Replace(Hstr_1,"<a href=""?tvid","<a href=""?u=http://www.tvsou.com/union/uni2.asp?tvid")
		Hstr_1=Replace(Hstr_1,  "<a href=""un","<a href=""?v=http://www.tvsou.com/union/un")
		response.write "<link href=""http://www.tvsou.com/union/style_2.css"" rel=""stylesheet"" type=""text/css"">"
		response.write "<Script language='javascript' src=""http://epg.tvsou.com/list.js""></script>"
		response.Write("<title>"&WebName&"</title>")
		response.write "<Script language=""javascript"" src=""tv.js""></script>"
		response.Write(Hstr_1)
		response.End()


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''读取页面数据
Function GetURL(URL)
Set http=Server.CreateObject("Microsoft.XMLHTTP") 
    On Error Resume Next
    http.Open "GET",URL,False 
    http.send()
    if Err then
    Err.Clear
    Response.Write("没有找到网页!")
	Exit Function
    End if
    getHTTPPage=bytesToBSTR(Http.responseBody,"gb2312")
set http=nothing 
GetURL=getHTTPPage
End Function

Function BytesToBstr(body,Cset) 
dim objstream 
set objstream = Server.CreateObject("adodb.stream") 
objstream.Type = 1 
objstream.Mode =3 
objstream.Open 
objstream.Write body 
objstream.Position = 0 
objstream.Type = 2 
objstream.Charset = Cset 
BytesToBstr = objstream.ReadText 
objstream.Close 
set objstream = nothing 
End Function 

Function RemoveHTML_A(strText,HTML) '过虑HTML标签
    Dim nPos1
    Dim nPos2  
    nPos1 = InStr(strText,HTML) 
    Do While nPos1>0 
        nPos2 = InStr(nPos1+1, strText, ">") 
        If nPos2>0 Then 
            strText = Left(strText, nPos1 - 1) & Mid(strText, nPos2 + 1) 
        Else 
            Exit Do 
        End If 
        nPos1 = InStr(strText, HTML) 
    Loop  
    RemoveHTML_A = strText 
End Function
%>